Removed the world global altogether

TODO.FACTOR.txt

@@ -31,14 +31,12 @@
 
 + ui/help:
 
-- 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
 - make the UI look better, something like this:
   http://twb.ath.cx/~twb/darcs/OBSOLETE/factor/final.html

library/cocoa/application-utils.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2006 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
 IN: cocoa
-USING: alien errors gadgets io kernel namespaces objc
-objc-NSApplication objc-NSAutoreleasePool objc-NSException
+USING: alien errors gadgets gadgets-layouts io kernel namespaces
+objc objc-NSApplication objc-NSAutoreleasePool objc-NSException
 objc-NSNotificationCenter objc-NSObject objc-NSView threads ;
 
 : with-autorelease-pool ( quot -- )
@@ -28,7 +28,7 @@ objc-NSNotificationCenter objc-NSObject objc-NSView threads ;
 : event-loop ( -- )
     [
         NSApplication [sharedApplication] do-events
-        world get world-step
+        do-timers layout-queued
     ] with-autorelease-pool 10 sleep event-loop ;
 
 : add-observer ( observer selector name object -- )

library/cocoa/ui.factor

@@ -12,7 +12,7 @@ DEFER: FactorView
 
 IN: gadgets
 
-: redraw-world ( gadget -- ) world-handle 1 [setNeedsDisplay:] ;
+: repaint-handle ( handle -- ) 1 [setNeedsDisplay:] ;
 
 IN: gadgets-cocoa
 
@@ -153,9 +153,8 @@ IN: shells
 : ui
     [
         [
-            <listener>
-            { 600 700 0 } <world> world set
-            world get "Listener" <FactorWindow> drop
+            <listener> { 600 700 0 } <world>
+            "Listener" <FactorWindow> drop
             [ clear listener-thread ] in-thread
             pane get request-focus
             finish-launching

library/ui/gadgets.factor

@@ -101,3 +101,11 @@ M: gadget children-on ( rect/point gadget -- list )
 GENERIC: gadget-help
 
 M: gadget gadget-help drop f ;
+
+! Repaint/relayout protocol
+
+! This word is defined in the backend
+DEFER: repaint-handle ( handle -- )
+
+! This word is defined in world.factor
+DEFER: layout-done ( gadget -- )

library/ui/hand.factor

@@ -40,7 +40,7 @@ C: hand ( -- hand )
 
 : send-scroll-wheel ( up/down -- )
     [ wheel-up ] [ wheel-down ] ?
-    hand get hand-clicked handle-gesture drop ;
+    hand get hand-gadget handle-gesture drop ;
 
 : drag-gesture ( -- )
     #! Send a gesture like [ drag 2 ]; if nobody handles it,

library/ui/layouts.factor

@@ -25,8 +25,7 @@ IN: gadgets-layouts
     ] [
         dup invalidate*
         dup gadget-root?
-        [ add-invalid ]
-        [ gadget-parent [ relayout ] when* ] if
+        [ add-invalid ] [ gadget-parent [ relayout ] when* ] if
     ] if ;
 
 : relayout-1 ( gadget -- )
@@ -77,7 +76,7 @@ DEFER: layout
 
 : layout-queued ( -- )
     invalid dup queue-empty?
-    [ drop ] [ deque layout layout-queued ] if ;
+    [ drop ] [ deque dup layout layout-done layout-queued ] if ;
 
 TUPLE: pack align fill gap ;
 

library/ui/paint.factor

@@ -7,7 +7,10 @@ IN: gadgets
 
 SYMBOL: clip
 
+SYMBOL: world-dim
+
 : init-gl ( dim -- )
+    dup world-dim set
     { 1.0 0.0 0.0 1.0 } gl-color
     GL_PROJECTION glMatrixMode
     glLoadIdentity
@@ -46,8 +49,6 @@ 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-dim get second
@@ -66,11 +67,6 @@ SYMBOL: world-dim
         ] 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

@@ -1,12 +1,8 @@
 ! Copyright (C) 2005, 2006 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 IN: gadgets
-USING: alien arrays errors freetype gadgets-labels
-gadgets-layouts gadgets-theme generic io kernel lists math
-memory namespaces opengl prettyprint queues sequences sequences
-strings styles threads ;
-
-DEFER: redraw-world
+USING: freetype gadgets-labels gadgets-layouts gadgets-theme
+generic kernel namespaces queues sequences ;
 
 ! The world gadget is the top level gadget that all (visible)
 ! gadgets are contained in. The current world is stored in the
@@ -64,9 +60,8 @@ C: world ( gadget status dim -- world )
     #! Called when a gadget is removed or added.
     hand get rect-loc swap move-hand ;
 
-: world-step ( world -- )
-    do-timers invalid queue-empty? >r layout-queued r>
-    [ drop ] [ dup update-hand redraw-world ] if ;
+: draw-world ( world -- )
+    [ dup rect-dim init-gl draw-gadget ] with-scope ;
 
 GENERIC: find-world ( gadget -- world )
 
@@ -75,3 +70,11 @@ M: f find-world ;
 M: gadget find-world gadget-parent find-world ;
 
 M: world find-world ;
+
+: repaint ( gadget -- )
+    find-world [ world-handle repaint-handle ] when* ;
+
+: layout-done ( gadget -- )
+    find-world [
+        dup update-hand world-handle repaint-handle
+    ] when* ;