Removing global world dependencies and cleaning up UI listener

library/bootstrap/boot-stage1.factor

@@ -170,13 +170,13 @@ vectors words ;
         "/library/ui/theme.factor"
         "/library/ui/hand.factor"
         "/library/ui/frames.factor"
-        "/library/ui/world.factor"
         "/library/ui/borders.factor"
         "/library/ui/labels.factor"
         "/library/ui/buttons.factor"
         "/library/ui/line-editor.factor"
         "/library/ui/sliders.factor"
         "/library/ui/scrolling.factor"
+        "/library/ui/world.factor"
         "/library/ui/menus.factor"
         "/library/ui/editors.factor"
         "/library/ui/splitters.factor"

library/cocoa/ui.factor

@@ -1,9 +1,9 @@
 ! Copyright (C) 2006 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays cocoa freetype gadgets-layouts gadgets-listener
-hashtables kernel lists math namespaces objc objc-NSApplication
+gadgets-panes hashtables kernel lists math namespaces objc
-objc-NSEvent objc-NSObject objc-NSOpenGLView objc-NSView
+objc-NSApplication objc-NSEvent objc-NSObject objc-NSOpenGLView
-objc-NSWindow sequences ;
+objc-NSView objc-NSWindow sequences threads ;
 
 ! Cocoa backend for Factor UI
 
@@ -41,7 +41,7 @@ H{ } clone views set-global
     ] keep [frame] NSRect-h swap - 0 3array ;
 
 : send-mouse-moved ( event view -- )
-    mouse-location move-hand ;
+    [ mouse-location ] keep view move-hand ;
 
 : button ( event -- n )
     #! Cocoa -> Factor UI button mapping
@@ -158,9 +158,10 @@ IN: shells
 : ui
     [
         [
-            { 600 700 0 } <world> world set
+            { 600 700 0 } >r <listener> r> <world> world set
             world get ui-title <FactorWindow>
-            listener-application
+            [ clear listener-thread ] in-thread
+            pane get request-focus
             finish-launching
             event-loop
         ] with-cocoa

library/ui/listener.factor

@@ -52,15 +52,13 @@ SYMBOL: browser-pane
         listener
     ] with-stream* ;
 
-M: label set-message ( string/f status -- )
-    set-label-text* ;
-
 : <status-bar> ( -- gadget ) "" <label> dup status-theme ;
 
-: <bottom-bar> ( -- gadget )
+: <bottom-bar> ( -- gadget status )
-    <status-bar> dup world get set-world-status
+    <status-bar> [
-    <shelf> dup stack-bar set-global
+        <shelf> dup stack-bar set-global
-    2array make-pile 1 over set-pack-fill ;
+        2array make-pile 1 over set-pack-fill
+    ] keep ;
 
 : <browser-scroller> ( -- gadget )
     <pane> dup browser-pane set-global <scroller> ;
@@ -68,16 +66,8 @@ M: label set-message ( string/f status -- )
 : <listener-scroller> ( -- gadget )
     <input-pane> dup pane set-global <scroller> ;
 
-: <listener> ( -- gadget )
+: <listener> ( -- gadget status )
     <frame> dup solid-interior
     <browser-scroller> <listener-scroller>
     0 <x-splitter> over @center frame-add
-    <bottom-bar> over @bottom frame-add ;
+    <bottom-bar> >r over @bottom frame-add r> ;
-
-: set-application ( gadget -- )
-    world get dup clear-gadget add-gadget ;
-
-: listener-application ( -- )
-    <listener> set-application
-    [ clear listener-thread ] in-thread
-    pane get request-focus ;

library/ui/menus.factor

@@ -1,5 +1,5 @@
-! Copyright (C) 2005 Slava Pestov.
+! Copyright (C) 2005, 2006 Slava Pestov.
-! See http://factor.sf.net/license.txt for BSD license.
+! See http://factorcode.org/license.txt for BSD license.
 IN: gadgets-menus
 USING: gadgets gadgets-borders gadgets-buttons gadgets-layouts
 gadgets-labels gadgets-theme generic kernel lists math
@@ -7,10 +7,11 @@ namespaces sequences ;
 
 : retarget-drag ( -- )
     hand get [ hand-gadget ] keep 2dup hand-clicked eq?
-    [ 2dup set-hand-clicked update-hand ] unless 2drop ;
+    [ 2dup set-hand-clicked world get update-hand ] unless
+    2drop ;
 
 : retarget-click ( -- )
-    hide-glass update-hand-gadget update-clicked ;
+    world get dup hide-glass update-hand-gadget update-clicked ;
 
 : menu-actions ( glass -- )
     dup [ drop retarget-drag ] [ drag ] set-action
@@ -24,7 +25,7 @@ namespaces sequences ;
     swap rect-dim world get rect-dim fit-bounds ;
 
 : show-menu ( menu loc -- )
-    >r dup dup show-glass r>
+    >r dup dup world get show-glass r>
     menu-loc swap set-rect-loc
     world get world-glass dup menu-actions
     hand get set-hand-clicked ;
@@ -34,7 +35,10 @@ namespaces sequences ;
 : menu-items ( assoc -- pile )
     #! Given an association list mapping labels to quotations.
     #! Prepend a call to hide-menu to each quotation.
-    [ uncons \ hide-glass swons >r <label> r> <roll-button> ] map
+    [
+        uncons [ world get hide-glass ] swap append
+        >r <label> r> <roll-button>
+    ] map
     make-pile 1 over set-pack-fill ;
 
 : <menu> ( assoc -- gadget )

library/ui/world.factor

@@ -1,10 +1,10 @@
 ! Copyright (C) 2005, 2006 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 IN: gadgets
-USING: alien arrays errors freetype gadgets-layouts
+USING: alien arrays errors freetype gadgets-labels
-gadgets-theme generic io kernel lists math memory namespaces
+gadgets-layouts gadgets-theme generic io kernel lists math
-opengl prettyprint queues sequences sequences strings styles
+memory namespaces opengl prettyprint queues sequences sequences
-threads ;
+strings styles threads ;
 
 DEFER: redraw-world
 
@@ -14,58 +14,55 @@ DEFER: redraw-world
 ! need to be layout.
 TUPLE: world glass status handle ;
 
-: add-layer ( gadget -- )
+C: world ( gadget status dim -- world )
-    world get add-gadget ;
-
-C: world ( dim -- world )
     <stack> over set-delegate
+    t over set-gadget-root?
     [ set-gadget-dim ] keep
-    t over set-gadget-root? ;
+    [ set-world-status ] keep
+    [ add-gadget ] keep ;
 
-: hide-glass ( -- )
+: hide-glass ( world -- )
-    f world get dup world-glass unparent set-world-glass ;
+    dup world-glass unparent f swap set-world-glass ;
 
-: show-glass ( gadget -- )
+: <glass> ( gadget -- glass )
-    hide-glass
+    <gadget> 2dup add-gadget swap prefer ;
-    <gadget> dup add-layer dup world get set-world-glass
-    dupd add-gadget prefer ;
 
-! Status bar protocol
+: show-glass ( gadget world -- )
-GENERIC: set-message ( string/f status -- )
+    dup hide-glass
+    >r <glass> r> 2dup add-gadget
+    set-world-glass ;
 
-M: f set-message 2drop ;
+: relevant-help ( seq -- help )
+    [ gadget-help ] map [ ] find nip ;
 
 : show-message ( string/f -- )
     #! Show a message in the status bar.
-    world get world-status set-message ;
+    world-status set-label-text* ;
 
-: relevant-help ( -- string )
+: update-help ( -- string )
-    hand get hand-gadget
-    parents [ gadget-help ] map [ ] find nip ;
-
-: update-help ( -- )
     #! Update mouse-over help message.
-    relevant-help show-message ;
+    hand get hand-gadget 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-grab ( -- gadget )
+: hand-grab ( world -- gadget )
-    hand get rect-loc world get pick-up ;
+    hand get rect-loc swap pick-up ;
 
-: update-hand-gadget ( -- )
+: update-hand-gadget ( world -- )
     hand-grab hand get set-hand-gadget ;
 
-: move-hand ( loc -- )
+: move-hand ( loc world -- )
-    under-hand >r hand get set-rect-loc
+    swap under-hand >r hand get set-rect-loc
     update-hand-gadget
     under-hand r> hand-gestures update-help ;
 
-: update-hand ( -- )
+: update-hand ( world -- )
     #! Called when a gadget is removed or added.
-    hand get rect-loc move-hand ;
+    hand get rect-loc swap move-hand ;
 
 : ui-title
     [ "Factor " % version % " - " % image % ] "" make ;
@@ -73,4 +70,4 @@ M: f set-message 2drop ;
 : world-step ( -- )
     do-timers
     invalid queue-empty? >r layout-queued r>
-    [ update-hand world get redraw-world ] unless ;
+    [ world get update-hand world get redraw-world ] unless ;