! 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 continuations init
+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 ;
+destructors ui.gadgets ui.gadgets.private ui.gadgets.worlds
+ui.gadgets.tracks ui.gestures ui.backend ui.render ui.text
+ui.text.private ;
IN: ui
+<PRIVATE
+
! Assoc mapping aliens to gadgets
SYMBOL: windows
: reset-world ( world -- )
#! This is used when a window is being closed, but also
#! when restoring saved worlds on image startup.
- [ fonts>> clear-assoc ]
- [ unfocus-world ]
- [ f >>handle drop ] tri ;
+ f >>handle unfocus-world ;
: (ungraft-world) ( world -- )
{
[ handle>> select-gl-context ]
- [ fonts>> free-fonts ]
+ [ text-handle>> dispose ]
+ [ images>> [ dispose ] when* ]
[ hand-clicked close-global ]
[ hand-gadget close-global ]
} cleave ;
[ handle>> (close-window) ]
[ reset-world ] tri ;
-: find-window ( quot -- world )
- windows get values
- [ gadget-child swap call ] with find-last nip ; inline
-
: init-ui ( -- )
<dlist> \ graft-queue set-global
<dlist> \ layout-queue set-global
children>> [ restore-gadget ] each ;
: restore-world ( world -- )
- dup reset-world restore-gadget ;
+ {
+ [ reset-world ]
+ [ init-text-rendering ]
+ [ f >>images drop ]
+ [ restore-gadget ]
+ } cleave ;
: update-hand ( world -- )
dup hand-world get-global eq?
: update-ui ( -- )
[
- [
- notify-queued
- layout-queued
- redraw-worlds
- send-queued-gestures
- ] assert-depth
+ notify-queued
+ layout-queued
+ redraw-worlds
+ send-queued-gestures
] [ ui-error ] recover ;
SYMBOL: ui-thread
t \ ui-running set-global
[ f \ ui-running set-global ] [ ] cleanup ; inline
+PRIVATE>
+
+: find-window ( quot -- world )
+ windows get values
+ [ gadget-child swap call ] with find-last nip ; inline
+
: ui-running? ( -- ? )
\ ui-running get-global ;
+<PRIVATE
+
: update-ui-loop ( -- )
[ ui-running? ui-thread get-global self eq? and ]
[ ui-notify-flag get lower-flag update-ui ]
- [ ] while ;
+ while ;
: start-ui-thread ( -- )
[ self ui-thread set-global update-ui-loop ]
"UI update" spawn drop ;
+: start-ui ( quot -- )
+ call notify-ui-thread start-ui-thread ;
+
+: restore-windows ( -- )
+ [
+ windows get [ values ] [ delete-all ] bi
+ [ restore-world ] each
+ forget-rollover
+ ] (with-ui) ;
+
+: restore-windows? ( -- ? )
+ windows get empty? not ;
+
+PRIVATE>
+
: open-world-window ( world -- )
dup pref-dim >>dim dup relayout graft ;
M: object close-window
find-world [ ungraft ] when* ;
-: 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: (with-ui) ui-backend ( quot -- )
-
-: restore-windows ( -- )
- [
- windows get [ values ] [ delete-all ] bi
- [ restore-world ] each
- forget-rollover
- ] (with-ui) ;
-
-: restore-windows? ( -- ? )
- windows get empty? not ;
-
: with-ui ( quot -- )
ui-running? [ call ] [ '[ init-ui @ ] (with-ui) ] if ;