Remove most usages of the global 'world'

TODO.FACTOR.txt

@@ -31,7 +31,12 @@
 
 + ui/help:
 
-- unregister notifications in dealloc
+- flickering incremental layout
+- expired aliens in view hash
+- try launchpad with bevel buttons replaced by buttons: there's
+  overpainting
+- artifacts while resizing
+- unregister notifications and the view in dealloc
 - segfault when closing window
 - wheel mouse is a bit funny
 - changelog in the UI

library/cocoa/application-utils.factor

@@ -27,7 +27,8 @@ objc-NSNotificationCenter objc-NSObject objc-NSView threads ;
 
 : event-loop ( -- )
     [
-        NSApplication [sharedApplication] do-events world-step
+        NSApplication [sharedApplication] do-events
+        world get world-step
     ] with-autorelease-pool 10 sleep event-loop ;
 
 : add-observer ( observer selector name object -- )

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
-gadgets-panes hashtables kernel lists math namespaces objc
-objc-NSApplication objc-NSEvent objc-NSObject objc-NSOpenGLView
-objc-NSView objc-NSWindow sequences threads ;
+USING: arrays cocoa freetype gadgets-layouts
+gadgets-listener gadgets-panes hashtables kernel lists math
+namespaces objc objc-NSApplication objc-NSEvent objc-NSObject
+objc-NSOpenGLView objc-NSView objc-NSWindow sequences threads ;
 
 ! Cocoa backend for Factor UI
 
@@ -29,11 +29,6 @@ H{ } clone views set-global
 
 : view ( handle -- world ) views get hash ;
 
-: draw-view ( view -- )
-    dup [openGLContext] [
-        dup view-dim init-gl view draw-gadget
-    ] with-gl-context ;
-
 : mouse-location ( event view -- loc )
     [
         swap [locationInWindow] f [convertPoint:fromView:]
@@ -85,7 +80,7 @@ H{ } clone views set-global
 
 "NSOpenGLView" "FactorView" {
     { "drawRect:" "void" { "id" "SEL" "NSRect" }
-        [ 2drop draw-view ]
+        [ 2drop [ view draw-world ] with-gl-view ]
     }
     
     { "mouseMoved:" "void" { "id" "SEL" "id" }
@@ -158,8 +153,9 @@ IN: shells
 : ui
     [
         [
-            { 600 700 0 } >r <listener> r> <world> world set
-            world get ui-title <FactorWindow>
+            <listener>
+            { 600 700 0 } <world> world set
+            world get "Listener" <FactorWindow> drop
             [ clear listener-thread ] in-thread
             pane get request-focus
             finish-launching

library/cocoa/view-utils.factor

@@ -16,6 +16,9 @@ objc-NSOpenGLView objc-NSView opengl sequences ;
     [ [makeCurrentContext] call glFlush ] keep
     [flushBuffer] ; inline
 
+: with-gl-view ( view quot -- | quot: view -- )
+    >r dup [openGLContext] r> with-gl-context ; inline
+
 : view-dim [bounds] dup NSRect-w swap NSRect-h 0 3array ;
 
 : NSViewFrameDidChangeNotification

library/ui/commands.factor

@@ -1,5 +1,5 @@
 IN: gadgets-presentations
-USING: compiler gadgets gadgets-buttons gadgets-listener
+USING: arrays compiler gadgets gadgets-buttons gadgets-listener
 gadgets-menus gadgets-panes generic hashtables inference
 inspector io jedit kernel lists namespaces parser prettyprint
 sequences strings styles words ;
@@ -39,7 +39,7 @@ TUPLE: command-button object ;
 
 : <command-menu-item> ( presented command -- item )
     [ command>quot [ drop ] swap append ] keep
-    command-name swons ;
+    command-name swap 2array ;
 
 : <command-menu> ( presented -- menu )
     dup applicable
@@ -47,7 +47,7 @@ TUPLE: command-button object ;
 
 : command-menu ( command-button -- )
     dup button-update
-    command-button-object <command-menu>
+    [ command-button-object <command-menu> ] keep
     show-hand-menu ;
 
 : command-button-actions ( gadget -- )

library/ui/editors.factor

@@ -74,13 +74,14 @@ TUPLE: editor line caret font color ;
     dup screen-loc swap editor-caret rect-extent nip v+ ;
 
 : <completion-item> ( completion editor -- menu-item )
-    dupd [ [ complete ] with-editor drop ] curry curry cons ;
+    dupd [ [ complete ] with-editor drop ] curry curry 2array ;
 
 : <completion-menu> ( editor completions -- menu )
     [ swap <completion-item> ] map-with <menu> ;
 
 : completion-menu ( editor completions -- )
-    over >r <completion-menu> r> popup-location show-menu ;
+    over popup-location -rot
+    over >r <completion-menu> r> show-menu ;
 
 : do-completion-1 ( editor completions -- )
     swap [ first complete ] with-editor ;

library/ui/launchpad.factor

@@ -0,0 +1,18 @@
+IN: gadgets-launchpad
+USING: gadgets-buttons gadgets-labels gadgets-layouts io kernel
+memory namespaces sequences ;
+
+: <launchpad> ( menu -- )
+    [ first2 >r <label> r> <bevel-button> ] map make-pile ;
+
+: default-launchpad
+    {
+        { "Listener" [ global [ "Hi" print ] bind drop ] }
+        { "Browser" [ global [ "Hi" print ] bind drop ] }
+        { "Inspector" [ global [ "Hi" print ] bind drop ] }
+        { "Help" [ global [ "Hi" print ] bind drop ] }
+        { "Tutorial" [ global [ "Hi" print ] bind drop ] }
+        { "System" [ global [ "Hi" print ] bind drop ] }
+        { "Save image" [ save ] }
+        { "Exit" [ 0 exit ] }
+    } <launchpad> ;

library/ui/menus.factor

@@ -5,40 +5,36 @@ USING: gadgets gadgets-borders gadgets-buttons gadgets-layouts
 gadgets-labels gadgets-theme generic kernel lists math
 namespaces sequences ;
 
-: retarget-drag ( -- )
+: retarget-drag ( gadget -- )
     hand get [ hand-gadget ] keep 2dup hand-clicked eq?
-    [ 2dup set-hand-clicked world get update-hand ] unless
-    2drop ;
+    [ 3drop ] [ set-hand-clicked update-hand ] if ;
 
-: retarget-click ( -- )
-    world get dup hide-glass update-hand-gadget update-clicked ;
+: retarget-click ( gadget -- )
+    find-world dup hide-glass update-hand-gadget
+    update-clicked ;
 
 : menu-actions ( glass -- )
-    dup [ drop retarget-drag ] [ drag ] set-action
-    [ drop retarget-click ] [ button-down ] set-action ;
+    dup [ retarget-drag ] [ drag ] set-action
+    [ retarget-click ] [ button-down ] set-action ;
 
-: fit-bounds ( loc dim max -- loc )
-    #! Adjust loc to fit inside max.
-    swap |v-| vmin ;
+: menu-loc ( loc menu world -- loc )
+    [ rect-dim ] 2apply swap |v-| vmin ;
 
-: menu-loc ( menu loc -- loc )
-    swap rect-dim world get rect-dim fit-bounds ;
+: show-menu ( loc menu gadget -- )
+    find-world 2dup show-glass
+    dup world-glass dup menu-actions hand get set-hand-clicked
+    over >r menu-loc r> set-rect-loc ;
 
-: show-menu ( menu loc -- )
-    >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 ;
+: show-hand-menu ( menu gadget -- )
+    hand get rect-loc -rot show-menu ;
 
-: show-hand-menu ( menu -- ) hand get rect-loc show-menu ;
+: menu-item-quot ( quot -- quot )
+    [ keep find-world hide-glass ] curry ;
 
 : menu-items ( assoc -- pile )
     #! Given an association list mapping labels to quotations.
     #! Prepend a call to hide-menu to each quotation.
-    [
-        uncons [ world get hide-glass ] swap append
-        >r <label> r> <roll-button>
-    ] map
+    [ first2 menu-item-quot >r <label> r> <roll-button> ] map
     make-pile 1 over set-pack-fill ;
 
 : <menu> ( assoc -- gadget )

library/ui/paint.factor

@@ -8,9 +8,7 @@ IN: gadgets
 SYMBOL: clip
 
 : init-gl ( dim -- )
-    1.0 1.0 1.0 1.0 glClearColor
-    GL_COLOR_BUFFER_BIT glClear
-    { 1.0 0.0 0.0 0.0 } gl-color
+    { 1.0 0.0 0.0 1.0 } gl-color
     GL_PROJECTION glMatrixMode
     glLoadIdentity
     GL_MODELVIEW glMatrixMode
@@ -22,7 +20,9 @@ SYMBOL: clip
     GL_BLEND glEnable
     GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA glBlendFunc
     GL_SCISSOR_TEST glEnable
-    GL_MODELVIEW glMatrixMode ;
+    GL_MODELVIEW glMatrixMode
+    1.0 1.0 1.0 1.0 glClearColor
+    GL_COLOR_BUFFER_BIT glClear ;
 
 GENERIC: draw-gadget* ( gadget -- )
 
@@ -46,9 +46,11 @@ DEFER: world
         draw-gadget*
     ] keep vneg gl-translate ;
 
+SYMBOL: world-dim
+
 : gl-set-clip ( loc dim -- )
     dup first2 1+ >r >r
-    over second swap second + world get rect-dim second
+    over second swap second + world-dim get second
     swap - >r first r> r> r> glScissor ;
 
 : do-clip ( gadget -- )
@@ -64,6 +66,11 @@ DEFER: world
         ] with-scope
     ] when drop ;
 
+: draw-world ( world -- )
+    [
+        dup rect-dim dup world-dim set init-gl draw-gadget
+    ] with-scope ;
+
 ! Pen paint properties
 M: f draw-interior 2drop ;
 M: f draw-boundary 2drop ;

library/ui/world.factor

@@ -64,10 +64,14 @@ C: world ( gadget status dim -- world )
     #! Called when a gadget is removed or added.
     hand get rect-loc swap move-hand ;
 
-: ui-title
-    [ "Factor " % version % " - " % image % ] "" make ;
+: world-step ( world -- )
+    do-timers invalid queue-empty? >r layout-queued r>
+    [ drop ] [ dup update-hand redraw-world ] if ;
 
-: world-step ( -- )
-    do-timers
-    invalid queue-empty? >r layout-queued r>
-    [ world get update-hand world get redraw-world ] unless ;
+GENERIC: find-world ( gadget -- world )
+
+M: f find-world ;
+
+M: gadget find-world gadget-parent find-world ;
+
+M: world find-world ;