fix mouse enter/leave handling

diff --git a/library/generic/tuple.factor b/library/generic/tuple.factor
index 91a8c13d7633d7cd69a480fce054f2554ae40e9e..328247e7a65cb4ce48cccbe84381ce488112b01b 100644 (file)
--- a/library/generic/tuple.factor
+++ b/library/generic/tuple.factor
@@ -221,3 +221,12 @@ tuple 10 "priority" set-word-prop
 tuple [ 2drop t ] "class<" set-word-prop
 
 PREDICATE: word tuple-class metaclass tuple = ;
+
+: is? ( obj pred -- ? | pred: obj -- ? )
+    #! Tests if the object satisfies the predicate, or if
+    #! it delegates to an object satisfying it.
+    [ call ] 2keep rot [
+        2drop t
+    ] [
+        over [ >r delegate r> is? ] [ 2drop f ] ifte
+    ] ifte ;

diff --git a/library/styles.factor b/library/styles.factor
index 5c4abd7978eaa2dec3a778c2042b1dd6a2d29a05..61d69d5969ecb16c98438daaaeb4492f32ea9cf3 100644 (file)
--- a/library/styles.factor
+++ b/library/styles.factor
@@ -31,6 +31,6 @@ SYMBOL: bold-italic
 
 SYMBOL: underline
 
-SYMBOL: presented
-
 SYMBOL: icon
+
+SYMBOL: presented

diff --git a/library/ui/hand.factor b/library/ui/hand.factor
index 673196f708c68af33fbfb8fe9489370245eae9df..ff9530d7b328d6be01ad94b6c623e295ccdc82f3 100644 (file)
--- a/library/ui/hand.factor
+++ b/library/ui/hand.factor
@@ -6,32 +6,28 @@ prettyprint sdl sequences vectors ;
 
 DEFER: pick-up
 
-: pick-up-list ( point list -- gadget )
+: (pick-up) ( point list -- gadget )
     dup [
         2dup car pick-up dup
-        [ 2nip ] [ drop cdr pick-up-list ] ifte
+        [ 2nip ] [ drop cdr (pick-up) ] ifte
     ] [
         2drop f
     ] ifte ;
 
-: pick-up* ( point gadget -- gadget/t )
+: pick-up ( point gadget -- gadget )
     #! The logic is thus. If the point is definately outside the
     #! box, return f. Otherwise, see if the point is contained
     #! in any subgadget. If not, see if it is contained in the
     #! box delegate.
     2dup inside? [
-        2dup [ translate ] keep
-        gadget-children reverse pick-up-list dup
-        [ 2nip ] [ 3drop t ] ifte
+        [
+            [ translate ] keep
+            gadget-children reverse (pick-up) dup
+        ] keep ?
     ] [
         2drop f
     ] ifte ;
 
-: pick-up ( point gadget -- gadget )
-    #! pick-up* returns t to mean 'this gadget', avoiding the
-    #! exposed facade issue.
-    tuck pick-up* dup t = [ drop ] [ nip ] ifte ;
-
 ! The hand is a special gadget that holds mouse position and
 ! mouse button click state. The hand's parent is the world, but
 ! it is special in that the world does not list it as part of
@@ -39,14 +35,10 @@ DEFER: pick-up
 ! - hand-gadget is the gadget under the mouse position
 ! - hand-clicked is the most recently clicked gadget
 ! - hand-focus is the gadget holding keyboard focus
-TUPLE: hand
-    world
-    click-loc click-rel clicked buttons
-    gadget focus ;
+TUPLE: hand click-loc click-rel clicked buttons gadget focus ;
 
 C: hand ( world -- hand )
     <empty-gadget> over set-delegate
-    [ set-hand-world ] 2keep
     [ set-gadget-parent ] 2keep
     [ set-hand-gadget ] keep ;
 
@@ -66,7 +58,7 @@ C: hand ( world -- hand )
     hand-gadget [ screen-loc v- ] keep mouse-enter ;
 
 : update-hand-gadget ( hand -- )
-    dup dup hand-world pick-up swap set-hand-gadget ;
+    [ world get pick-up ] keep set-hand-gadget ;
 
 : motion-gesture ( hand gadget gesture -- )
     #! Send a gesture like [ drag 2 ].

diff --git a/library/ui/presentations.factor b/library/ui/presentations.factor
index b7bdb3583fce89594e87c80f14ff94fb8399179e..30de321d803cb3604543981c1638439e529484ed 100644 (file)
--- a/library/ui/presentations.factor
+++ b/library/ui/presentations.factor
@@ -13,7 +13,7 @@ global [ 100 <vector> commands set ] bind
 
 : applicable ( object -- )
     commands get >list
-    [ car "predicate" word-prop call ] subset-with ;
+    [ car call ] subset-with ;
 
 DEFER: pane-call
 
@@ -39,13 +39,22 @@ DEFER: pane-call
     <label> swap alist>hash over set-gadget-paint ;
 
 : <presentation> ( style text pane -- presentation )
-    >r <styled-label> dup r> init-commands ;
+    pick gadget swap assoc dup [
+        >r 3drop r>
+    ] [
+        drop >r <styled-label> dup r> init-commands
+    ] ifte ;
+
+: gadget. ( gadget -- )
+    gadget swons unit "" swap write-attr ;
+
+[ drop t ] "Prettyprint" [ prettyprint ] define-command
+[ drop t ] "Inspect" [ inspect ] define-command
+[ drop t ] "References" [ references inspect ] define-command
 
-object "Prettyprint" [ prettyprint ] define-command
-object "Inspect" [ inspect ] define-command
-object "References" [ references inspect ] define-command
+[ word? ] "See" [ see ] define-command
+[ word? ] "Execute" [ execute ] define-command
+[ word? ] "Usage" [ usage . ] define-command
+[ word? ] "jEdit" [ jedit ] define-command
 
-\ word "See" [ see ] define-command
-\ word "Execute" [ execute ] define-command
-\ word "Usage" [ usage . ] define-command
-\ word "jEdit" [ jedit ] define-command
+[ [ gadget? ] is? ] "Display" [ ] define-command

diff --git a/library/ui/rectangles.factor b/library/ui/rectangles.factor
index 2aee919db0a3ed97d197a20e09330145170458ba..68b5a7b0ad57699bf841d7966f907d3a413eab4b 100644 (file)
--- a/library/ui/rectangles.factor
+++ b/library/ui/rectangles.factor
@@ -16,7 +16,7 @@ M: rectangle set-shape-dim set-rectangle-dim ;
     shape-bounds >r origin v+ r> <rectangle> ;
 
 M: rectangle inside? ( loc rect -- ? )
-    screen-bounds shape-bounds
+    screen-bounds shape-bounds { 1 1 1 } v- { 0 0 0 } vmax
     >r v- { 0 0 0 } r> vbetween? conj ;
 
 M: rectangle draw-shape drop ;

diff --git a/library/ui/ui.factor b/library/ui/ui.factor
index 11fbf61ffbda55e97071d53da03e47ebd3697d17..fb27a9bae50dce45c6b968bf46b0f67d890d8705 100644 (file)
--- a/library/ui/ui.factor
+++ b/library/ui/ui.factor
@@ -8,11 +8,11 @@ IN: shells
 : ui ( -- )
     #! Start the Factor graphics subsystem with the given screen
     #! dimensions.
+    ttf-init
     ?init-world
     world get shape-dim 2unseq 0 SDL_RESIZABLE [
         0 x set 0 y set [
             "Factor " version append dup SDL_WM_SetCaption
-            ttf-init
             start-world
             run-world
         ] with-screen

diff --git a/library/ui/world.factor b/library/ui/world.factor
index 9015a7eb84e863c001b7f44b9a86a95a38a03288..711cd15a8c600721b96ae79cc0eb3312ca18fde7 100644 (file)
--- a/library/ui/world.factor
+++ b/library/ui/world.factor
@@ -57,7 +57,7 @@ DEFER: handle-event
 
 : world-step ( -- ? )
     world get dup world-invalid >r layout-world r>
-    [ draw-world ] [ drop ] ifte ;
+    [ dup world-hand update-hand draw-world ] [ drop ] ifte ;
 
 : next-event ( -- event ? )
     <event> dup SDL_PollEvent ;