Start refactoring hand, add new get-global word

library/collections/namespaces.factor

@@ -15,6 +15,7 @@ sequences strings vectors words ;
 : set ( value variable -- ) namespace set-hash ;
 : on ( var -- ) t swap set ; inline
 : off ( var -- ) f swap set ; inline
+: get-global ( var -- value ) global hash ; inline
 : set-global ( value var -- ) global set-hash ; inline
 
 : nest ( variable -- hash )

library/threads.factor

@@ -7,11 +7,11 @@ namespaces queues sequences vectors ;
 
 ! Co-operative multitasker.
 
-: run-queue ( -- queue ) \ run-queue global hash ;
+: run-queue ( -- queue ) \ run-queue get-global ;
 
 : schedule-thread ( continuation -- ) run-queue enque ;
 
-: sleep-queue ( -- vec ) \ sleep-queue global hash ;
+: sleep-queue ( -- vec ) \ sleep-queue get-global ;
 
 : sleep-queue* ( -- vec )
     sleep-queue dup [ 2car swap - ] nsort ;

library/ui/buttons.factor

@@ -7,11 +7,14 @@ styles threads ;
 
 TUPLE: button rollover? pressed? ;
 
-: button-down? ( -- ? ) hand get hand-buttons empty? not ;
+: button-down? ( -- ? )
+    hand-buttons get-global empty? not ;
 
-: mouse-over? ( gadget -- ? ) hand get hand-gadget child? ;
+: mouse-over? ( gadget -- ? )
+    hand-gadget get-global child? ;
 
-: mouse-clicked? ( gadget -- ? ) hand get hand-clicked child? ;
+: mouse-clicked? ( gadget -- ? )
+    hand-clicked get-global child? ;
 
 : button-update ( button -- )
     dup mouse-over? over set-button-rollover?

library/ui/editors.factor

@@ -68,7 +68,8 @@ TUPLE: editor line caret font color ;
     ] with-editor ;
 
 : click-editor ( editor -- )
-    dup hand get relative first over set-caret-x request-focus ;
+    dup hand get rect-loc relative-loc
+    first over set-caret-x request-focus ;
 
 : popup-location ( editor -- loc )
     dup screen-loc swap editor-caret rect-extent nip v+ ;

library/ui/hand.factor

@@ -4,6 +4,16 @@ IN: gadgets
 USING: gadgets-labels gadgets-layouts kernel math namespaces
 queues sequences ;
 
+! Hand state
+
+SYMBOL: hand-gadget
+
+SYMBOL: hand-clicked
+SYMBOL: hand-click-loc
+
+SYMBOL: hand-buttons
+V{ } clone hand-buttons set-global
+
 ! The hand is a special gadget that holds mouse position and
 ! mouse button click state.
 
@@ -11,53 +21,50 @@ queues sequences ;
 ! - 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 click-loc click-rel clicked buttons gadget focus ;
+TUPLE: hand focus ;
 
 C: hand ( -- hand )
-    dup delegate>gadget V{ } clone over set-hand-buttons ;
+    dup delegate>gadget ;
 
 <hand> hand set-global
 
 : button-gesture ( buttons gesture -- )
     #! Send a gesture like [ button-down 2 ]; if nobody
     #! handles it, send [ button-down ].
-    swap hand get hand-clicked 3dup >r add r> handle-gesture
+    swap hand-clicked get-global 3dup >r add r> handle-gesture
     [ nip handle-gesture drop ] [ 3drop ] if ;
 
 : update-clicked ( -- )
-    hand get
+    hand-gadget get-global hand-clicked set-global
-    dup hand-gadget over set-hand-clicked
+    hand get rect-loc hand-click-loc set-global ;
-    dup screen-loc over set-hand-click-loc
-    dup hand-gadget over relative swap set-hand-click-rel ;
 
 : send-button-down ( event -- )
     update-clicked
-    dup hand get hand-buttons push
+    dup hand-buttons get-global push
     [ button-down ] button-gesture ;
 
 : send-button-up ( event -- )
-    dup hand get hand-buttons delete
+    dup hand-buttons get-global delete
     [ button-up ] button-gesture ;
 
 : send-scroll-wheel ( up/down -- )
     [ wheel-up ] [ wheel-down ] ?
-    hand get hand-gadget handle-gesture drop ;
+    hand-gadget get-global handle-gesture drop ;
 
 : drag-gesture ( -- )
     #! Send a gesture like [ drag 2 ]; if nobody handles it,
     #! send [ drag ].
-    hand get hand-buttons first [ drag ] button-gesture ;
+    hand-buttons get-global first [ drag ] button-gesture ;
 
-: fire-motion ( hand -- )
+: fire-motion ( -- )
     #! Fire a motion gesture to the gadget underneath the hand,
     #! and if a mouse button is down, fire a drag gesture to the
     #! gadget that was clicked.
-    [ motion ] over hand-gadget handle-gesture drop
+    [ motion ] hand-gadget get-global handle-gesture drop
-    hand-buttons empty? [ drag-gesture ] unless ;
+    hand-buttons get-global empty? [ drag-gesture ] unless ;
 
 : send-user-input ( string -- )
-    dup empty?
+    dup empty? [ hand get hand-focus user-input ] unless drop ;
-    [ hand get hand-focus user-input ] unless drop ;
 
 : each-gesture ( gesture seq -- )
     [ handle-gesture* drop ] each-with ;
@@ -65,7 +72,7 @@ C: hand ( -- hand )
 : hand-gestures ( new old -- )
     drop-prefix reverse-slice
     [ mouse-leave ] swap each-gesture
-    hand get fire-motion
+    fire-motion
     [ mouse-enter ] swap each-gesture ;
 
 : focus-gestures ( new old -- )
@@ -73,7 +80,7 @@ C: hand ( -- hand )
     [ lose-focus ] swap each-gesture
     [ gain-focus ] swap each-gesture ;
 
-: focused-ancestors ( hand -- seq )
+: focused-ancestors ( -- seq )
     hand get hand-focus parents reverse-slice ;
 
 : request-focus ( gadget -- )
@@ -82,7 +89,7 @@ C: hand ( -- hand )
     r> focus-gestures ;
 
 : drag-loc ( gadget -- loc )
-    hand get [ relative ] keep hand-click-rel v- ;
+    hand get rect-loc relative-loc hand-click-rel v- ;
 
 : relevant-help ( seq -- help )
     [ gadget-help ] map [ ] find nip ;
@@ -93,19 +100,19 @@ C: hand ( -- hand )
 
 : update-help ( -- string )
     #! Update mouse-over help message.
-    hand get hand-gadget parents [ relevant-help ] keep
+    hand-gadget get-global parents [ relevant-help ] keep
     dup empty? [ 2drop ] [ peek show-message ] if ;
 
 : under-hand ( -- seq )
     #! A sequence whose first element is the world and last is
     #! the current gadget, with all parents in between.
-    hand get hand-gadget parents reverse-slice ;
+    hand-gadget get-global parents reverse-slice ;
 
 : hand-grab ( world -- gadget )
     hand get rect-loc swap pick-up ;
 
 : update-hand-gadget ( world -- )
-    hand-grab hand get set-hand-gadget ;
+    hand-grab hand-gadget set-global ;
 
 : move-hand ( loc world -- )
     swap under-hand >r hand get set-rect-loc

library/ui/hierarchy.factor

@@ -78,10 +78,10 @@ M: gadget remove-notify* drop ;
     #! { 1 1 0 } - bottom right corner
     >r dup screen-loc swap rect-dim r> v* v+ ;
 
-: relative ( g1 g2 -- g2-g1 ) screen-loc swap screen-loc v- ;
+: relative-loc ( g1 point -- point-g1 ) swap screen-loc v- ;
 
 : relative-rect ( g1 g2 -- rect )
-    [ relative ] keep rect-dim <rect> ;
+    [ screen-loc relative-loc ] keep rect-dim <rect> ;
 
 : child? ( parent child -- ? ) parents memq? ;
 

library/ui/layouts.factor

@@ -10,7 +10,7 @@ IN: gadgets-layouts
 
 : invalidate* ( gadget -- ) dup invalidate forget-pref-dim ;
 
-: invalid ( -- queue ) \ invalid global hash ;
+: invalid ( -- queue ) \ invalid get-global ;
 
 <queue> \ invalid set-global
 

library/ui/menus.factor

@@ -26,7 +26,7 @@ namespaces sequences ;
 
 : show-menu ( loc menu gadget -- )
     find-world 2dup show-glass
-    dup world-glass dup menu-actions hand get set-hand-clicked
+    dup world-glass dup menu-actions hand-clicked set-global
     over >r menu-loc r> set-rect-loc ;
 
 : show-hand-menu ( menu gadget -- )

library/ui/panes.factor

@@ -40,7 +40,7 @@ SYMBOL: structured-input
 : pane-call ( quot pane -- )
     "<< command >>" over stream-print
     >r structured-input set-global
-    "\"structured-input\" \"gadgets-panes\" lookup global hash call"
+    "\"structured-input\" \"gadgets-panes\" lookup get-global call"
     r> pane-eval ;
 
 : editor-commit ( editor -- line )

library/ui/sliders.factor

@@ -70,7 +70,7 @@ SYMBOL: slider-changed
     [ slider-page * ] keep slide-by ;
 
 : elevator-click ( elevator -- )
-    dup hand get relative >r find-slider r>
+    dup hand get rect-loc relative-loc >r find-slider r>
     over gadget-orientation v.
     over screen>slider over slider-value - sgn
     swap slide-by-page ;

library/ui/timers.factor

@@ -14,7 +14,7 @@ C: timer ( object delay -- timer )
 
 GENERIC: tick ( ms object -- )
 
-: timers \ timers global hash ;
+: timers \ timers get-global ;
 
 H{ } clone \ timers set-global
 

library/vocabularies.factor

@@ -8,7 +8,7 @@ SYMBOL: bootstrapping?
 
 SYMBOL: vocabularies
 
-: word ( -- word ) \ word global hash ;
+: word ( -- word ) \ word get-global ;
 
 : set-word ( word -- ) \ word set-global ;