From: Matt Birkholz <puck@birchwood-abbey.net>
Date: Fri, 5 Feb 2016 22:19:30 +0000 (-0700)
Subject: Remove <box-ink> (gtk_render_focus), the last stylish ink.
X-Git-Tag: mit-scheme-pucked-9.2.12~370
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=87d0aac5831396ce5e7e1810e78c1359bb4db170;p=mit-scheme.git

Remove <box-ink> (gtk_render_focus), the last stylish ink.

Use a rectangle ink in the demo instead.

It is too hard to calculate a stylish ink's extent, because it depends
on the style context -- the current theme's colors, line widths, etc.
---

diff --git a/src/gtk/fix-demo.scm b/src/gtk/fix-demo.scm
index 3f0447a6a..b18dad324 100644
--- a/src/gtk/fix-demo.scm
+++ b/src/gtk/fix-demo.scm
@@ -57,8 +57,8 @@ USA.
     (gtk-widget-show-all window)
 
     (let ((drawing (make-demo-drawing layout1)))
-      (let ((cursor1 (make-box-ink))
-	    (cursor2 (make-box-ink)))
+      (let ((cursor1 (make-cursor-ink))
+	    (cursor2 (make-cursor-ink)))
 	(fix-drawing-add-ink! drawing cursor1 'bottom)
 	(fix-drawing-add-ink! drawing cursor2 'bottom)
 	(set-demo-drawing-cursor-inks!
@@ -79,6 +79,13 @@ USA.
     (%trace ";created "layout1" and "layout2"\n"))
   unspecific)
 
+(define (make-cursor-ink)
+  (let ((cursor (make-rectangle-ink)))
+    (set-rectangle-ink-width! cursor 2)
+    (set-rectangle-ink-color! cursor "green")
+    (set-rectangle-ink-fill-color! cursor (make-rgba-color 0. 1. 0. .5))
+    cursor))
+
 (define-class (<demo-layout> (constructor () (width height)))
     (<fix-layout>))
 
@@ -109,7 +116,7 @@ USA.
 	  (poly (make-polygon-ink))
 	  (arc (make-arc-ink))
 	  (text (make-simple-text-ink))
-	  (box (make-box-ink))
+	  (box (make-rectangle-ink))
 	  (image (make-image-ink-from-file
 		  (merge-pathnames "conses.png"
 				   (or
@@ -136,7 +143,10 @@ USA.
       (set-simple-text-ink-text! text widget "Hello, World!")
       (fix-drawing-add-ink! drawing text)
 
-      (set-box-ink! box 120 120 20 20)
+      (set-rectangle-ink! box 120 120 20 20)
+      (set-rectangle-ink-width! box 2)
+      (set-rectangle-ink-color! box "green")
+      (set-rectangle-ink-fill-color! box (make-rgba-color 0. 1. 0. .5))
       (fix-drawing-add-ink! drawing box)
 
       (set-image-ink! image 170 100)
@@ -217,7 +227,7 @@ USA.
   (cursor-inks define standard initial-value '()))
 
 (define (demo-motion-handler layout modifiers window-x window-y)
-  (%trace2 ";motion-handler "layout" "modifiers" "window-x" "window-y"\n")
+  (%trace2 ";demo-motion-handler "layout" "modifiers" "window-x" "window-y"\n")
   (let* ((drawing (fix-layout-drawing layout))
 	 (view (fix-layout-view layout))
 	 (x (+ window-x (fix-rect-x view)))
@@ -236,7 +246,7 @@ USA.
 		   (lambda (cursor.widgets)
 		     (if (memq layout (cdr cursor.widgets))
 			 (begin
-			   (set-box-ink!
+			   (set-rectangle-ink!
 			    (car cursor.widgets)
 			    (+ xG (fix-rect-x text-extent))
 			    (+ yG (fix-rect-y text-extent))
@@ -250,7 +260,7 @@ USA.
   #t)
 
 (define (demo-button-release-handler layout type button modifiers window-x window-y)
-  (%trace2 ";button-release-handler "layout" "type" "button" "modifiers" "window-x" "window-y"\n")
+  (%trace2 ";demo-button-release-handler "layout" "type" "button" "modifiers" "window-x" "window-y"\n")
   (let* ((drawing (fix-layout-drawing layout))
 	 (view (fix-layout-view layout))
 	 (x (+ window-x (fix-rect-x view)))
diff --git a/src/gtk/fix-layout.scm b/src/gtk/fix-layout.scm
index d8fdd235c..107c6f6bb 100644
--- a/src/gtk/fix-layout.scm
+++ b/src/gtk/fix-layout.scm
@@ -1738,42 +1738,6 @@ USA.
 (define (set-surface-ink-position! ink x y)
   (set-fix-rect-position! (fix-ink-extent ink) x y))
 
-
-;;; Inks implemented by gtk_render_*, using widget style/state.
-
-(define-class (<box-ink> (constructor ()))
-    (<fix-ink>)
-  ;; Just hoping that the effects of style xthickness, ythickness,
-  ;; etc. do not drop ink beyond the ink-extent.
-  (%shadow define standard initial-value (C-enum "GTK_SHADOW_NONE")))
-
-(define-method fix-ink-draw-callback ((ink <box-ink>) widget window cr area)
-  (declare (ignore window area))
-  (%trace2 ";drawing "ink" on "widget"\n")
-  (let ((view (fix-layout-view widget))
-	(extent (fix-ink-extent ink))
-	(style (gtk-widget-style-context widget)))
-    (let ((x (->flonum (fix:- (fix-rect-x extent) (fix-rect-x view))))
-	  (y (->flonum (fix:- (fix-rect-y extent) (fix-rect-y view))))
-	  (width (->flonum (fix-rect-width extent)))
-	  (height (->flonum (fix-rect-height extent))))
-      (C-call "gtk_render_focus" style cr x y width height))))
-
-(define-method fix-ink-move! ((ink <box-ink>) dx dy)
-  (generic-fix-ink-move! ink dx dy))
-
-(define (set-box-ink! ink x y width height)
-  (guarantee-fixnum x 'set-box-ink!)
-  (guarantee-fixnum y 'set-box-ink!)
-  (guarantee-size width 'set-box-ink!)
-  (guarantee-size height 'set-box-ink!)
-  (set-fix-ink! ink x y width height))
-
-(define (set-box-ink-position! ink x y)
-  (guarantee-fixnum x 'set-box-ink!)
-  (guarantee-fixnum y 'set-box-ink!)
-  (set-fix-ink-%position! ink x y))
-
 ;;;; Fixnum Rectangles
 
 (define-structure (fix-rect (constructor make-fix-rect (#!optional x y width height))
diff --git a/src/gtk/gtk.pkg b/src/gtk/gtk.pkg
index b294cdb39..c9c1d504c 100644
--- a/src/gtk/gtk.pkg
+++ b/src/gtk/gtk.pkg
@@ -241,12 +241,6 @@ USA.
 
 	  <surface-ink> surface-ink? make-surface-ink
 	  surface-ink-surface set-surface-ink-position!
-
-	  <box-ink> box-ink? make-box-ink
-	  set-box-ink! set-box-ink-position!
-
-	  ;;<hline-ink> make-hline-ink set-hline-ink-size!
-	  ;;<vline-ink> make-vline-ink set-vline-ink-size!
 	  ))
 
 (define-package (gtk keys)
diff --git a/src/gtk/gtk.scm b/src/gtk/gtk.scm
index 780cf46f3..91b144d8a 100644
--- a/src/gtk/gtk.scm
+++ b/src/gtk/gtk.scm
@@ -98,4 +98,11 @@ USA.
 (define-integrable-operator (set-color-blue! o b)
   (if (color? o) (flo:vector-set! o 2 b)(error:wrong-type-argument o"a color")))
 (define-integrable-operator (set-color-alpha! o a)
-  (if (color? o) (flo:vector-set! o 3 a)(error:wrong-type-argument o"a color")))
\ No newline at end of file
+  (if (color? o) (flo:vector-set! o 3 a)(error:wrong-type-argument o"a color")))
+(define-integrable-operator (make-rgba-color red green blue alpha)
+  (let ((color (make-color)))
+    (set-color-red! color red)
+    (set-color-green! color green)
+    (set-color-blue! color blue)
+    (set-color-alpha! color alpha)
+    color))
\ No newline at end of file
diff --git a/src/gtk/gtk.texinfo b/src/gtk/gtk.texinfo
index bc220601e..1d998899d 100644
--- a/src/gtk/gtk.texinfo
+++ b/src/gtk/gtk.texinfo
@@ -1525,10 +1525,8 @@ in fixnum pixels.  Thus flonums are rarely needed, and actually
 avoided.  For a flonum-oriented canvas (with scale, rotate, splines,
 etc.), a cairo-layout seems inevitable.
 
-Just a few types of fix-ink been implemented: line-ink,
-rectangle-ink, arc-ink, simple-text-ink, image-ink and
-box-ink.  The last three are rendered by more modern toolkit
-functions, from libraries like Pango and GdkPixbuf.
+Just a few types of fix-ink have been implemented: line-ink,
+rectangle-ink, arc-ink, simple-text-ink, and image-ink.
 
 Each fix-ink has a position on the canvas and a position in the
 drawing's display list.  The display list determines the order in
@@ -1997,34 +1995,6 @@ on this surface, you need to call @code{drawing-damage} to notify any
 widgets.
 @end deffn
 
-@subsection Box Ink
-
-A fix-ink rendered by @code{gtk_paint_box}.
-
-@deffn Class <box-ink>
-A direct subclass of fix-ink.
-@end deffn
-
-@deffn Procedure box-ink? object
-Type predicate.
-@end deffn
-
-@deffn Procedure make-box-ink
-A new box-ink.
-@end deffn
-
-@deffn Procedure set-box-ink! box x y width height
-Resizes @var{box} to @var{width} and @var{height}, and moves it
-to (@var{x}, @var{y}).  If @var{box} is already at the specified
-position and size, this procedure does nothing.
-@end deffn
-
-@deffn Procedure set-box-ink-position! box x y
-Moves @var{box} to place its upper-left corner at point (@var{x},
-@var{y}).  If @var{box} is already at the specified position, this
-procedure does nothing.
-@end deffn
-
 @node Gdk Functions, Debugging Facilities, Fix Layout, API Reference
 @section Gdk Functions