gtk-screen: Replace stylish box ink with rectangle ink.
authorMatt Birkholz <puck@birchwood-abbey.net>
Sun, 7 Feb 2016 23:34:23 +0000 (16:34 -0700)
committerMatt Birkholz <puck@birchwood-abbey.net>
Sun, 7 Feb 2016 23:51:45 +0000 (16:51 -0700)
src/gtk-screen/gtk-screen.pkg
src/gtk-screen/gtk-screen.scm

index 46efbe0f84c62156a6a2ce4fa2ee16750510eef7..ef069f6f633fc7b88bd4c7305723c9f833060157 100644 (file)
@@ -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
index 0ccb27c71f28ddc9add27c61c025c14822ff9c09..bd04f4bdcdc9341dda18538dcbfdd9f753200a78 100644 (file)
@@ -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)))))
 \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))
 \f
 (define %trace? #f)