UI cleanups

library/cocoa/application-utils.factor

@@ -10,9 +10,8 @@ objc-NSNotificationCenter objc-NSObject objc-NSView threads ;
 
 : with-cocoa ( quot -- )
     [
-        NSApplication [sharedApplication] drop
+        NSApplication [sharedApplication] drop call
-        call
+    ] with-autorelease-pool ;
-    ] with-autorelease-pool ; inline
 
 : <NSString> <CFString> [autorelease] ;
 
@@ -23,11 +22,8 @@ objc-NSNotificationCenter objc-NSObject objc-NSView threads ;
     [nextEventMatchingMask:untilDate:inMode:dequeue:] ;
 
 : do-events ( app -- )
-    dup next-event [
+    dup next-event
-        dupd [ [sendEvent:] ] with-autorelease-pool do-events
+    [ dupd [sendEvent:] do-events ] [ drop ] if* ;
-    ] [
-        drop
-    ] if* ;
 
 : event-loop ( -- )
     [

library/cocoa/core-foundation.factor

@@ -56,7 +56,9 @@ FUNCTION: void CFRelease ( void* cf ) ;
     CFRelease ;
 
 : <CFBundle> ( string -- cf )
-    t <CFFileSystemURL> f over CFBundleCreate swap CFRelease ;
+    t <CFFileSystemURL> [
+        f swap CFBundleCreate
+    ] keep CFRelease ;
 
 : load-framework ( name -- )
     dup <CFBundle> [

library/cocoa/ui.factor

@@ -141,7 +141,8 @@ IN: gadgets-cocoa
     [initWithFrame:pixelFormat:]
     dup 1 [setPostsBoundsChangedNotifications:]
     dup 1 [setPostsFrameChangedNotifications:]
-    dup "updateFactorGadgetSize:" add-resize-observer ;
+    dup "updateFactorGadgetSize:" add-resize-observer
+    [autorelease] ;
 
 : <FactorWindow> ( gadget title -- window )
     over rect-dim first2 0 0 2swap <NSRect> <NSWindow>
@@ -149,14 +150,16 @@ IN: gadgets-cocoa
     [ swap set-world-handle ] keep
     dup 1 [setAcceptsMouseMovedEvents:]
     dup dup [contentView] [setInitialFirstResponder:]
-    dup f [makeKeyAndOrderFront:] ;
+    dup f [makeKeyAndOrderFront:]
+    [autorelease] ;
 
 IN: shells
 
 : ui
     [
         [
-            init-world
+            { 600 700 0 } <world> world set
+            <hand> hand set
 
             world get ui-title <FactorWindow>
 

library/ui/gadgets.factor

@@ -63,8 +63,6 @@ GENERIC: user-input* ( str gadget -- ? )
 
 M: gadget user-input* 2drop t ;
 
-DEFER: add-invalid
-
 GENERIC: children-on ( rect/point gadget -- list )
 
 M: gadget children-on ( rect/point gadget -- list )

library/ui/layouts.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2005, 2006 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-IN: gadgets-layouts
 USING: errors gadgets generic hashtables kernel lists math
-namespaces sequences ;
+namespaces queues sequences ;
+IN: gadgets-layouts
 
 : invalidate ( gadget -- ) t swap set-gadget-relayout? ;
 
@@ -10,6 +10,12 @@ namespaces sequences ;
 
 : invalidate* ( gadget -- ) dup invalidate forget-pref-dim ;
 
+: invalid ( -- queue ) \ invalid global hash ;
+
+<queue> \ invalid set-global
+
+: add-invalid ( gadget -- ) invalid enque ;
+
 : relayout ( gadget -- )
     #! Relayout and redraw a gadget and its parent before the
     #! next iteration of the event loop. Should be used when the
@@ -69,6 +75,10 @@ DEFER: layout
         dup layout* dup layout-children
     ] when drop ;
 
+: layout-queued ( -- )
+    invalid dup queue-empty?
+    [ drop ] [ deque layout layout-queued ] if ;
+
 TUPLE: pack align fill gap ;
 
 : pref-dims ( gadget -- list ) [ pref-dim ] map ;

library/ui/paint.factor

@@ -8,9 +8,9 @@ IN: gadgets
 SYMBOL: clip
 
 : init-gl ( dim -- )
-    0.0 0.0 0.0 0.0 glClearColor 
+    1.0 1.0 1.0 1.0 glClearColor
-    { 1.0 0.0 0.0 0.0 } gl-color
     GL_COLOR_BUFFER_BIT glClear
+    { 1.0 0.0 0.0 0.0 } gl-color
     GL_PROJECTION glMatrixMode
     glLoadIdentity
     GL_MODELVIEW glMatrixMode

library/ui/timers.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2005, 2006 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 IN: gadgets
-USING: hashtables kernel math sequences ;
+USING: hashtables kernel math namespaces sequences ;
 
 TUPLE: timer object delay last ;
 
@@ -14,7 +14,9 @@ C: timer ( object delay -- timer )
 
 GENERIC: tick ( ms object -- )
 
-DEFER: timers
+: timers \ timers global hash ;
+
+H{ } clone \ timers set-global
 
 : add-timer ( object delay -- )
     over >r <timer> r> timers set-hash ;

library/ui/world.factor

@@ -3,7 +3,8 @@
 IN: gadgets
 USING: alien arrays errors freetype gadgets-layouts
 gadgets-theme generic io kernel lists math memory namespaces
-opengl prettyprint sequences sequences strings styles threads ;
+opengl prettyprint queues sequences sequences strings styles
+threads ;
 
 DEFER: redraw-world
 
@@ -11,28 +12,15 @@ DEFER: redraw-world
 ! gadgets are contained in. The current world is stored in the
 ! world variable. The invalid slot is a list of gadgets that
 ! need to be layout.
-TUPLE: world glass status invalid timers handle ;
+TUPLE: world glass status handle ;
-
-: timers ( -- hash ) world get world-timers ;
 
 : add-layer ( gadget -- )
     world get add-gadget ;
 
-C: world ( -- world )
+C: world ( dim -- world )
     <stack> over set-delegate
-    dup solid-interior
+    [ set-gadget-dim ] keep
-    t over set-gadget-root?
+    t over set-gadget-root? ;
-    H{ } clone over set-world-timers ;
-
-: add-invalid ( gadget -- )
-    world get [ world-invalid cons ] keep set-world-invalid ;
-
-: pop-invalid ( -- list )
-    world get [ world-invalid f ] keep set-world-invalid ;
-
-: layout-world ( -- )
-    world get world-invalid
-    [ pop-invalid [ layout ] each layout-world ] when ;
 
 : hide-glass ( -- )
     f world get dup world-glass unparent set-world-glass ;
@@ -84,19 +72,5 @@ M: f set-message 2drop ;
 
 : world-step ( -- )
     do-timers
-    world get world-invalid >r layout-world r>
+    invalid queue-empty? >r layout-queued r>
-    [ update-hand world get redraw-world ] when ;
+    [ update-hand world get redraw-world ] unless ;
-
-SYMBOL: first-time
-
-global [ first-time on ] bind
-
-: init-world ( -- )
-    global [
-        first-time get [
-            <world> world set
-            { 600 700 0 } world get set-gadget-dim
-            <hand> hand set
-            first-time off
-        ] when
-    ] bind ;