From 9f03f548e6661e63b45a7f269d999ee3f7d23969 Mon Sep 17 00:00:00 2001
From: Matt Birkholz <puck@birchwood-abbey.net>
Date: Sun, 7 Feb 2016 16:34:23 -0700
Subject: [PATCH] gtk-screen: Replace stylish box ink with rectangle ink.

---
 src/gtk-screen/gtk-screen.pkg |  4 +++-
 src/gtk-screen/gtk-screen.scm | 22 +++++++++++++++-------
 2 files changed, 18 insertions(+), 8 deletions(-)

diff --git a/src/gtk-screen/gtk-screen.pkg b/src/gtk-screen/gtk-screen.pkg
index 46efbe0f8..ef069f6f6 100644
--- a/src/gtk-screen/gtk-screen.pkg
+++ b/src/gtk-screen/gtk-screen.pkg
@@ -189,4 +189,6 @@ USA.
 	  simple-text-ink-text set-simple-text-ink-text!
 	  set-simple-text-ink-font!
 
-	  <box-ink> set-box-ink! set-box-ink-position!))
\ No newline at end of file
+	  <rectangle-ink> set-rectangle-ink! set-rectangle-ink-position!
+	  set-rectangle-ink-color! set-rectangle-ink-fill-color!
+	  set-rectangle-ink-width! make-rgba-color))
\ No newline at end of file
diff --git a/src/gtk-screen/gtk-screen.scm b/src/gtk-screen/gtk-screen.scm
index 0ccb27c71..bd04f4bdc 100644
--- a/src/gtk-screen/gtk-screen.scm
+++ b/src/gtk-screen/gtk-screen.scm
@@ -1595,7 +1595,7 @@ ScmWidget { font: Monospace 11 }
 		     (space (gtk-screen-line-spacing screen))
 		     (widgets (list widget)))
 		 (%trace ";\t  new "new" for new "widget"\n")
-		 (set-box-ink! new 0 space width height)
+		 (set-rectangle-ink! new 0 space width height)
 		 (set-cursor-ink-widget-list! new widgets)
 		 (if (not modeline)
 		     (begin
@@ -1608,7 +1608,8 @@ ScmWidget { font: Monospace 11 }
 	      ((not (eq? drawing (fix-ink-drawing cursor)))
 	       (%trace ";\t  moving "cursor" to new "drawing"\n")
 	       (fix-ink-remove! cursor)
-	       (set-box-ink-position! cursor 0 (gtk-screen-line-spacing screen))
+	       (set-rectangle-ink-position! cursor
+					    0 (gtk-screen-line-spacing screen))
 	       (fix-drawing-add-ink! drawing cursor 'bottom))
 	      (else
 	       (%trace ";\t  no change\n")))))
@@ -2396,13 +2397,13 @@ ScmWidget { font: Monospace 11 }
     (define (set-half-box! x y)
       (let ((half-width (quotient (gtk-screen-char-width screen) 2))
 	    (line-height (gtk-screen-line-height screen)))
-	(set-box-ink! cursor x y half-width line-height))
+	(set-rectangle-ink! cursor x y half-width line-height))
       #t)
 
     (define (set-box! x y width height)
       (if (fix:< width 5)
-	  (set-box-ink! cursor x y 5 height)
-	  (set-box-ink! cursor x y width height))
+	  (set-rectangle-ink! cursor x y 5 height)
+	  (set-rectangle-ink! cursor x y width height))
       #t)
 
     (main)))
@@ -2572,7 +2573,7 @@ ScmWidget { font: Monospace 11 }
 	  (set-line-ink-cached-pango-layout! line #f)))))
 
 (define-class (<cursor-ink> (constructor ()))
-    (<box-ink>)
+    (<rectangle-ink>)
 
   ;; #t if the cursor should be drawn.
   (visible? define standard initial-value #t)
@@ -2581,6 +2582,13 @@ ScmWidget { font: Monospace 11 }
   ;; (restore its ink-widgets list) withOUT consing.
   (widget-list define standard))
 
+(define-method initialize-instance ((cursor <cursor-ink>))
+  (call-next-method cursor)
+  (set-rectangle-ink-width! cursor 2)
+  (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)))
+
 (define (guarantee-cursor-ink object)
   (if (cursor-ink? object) object
       (error:wrong-type-argument object "<cursor-ink>" 'guarantee-cursor-ink)))
@@ -2640,7 +2648,7 @@ ScmWidget { font: Monospace 11 }
 ;; indicator.  Any typeahead will be displayed... eventually.
 
 (define-class (<buffer-status> (constructor add-buffer-status (drawing) 1))
-    (<box-ink>)
+    (<rectangle-ink>)
   (text-ink define standard))
 
 (define %trace? #f)
-- 
2.25.1