slava 2006-06-02 20:28:57 +00:00
parent 2b475b4b43
commit afa4aef86b
7 changed files with 26 additions and 18 deletions

View File

@ -57,6 +57,8 @@ SYMBOL: building
: # ( n -- ) number>string % ;
: init-namespaces ( -- ) global 1array >vector set-namestack ;
IN: sequences
: prune ( seq -- seq )
@ -69,7 +71,3 @@ IN: sequences
: join ( seq glue -- seq )
[ swap [ % ] [ dup % ] interleave drop ] over make ;
flushable
IN: kernel-internals
: init-namespaces ( -- ) global 1array >vector set-namestack ;

View File

@ -22,9 +22,8 @@ namespaces objc sequences errors freetype ;
: install-app-delegate ( -- )
NSApp FactorApplicationDelegate install-delegate ;
: init-cocoa-ui ( -- )
: init-cocoa ( -- )
reset-callbacks
init-ui
install-app-delegate
register-services
default-main-menu ;
@ -68,11 +67,12 @@ IN: shells
] unless
[
[
init-cocoa-ui
init-timers
init-cocoa
restore-windows? [
restore-windows
] [
reset-windows
init-ui
listener-window
] if
finish-launching

View File

@ -16,6 +16,8 @@ GENERIC: tick ( ms object -- )
: timers \ timers get-global ;
: init-timers ( -- ) H{ } clone \ timers set-global ;
: add-timer ( object delay -- )
over >r <timer> r> timers set-hash ;

View File

@ -44,7 +44,8 @@ TUPLE: listener-gadget scroller stack ;
: <stack-bar> ( -- gadget ) <shelf> dup highlight-theme ;
: start-listener ( listener -- )
[ >r clear r> listener-thread ] in-thread drop ;
[ >r clear r> init-namespaces listener-thread ] in-thread
drop ;
C: listener-gadget ( -- gadget )
{

View File

@ -8,8 +8,6 @@ sequences threads ;
! Assoc mapping aliens to gadgets
SYMBOL: windows
: reset-windows ( hash -- hash ) V{ } clone windows set-global ;
: window ( handle -- world ) windows get-global assoc ;
: register-window ( world handle -- )
@ -41,9 +39,9 @@ SYMBOL: windows
] if ;
: init-ui ( -- )
H{ } clone \ timers set-global
<queue> \ invalid set-global ;
<queue> \ invalid set-global
V{ } clone windows set-global ;
: ui-step ( -- )
do-timers
[ layout-queued ] make-hash hash-values [
@ -85,10 +83,18 @@ C: titled-gadget ( gadget title -- )
: open-titled-window ( gadget title -- )
<titled-gadget> open-window ;
: fix-rollover ( -- )
#! After we restore the UI, send mouse leave events to all
#! gadgets that were under the mouse at the time of the
#! save, since the mouse is in a different location now.
f hand-gadget [ get-global ] 2keep set-global
parents hand-gestures ;
: restore-windows ( -- )
windows get [ second ] map
reset-windows
[ dup reset-world open-window* ] each ;
0 windows get set-length
[ dup reset-world open-window* ] each
fix-rollover ;
: restore-windows? ( -- ? )
windows get [ empty? not ] [ f ] if* ;

View File

@ -145,11 +145,11 @@ IN: shells
: ui ( -- )
[
f [
init-ui
init-timers
restore-windows? [
restore-windows
] [
reset-windows
init-ui
launchpad-window
listener-window
] if

View File

@ -239,6 +239,7 @@ SYMBOL: hWnd
"MSG" <c-object> msg-obj set
class-name ui-wndproc register-wndclassex win32-error=0
H{ } clone windows set
init-timers
init-ui ;
: cleanup-win32-ui ( -- ) class-name f UnregisterClass drop ;