Merge OneEyed's patch

[factor.git] / basis / ui / ui.factor

diff --git a/basis/ui/ui.factor b/basis/ui/ui.factor
index 8c84dd691c8dbd40f526a3963f508c5d91edf87d..42885aecb70c7bb6145a4757aa41200b36c62b8c 100644 (file)
--- a/basis/ui/ui.factor
+++ b/basis/ui/ui.factor
@@ -1,12 +1,15 @@
 ! 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
 
@@ -55,14 +58,13 @@ M: world graft*
 : 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 ;
@@ -72,10 +74,6 @@ M: world ungraft*
     [ 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
@@ -95,7 +93,12 @@ M: world ungraft*
     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?
@@ -117,12 +120,10 @@ M: world ungraft*
 
 : 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
@@ -131,18 +132,41 @@ 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 ;
 
@@ -163,26 +187,11 @@ HOOK: close-window ui-backend ( gadget -- )
 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 ;