-! Copyright (C) 2006, 2008 Slava Pestov.
+! Copyright (C) 2006, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: arrays assocs io kernel math models namespaces make
-dlists deques sequences threads sequences words ui.gadgets
-ui.gadgets.worlds ui.gadgets.tracks ui.gestures ui.backend
-ui.render continuations init combinators hashtables
-concurrency.flags sets accessors calendar call ;
+USING: arrays assocs io kernel math models namespaces make dlists
+deques sequences threads sequences words continuations init call
+combinators hashtables concurrency.flags sets accessors calendar fry
+ui.gadgets ui.gadgets.private ui.gadgets.worlds ui.gadgets.tracks
+ui.gestures ui.backend ui.render ui.text ui.text.private ;
IN: ui
! Assoc mapping aliens to gadgets
: focus-gestures ( new old -- )
drop-prefix <reversed>
- T{ lose-focus } swap each-gesture
- T{ gain-focus } swap each-gesture ;
+ lose-focus swap each-gesture
+ gain-focus swap each-gesture ;
: focus-world ( world -- )
t >>focused?
[ f >>handle drop ] tri ;
: (ungraft-world) ( world -- )
- [ free-fonts ]
- [ hand-clicked close-global ]
- [ hand-gadget close-global ] tri ;
+ {
+ [ handle>> select-gl-context ]
+ [ fonts>> free-fonts ]
+ [ hand-clicked close-global ]
+ [ hand-gadget close-global ]
+ } cleave ;
M: world ungraft*
[ (ungraft-world) ]
windows get values
[ gadget-child swap call ] with find-last nip ; inline
-SYMBOL: ui-hook
-
: init-ui ( -- )
<dlist> \ graft-queue set-global
<dlist> \ layout-queue set-global
: restore-world ( world -- )
dup reset-world restore-gadget ;
-: restore-windows ( -- )
- windows get [ values ] keep delete-all
- [ restore-world ] each
- forget-rollover ;
-
-: restore-windows? ( -- ? )
- windows get empty? not ;
-
: update-hand ( world -- )
dup hand-world get-global eq?
[ hand-loc get-global swap move-hand ] [ drop ] if ;
: redraw-worlds ( seq -- )
[ dup update-hand draw-world ] each ;
-: notify ( gadget -- )
- dup graft-state>>
- [ first { f f } { t t } ? >>graft-state ] keep
- {
- { { f t } [ dup activate-control graft* ] }
- { { t f } [ dup deactivate-control ungraft* ] }
- } case ;
-
-: notify-queued ( -- )
- graft-queue [ notify ] slurp-deque ;
-
: send-queued-gestures ( -- )
gesture-queue [ send-queued-gesture notify-queued ] slurp-deque ;
M: object close-window
find-world [ ungraft ] when* ;
-: start-ui ( -- )
- restore-windows? [
- restore-windows
- ] [
- init-ui ui-hook get call
- ] if
- notify-ui-thread start-ui-thread ;
+: start-ui ( quot -- )
+ call notify-ui-thread start-ui-thread ;
[
f \ ui-running set-global
<flag> ui-notify-flag set-global
] "ui" add-init-hook
-HOOK: ui ui-backend ( -- )
+HOOK: (with-ui) ui-backend ( quot -- )
+
+: restore-windows ( -- )
+ [
+ windows get [ values ] [ delete-all ] bi
+ [ restore-world ] each
+ forget-rollover
+ ] (with-ui) ;
-MAIN: ui
+: restore-windows? ( -- ? )
+ windows get empty? not ;
: with-ui ( quot -- )
- ui-running? [
- call
- ] [
- f windows set-global
- [
- ui-hook set
- ui
- ] with-scope
- ] if ;
+ ui-running? [ call ] [ '[ init-ui @ ] (with-ui) ] if ;
+
+HOOK: beep ui-backend ( -- )
\ No newline at end of file