From 240c12dfc8ebddb5643643d38ff77251994ce3f6 Mon Sep 17 00:00:00 2001 From: slava Date: Wed, 15 Mar 2006 23:24:59 +0000 Subject: [PATCH] UI cleanups --- library/cocoa/application-utils.factor | 12 +++----- library/cocoa/core-foundation.factor | 4 ++- library/cocoa/ui.factor | 9 ++++-- library/ui/gadgets.factor | 2 -- library/ui/layouts.factor | 14 +++++++-- library/ui/paint.factor | 4 +-- library/ui/timers.factor | 6 ++-- library/ui/world.factor | 42 +++++--------------------- 8 files changed, 39 insertions(+), 54 deletions(-) diff --git a/library/cocoa/application-utils.factor b/library/cocoa/application-utils.factor index e857b052e6..cb8cbadc80 100644 --- a/library/cocoa/application-utils.factor +++ b/library/cocoa/application-utils.factor @@ -10,9 +10,8 @@ objc-NSNotificationCenter objc-NSObject objc-NSView threads ; : with-cocoa ( quot -- ) [ - NSApplication [sharedApplication] drop - call - ] with-autorelease-pool ; inline + NSApplication [sharedApplication] drop call + ] with-autorelease-pool ; : [autorelease] ; @@ -23,11 +22,8 @@ objc-NSNotificationCenter objc-NSObject objc-NSView threads ; [nextEventMatchingMask:untilDate:inMode:dequeue:] ; : do-events ( app -- ) - dup next-event [ - dupd [ [sendEvent:] ] with-autorelease-pool do-events - ] [ - drop - ] if* ; + dup next-event + [ dupd [sendEvent:] do-events ] [ drop ] if* ; : event-loop ( -- ) [ diff --git a/library/cocoa/core-foundation.factor b/library/cocoa/core-foundation.factor index 7b45e80240..27345f8d7c 100644 --- a/library/cocoa/core-foundation.factor +++ b/library/cocoa/core-foundation.factor @@ -56,7 +56,9 @@ FUNCTION: void CFRelease ( void* cf ) ; CFRelease ; : ( string -- cf ) - t f over CFBundleCreate swap CFRelease ; + t [ + f swap CFBundleCreate + ] keep CFRelease ; : load-framework ( name -- ) dup [ diff --git a/library/cocoa/ui.factor b/library/cocoa/ui.factor index 0964c5d55e..bf7369b8d8 100644 --- a/library/cocoa/ui.factor +++ b/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] ; : ( gadget title -- window ) over rect-dim first2 0 0 2swap @@ -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 set + hand set world get ui-title diff --git a/library/ui/gadgets.factor b/library/ui/gadgets.factor index 1b955db97c..6591bcc8bb 100644 --- a/library/ui/gadgets.factor +++ b/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 ) diff --git a/library/ui/layouts.factor b/library/ui/layouts.factor index b04bc551d7..915b14d3bd 100644 --- a/library/ui/layouts.factor +++ b/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 ; + + \ 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 ; diff --git a/library/ui/paint.factor b/library/ui/paint.factor index 8684a3077b..2a282fef75 100644 --- a/library/ui/paint.factor +++ b/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 0.0 0.0 0.0 } gl-color + 1.0 1.0 1.0 1.0 glClearColor GL_COLOR_BUFFER_BIT glClear + { 1.0 0.0 0.0 0.0 } gl-color GL_PROJECTION glMatrixMode glLoadIdentity GL_MODELVIEW glMatrixMode diff --git a/library/ui/timers.factor b/library/ui/timers.factor index cba33e0961..da007807b9 100644 --- a/library/ui/timers.factor +++ b/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 r> timers set-hash ; diff --git a/library/ui/world.factor b/library/ui/world.factor index f7a296d894..e87abe1435 100644 --- a/library/ui/world.factor +++ b/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 ; - -: timers ( -- hash ) world get world-timers ; +TUPLE: world glass status handle ; : add-layer ( gadget -- ) world get add-gadget ; -C: world ( -- world ) +C: world ( dim -- world ) over set-delegate - dup solid-interior - 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 ; + [ set-gadget-dim ] keep + t over set-gadget-root? ; : 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> - [ update-hand world get redraw-world ] when ; - -SYMBOL: first-time - -global [ first-time on ] bind - -: init-world ( -- ) - global [ - first-time get [ - world set - { 600 700 0 } world get set-gadget-dim - hand set - first-time off - ] when - ] bind ; + invalid queue-empty? >r layout-queued r> + [ update-hand world get redraw-world ] unless ;