fixes to menu code in UI, hacked up presentations in listener

diff --git a/library/styles.factor b/library/styles.factor
index c063f17910eaf7e164ede76f582221752a426bcc..a26699b340d1bbb19ceeeb44102c69ab4402cd31 100644 (file)
--- a/library/styles.factor
+++ b/library/styles.factor
@@ -6,10 +6,19 @@ USING: kernel namespaces ;
 ! Colors are lists of three integers, 0..255.
 SYMBOL: foreground ! Used for text and outline shapes.
 SYMBOL: background ! Used for filled shapes.
+SYMBOL: rollover-bg
+SYMBOL: rollover
 SYMBOL: reverse-video
 
-: fg reverse-video get background foreground ? get ;
-: bg reverse-video get foreground background ? get ;
+: fg ( -- color )
+    reverse-video get background foreground ? get ;
+
+: bg ( -- color )
+    reverse-video get [
+        foreground
+    ] [
+        rollover get rollover-bg background ?
+    ] ifte get ;
 
 SYMBOL: font
 SYMBOL: font-size

diff --git a/library/ui/buttons.factor b/library/ui/buttons.factor
index 2daeee6ee1e42e91cadb05519f93f96a01b2449b..8d0e8ebdd64d2189027b09ccf1c5b9e87c77570d 100644 (file)
--- a/library/ui/buttons.factor
+++ b/library/ui/buttons.factor
@@ -12,28 +12,22 @@ sequences io sequences styles ;
     #! Return true if the mouse was clicked on the button, and
     #! is currently over the button.
     dup mouse-over? [
-        1 button-down? [
-            hand hand-clicked child?
-        ] [
-            drop f
-        ] ifte
+        1 button-down?
+        [ hand hand-clicked child? ] [ drop f ] ifte
     ] [
         drop f
     ] ifte ;
 
 : button-update ( button -- )
-    dup dup mouse-over? rollover? set-paint-prop
+    dup dup mouse-over? rollover set-paint-prop
     dup dup button-pressed? reverse-video set-paint-prop
     redraw ;
 
 : button-clicked ( button -- )
     #! If the mouse is released while still inside the button,
     #! fire an action gesture.
-    dup mouse-over? [
-        [ action ] swap handle-gesture drop
-    ] [
-        drop
-    ] ifte ;
+    dup mouse-over?
+    [ [ action ] swap handle-gesture drop ] [ drop ] ifte ;
 
 : button-action ( action -- quot )
     [ [ swap handle-gesture drop ] cons ] [ [ drop ] ] ifte* ;
@@ -49,11 +43,3 @@ sequences io sequences styles ;
 
 : <button> ( label action -- button )
     >r <label> line-border dup r> button-action button-gestures ;
-
-: roll-border ( child -- border )
-    0 0 0 0 <roll-rect> <gadget> 1 <border> ;
-
-: <roll-button> ( label quot -- gadget )
-    #! Thinner border that is only visible when the mouse is
-    #! over the button.
-    >r <label> roll-border dup r> button-action button-gestures ;

diff --git a/library/ui/hierarchy.factor b/library/ui/hierarchy.factor
index fb5fd4e5fba7b21a9ee38e83c42061e5647c4aa1..f7aeecbcb8dc629c62e13908603509fc2eaecd79 100644 (file)
--- a/library/ui/hierarchy.factor
+++ b/library/ui/hierarchy.factor
@@ -15,7 +15,10 @@ sequences ;
     set-gadget-children ;
 
 : unparent ( gadget -- )
-    dup gadget-parent dup [ remove-gadget ] [ 2drop ] ifte ;
+    [
+        dup gadget-parent dup
+        [ remove-gadget ] [ 2drop ] ifte
+    ] when* ;
 
 : add-gadget ( gadget box -- )
     #! Add a gadget to a box.

diff --git a/library/ui/init-world.factor b/library/ui/init-world.factor
index 966b9f139aa709283b158e35da60ae9a6b5ee1b9..f4f7a6566d6c760b7ef92810a3dfc6cceabfc192 100644 (file)
--- a/library/ui/init-world.factor
+++ b/library/ui/init-world.factor
@@ -10,6 +10,7 @@ global [
     {{
 
         [[ background [ 255 255 255 ] ]]
+        [[ rollover-bg [ 216 216 216 ] ]]
         [[ foreground [ 0 0 0 ] ]]
         [[ reverse-video f ]]
         [[ font "Sans Serif" ]]
@@ -22,6 +23,5 @@ global [
     <plain-gadget> world get add-gadget
 
     <console> "Stack display goes here" <label> <y-splitter>
-    3/4 over set-splitter-split
-    world get add-gadget
+    3/4 over set-splitter-split add-layer
 ] bind

diff --git a/library/ui/labels.factor b/library/ui/labels.factor
index f4e06b591ab73a3aabbf765a1edb592262070204..f7b71942597c9922a65a404e172050454bd18e57 100644 (file)
--- a/library/ui/labels.factor
+++ b/library/ui/labels.factor
@@ -19,6 +19,3 @@ M: label pref-size ( label -- w h )
 M: label draw-shape ( label -- )
     [ dup gadget-font swap label-text ] keep
     [ draw-string ] with-trans ;
-
-: <styled-label> ( style text -- label )
-    <label> swap alist>hash over set-gadget-paint ;

diff --git a/library/ui/load.factor b/library/ui/load.factor
index d26ebcd8a0c9d13548ea25d79fdd46f26cfe59ce..f5fc285acdc5a0651dbc454346cd4fbb961ebebf 100644 (file)
--- a/library/ui/load.factor
+++ b/library/ui/load.factor
@@ -29,6 +29,7 @@ USING: kernel parser sequences io ;
     "/library/ui/editors.factor"
     "/library/ui/menus.factor"
     "/library/ui/splitters.factor"
+    "/library/ui/presentations.factor"
     "/library/ui/panes.factor"
     "/library/ui/init-world.factor"
     "/library/ui/ui.factor"

diff --git a/library/ui/menus.factor b/library/ui/menus.factor
index 52664ca3282320ea8f52ea943518f4db5b6b012e..d6eae16dd35598c11433a6638e50a296f2ad2afc 100644 (file)
--- a/library/ui/menus.factor
+++ b/library/ui/menus.factor
@@ -5,14 +5,15 @@ USING: generic kernel lists math namespaces sequences ;
 
 : hide-menu ( -- )
     world get
-    dup world-menu [ unparent ] when* f swap set-world-menu ;
+    dup hide-glass
+    [ world-menu unparent f ] keep set-world-menu ;
 
 : show-menu ( menu -- )
     hide-menu
     world get
     2dup set-world-menu
     2dup world-hand screen-pos >rect rot move-gadget
-    add-gadget ;
+    show-glass ;
 
 : menu-item-border ( child -- border )
     <plain-gadget> 1 <border> ;

diff --git a/library/ui/panes.factor b/library/ui/panes.factor
index 85667f5fadc6fd8c57e95cbc8cccbdaad8933d04..10de6e417371dc7d944f70822716206856545c29 100644 (file)
--- a/library/ui/panes.factor
+++ b/library/ui/panes.factor
@@ -1,8 +1,8 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: gadgets
-USING: generic kernel line-editor listener lists math namespaces
-sequences io strings threads styles ;
+USING: generic hashtables io kernel line-editor listener lists
+math namespaces prettyprint sequences strings styles threads ;
 
 ! A pane is an area that can display text.
 
@@ -12,13 +12,14 @@ sequences io strings threads styles ;
 TUPLE: pane output active current input continuation ;
 
 : add-output 2dup set-pane-output add-gadget ;
+
 : add-input 2dup set-pane-input add-gadget ;
 
 : <active-line> ( input current -- line )
     <line-shelf> [ add-gadget ] keep [ add-gadget ] keep ;
 
 : init-active-line ( pane -- )
-    dup pane-active [ unparent ] when*
+    dup pane-active unparent
     [ dup pane-input swap pane-current <active-line> ] keep
     2dup set-pane-active add-gadget ;
 
@@ -67,6 +68,7 @@ C: pane ( -- pane )
 
 ! Panes are streams.
 M: pane stream-flush ( stream -- ) relayout ;
+
 M: pane stream-auto-flush ( stream -- ) stream-flush ;
 
 M: pane stream-readln ( stream -- line )

diff --git a/library/ui/presentations.factor b/library/ui/presentations.factor
new file mode 100644 (file)
index 0000000..ec260e5
--- /dev/null
+++ b/library/ui/presentations.factor
@@ -0,0 +1,14 @@
+! Copyright (C) 2005 Slava Pestov.
+! See http://factor.sf.net/license.txt for BSD license.
+IN: gadgets
+USING: hashtables io kernel lists namespaces prettyprint ;
+
+: actions-menu ( -- )
+    "actions" get <menu> show-menu ;
+
+: init-actions ( gadget -- )
+    [ "actions" get actions-menu ] button-gestures ;
+
+: <styled-label> ( style text -- label )
+    <label> "actions" pick assoc [ dup init-actions ] when
+    swap alist>hash over set-gadget-paint ;

diff --git a/library/ui/rectangles.factor b/library/ui/rectangles.factor
index 6e0cbacfd46a4b8c3a5b79cd4257d99f709d0e65..3dbd3d2b399c6b005a25d06488881812b01fb4ca 100644 (file)
--- a/library/ui/rectangles.factor
+++ b/library/ui/rectangles.factor
@@ -84,16 +84,3 @@ C: etched-rect ( x y w h -- rect )
 
 M: etched-rect draw-shape ( rect -- )
     >r surface get r> 2dup plain-rect hollow-rect ;
-
-! A rectangle that has a visible outline only if the rollover
-! paint property is set.
-SYMBOL: rollover?
-
-TUPLE: roll-rect ;
-
-C: roll-rect ( x y w h -- rect )
-    [ >r <rectangle> r> set-delegate ] keep ;
-
-M: roll-rect draw-shape ( rect -- )
-    >r surface get r> 2dup
-    plain-rect rollover? get [ hollow-rect ] [ 2drop ] ifte ;

diff --git a/library/ui/world.factor b/library/ui/world.factor
index 4875cb8173765cd64c19661821c7a3dc724a329c..c5abb569256a74c5d07dc95286fb4df3a001b88b 100644 (file)
--- a/library/ui/world.factor
+++ b/library/ui/world.factor
@@ -9,13 +9,23 @@ threads sequences ;
 ! gadgets are contained in. The current world is stored in the
 ! world variable. The menu slot ensures that only one menu is
 ! open at any one time.
-TUPLE: world running? hand menu ;
+TUPLE: world running? hand menu glass ;
 
 C: world ( -- world )
     f <stack> over set-delegate
     t over set-world-running?
     dup <hand> over set-world-hand ;
 
+: add-layer ( gadget -- )
+    world get add-gadget ;
+
+: show-glass ( gadget world -- )
+    >r <empty-gadget> [ add-gadget ] keep
+    r> 2dup set-world-glass add-gadget ;
+
+: hide-glass ( world -- )
+    [ world-glass unparent f ] keep set-world-glass ;
+
 M: world inside? ( point world -- ? ) 2drop t ;
 
 : hand world get world-hand ;