From 9bcde6657dd21459e9d67efddc83c738b60b1d62 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Sun, 17 Jul 2005 06:49:07 +0000
Subject: [PATCH] UI paint cleanups

---
 library/styles.factor     |  3 +++
 library/ui/buttons.factor |  3 +++
 library/ui/gadgets.factor | 12 +--------
 library/ui/paint.factor   | 52 ++++++++++++++++++++++++++-------------
 4 files changed, 42 insertions(+), 28 deletions(-)

diff --git a/library/styles.factor b/library/styles.factor
index 0f95ba97b0..0707aa0ab1 100644
--- a/library/styles.factor
+++ b/library/styles.factor
@@ -10,6 +10,9 @@ IN: styles
 : green [ 0   255 0   ] ;
 : blue  [ 0   0   255 ] ;
 
+SYMBOL: filled
+SYMBOL: etched
+
 SYMBOL: foreground ! Used for text and outline shapes.
 SYMBOL: background ! Used for filled shapes.
 SYMBOL: rollover-bg
diff --git a/library/ui/buttons.factor b/library/ui/buttons.factor
index cedfc7d955..1f85be22fe 100644
--- a/library/ui/buttons.factor
+++ b/library/ui/buttons.factor
@@ -40,3 +40,6 @@ sequences io sequences styles ;
     dup [ button-update ] [ mouse-leave ] set-action
     dup [ button-update ] [ mouse-enter ] set-action
     [ drop ] [ drag 1 ] set-action ;
+
+: <button> ( label quot -- button )
+    >r <label> line-border dup r> button-gestures ;
diff --git a/library/ui/gadgets.factor b/library/ui/gadgets.factor
index c8de99b29f..7fca229cff 100644
--- a/library/ui/gadgets.factor
+++ b/library/ui/gadgets.factor
@@ -2,7 +2,7 @@
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: gadgets
 USING: generic hashtables kernel lists math matrices namespaces
-sequences vectors ;
+sequences styles vectors ;
 
 ! A gadget is a shape, a paint, a mapping of gestures to
 ! actions, and a reference to the gadget's parent. A gadget
@@ -17,16 +17,6 @@ C: gadget ( -- gadget )
     { 0 0 0 } dup <rectangle> over set-delegate
     t over set-gadget-visible? ;
 
-TUPLE: plain-gadget ;
-
-C: plain-gadget ( -- gadget )
-    <gadget> over set-delegate ;
-
-TUPLE: etched-gadget ;
-
-C: etched-gadget ( -- gadget )
-    <gadget> over set-delegate ;
-
 DEFER: add-invalid
 
 : invalidate ( gadget -- )
diff --git a/library/ui/paint.factor b/library/ui/paint.factor
index 6807df988a..7c14e9e6ce 100644
--- a/library/ui/paint.factor
+++ b/library/ui/paint.factor
@@ -36,18 +36,13 @@ GENERIC: draw-gadget* ( gadget -- )
         ] with-clip
     ] [ drop ] ifte ;
 
-M: gadget draw-gadget* ( gadget -- ) drop ;
-
 : paint-prop* ( gadget key -- value )
     swap gadget-paint ?hash ;
 
 : paint-prop ( gadget key -- value )
     over [
-        2dup paint-prop* dup [
-            2nip
-        ] [
-            drop >r gadget-parent r> paint-prop
-        ] ifte
+        2dup paint-prop* dup
+        [ 2nip ] [ drop >r gadget-parent r> paint-prop ] ifte
     ] [
         2drop f
     ] ifte ;
@@ -66,16 +61,39 @@ M: gadget draw-gadget* ( gadget -- ) drop ;
         dup rollover paint-prop rollover-bg background ?
     ] ifte paint-prop ;
 
-: plain-rect ( shape -- )
-    #! Draw a filled rect with the bounds of an arbitrary shape.
-    [ rect>screen ] keep bg rgb boxColor ;
+: filled-rect
+    >r surface get r> [ rect>screen ] keep bg rgb boxColor ;
 
-M: plain-gadget draw-gadget* ( gadget -- )
-    >r surface get r> plain-rect ;
+: etched-rect
+    >r surface get r> [ rect>screen >r 1 - r> 1 - ] keep
+    fg rgb rectangleColor ;
 
-: hollow-rect ( shape -- )
-    #! Draw a hollow rect with the bounds of an arbitrary shape.
-    [ rect>screen >r 1 - r> 1 - ] keep fg rgb rectangleColor ;
+! Paint properties
+SYMBOL: interior
+SYMBOL: boundary
 
-M: etched-gadget draw-gadget* ( gadget -- )
-    >r surface get r> 2dup plain-rect hollow-rect ;
+GENERIC: draw-interior ( gadget interior -- )
+GENERIC: draw-boundary ( gadget boundary -- )
+
+M: f draw-interior 2drop ;
+M: f draw-boundary 2drop ;
+
+TUPLE: solid ;
+
+M: solid draw-interior
+    drop >r surface get r> [ rect>screen ] keep bg rgb boxColor ;
+
+M: solid draw-boundary
+    drop >r surface get r> [ rect>screen >r 1 - r> 1 - ] keep
+    fg rgb rectangleColor ;
+
+M: gadget draw-gadget* ( gadget -- )
+    dup
+    dup interior paint-prop* draw-interior
+    dup boundary paint-prop* draw-boundary ;
+
+: <plain-gadget> ( -- gadget )
+    <gadget> dup << solid f >> interior set-paint-prop ;
+
+: <etched-gadget> ( -- gadget )
+    <plain-gadget> dup << solid f >> boundary set-paint-prop ;