]> gitweb.factorcode.org Git - factor.git/blobdiff - basis/ui/ui.factor
Fix conflict
[factor.git] / basis / ui / ui.factor
index 78f150987f259f1c9c63937fde38c6142f607e1b..eea608d960da22d2fb092143cf2c2523d9fa1d7f 100644 (file)
@@ -1,10 +1,10 @@
-! 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
@@ -35,8 +35,8 @@ SYMBOL: windows
 
 : 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?
@@ -60,9 +60,12 @@ M: world graft*
     [ 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) ]
@@ -73,8 +76,6 @@ M: world ungraft*
     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
@@ -96,14 +97,6 @@ SYMBOL: ui-hook
 : 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 ;
@@ -119,17 +112,6 @@ SYMBOL: ui-hook
 : 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 ;
 
@@ -181,30 +163,27 @@ HOOK: close-window ui-backend ( gadget -- )
 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