Merge branch 'master' into new_ui

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

diff --git a/basis/ui/gadgets/worlds/worlds.factor b/basis/ui/gadgets/worlds/worlds.factor
index f57fb60bcd93e8d59c3f6a1d429b0c7771833cc2..749db69b5287cdf75e53007e8e5204268f111fa3 100644 (file)
--- a/basis/ui/gadgets/worlds/worlds.factor
+++ b/basis/ui/gadgets/worlds/worlds.factor
@@ -1,16 +1,16 @@
-! Copyright (C) 2005, 2008 Slava Pestov.
+! Copyright (C) 2005, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays assocs continuations kernel math models
-namespaces opengl sequences io combinators fry math.vectors
-ui.gadgets ui.gestures ui.render ui.backend ui.gadgets.tracks
-math.geometry.rect ;
+USING: accessors arrays assocs continuations kernel math models call
+namespaces opengl sequences io combinators combinators.short-circuit
+fry math.vectors ui.gadgets ui.gestures ui.render ui.text ui.text.private
+ui.backend ui.gadgets.tracks math.rectangles ;
 IN: ui.gadgets.worlds
 
 TUPLE: world < track
 active? focused?
 glass
 title status
-fonts handle
+text-handle handle
 window-loc ;
 
 : find-world ( gadget -- world/f ) [ world? ] find-parent ;
@@ -39,14 +39,14 @@ M: world request-focus-on ( child gadget -- )
     [ 2drop ] [ dup focused?>> (request-focus) ] if ;
 
 : new-world ( gadget title status class -- world )
-    { 0 1 } swap new-track
+    vertical swap new-track
         t >>root?
         t >>active?
-        H{ } clone >>fonts
         { 0 0 } >>window-loc
         swap >>status
         swap >>title
         swap 1 track-add
+    dup init-text-rendering
     dup request-focus ;
 
 : <world> ( gadget title status -- world )
@@ -54,9 +54,7 @@ M: world request-focus-on ( child gadget -- )
 
 M: world layout*
     dup call-next-method
-    dup glass>> [
-        [ dup rect-dim ] dip (>>dim)
-    ] when* drop ;
+    dup glass>> dup [ swap dim>> >>dim drop ] [ 2drop ] if ;
 
 M: world focusable-child* gadget-child ;
 
@@ -64,13 +62,13 @@ M: world children-on nip children>> ;
 
 : (draw-world) ( world -- )
     dup handle>> [
-        [ dup init-gl ] keep draw-gadget
+        [ init-gl ] [ draw-gadget ] [ finish-text-rendering ] tri
     ] with-gl-context ;
 
 : draw-world? ( world -- ? )
     #! We don't draw deactivated worlds, or those with 0 size.
     #! On Windows, the latter case results in GL errors.
-    [ active?>> ] [ handle>> ] [ dim>> [ 0 > ] all? ] tri and and ;
+    { [ active?>> ] [ handle>> ] [ dim>> [ 0 > ] all? ] } 1&& ;
 
 TUPLE: world-error error world ;
 
@@ -79,29 +77,27 @@ C: <world-error> world-error
 SYMBOL: ui-error-hook
 
 : ui-error ( error -- )
-    ui-error-hook get [ call ] [ die ] if* ;
+    ui-error-hook get [ call( error -- ) ] [ die drop ] if* ;
 
 ui-error-hook [ [ rethrow ] ] initialize
 
 : draw-world ( world -- )
     dup draw-world? [
         dup world [
-            [
-                (draw-world)
-            ] [
+            [ (draw-world) ] [
                 over <world-error> ui-error
                 f >>active? drop
             ] recover
         ] with-variable
-    ] [
-        drop
-    ] if ;
+    ] [ drop ] if ;
 
 world H{
-    { T{ key-down f { C+ } "x" } [ T{ cut-action } send-action ] }
-    { T{ key-down f { C+ } "c" } [ T{ copy-action } send-action ] }
-    { T{ key-down f { C+ } "v" } [ T{ paste-action } send-action ] }
-    { T{ key-down f { C+ } "a" } [ T{ select-all-action } send-action ] }
+    { T{ key-down f { C+ } "z" } [ undo-action send-action ] }
+    { T{ key-down f { C+ } "Z" } [ redo-action send-action ] }
+    { T{ key-down f { C+ } "x" } [ cut-action send-action ] }
+    { T{ key-down f { C+ } "c" } [ copy-action send-action ] }
+    { T{ key-down f { C+ } "v" } [ paste-action send-action ] }
+    { T{ key-down f { C+ } "a" } [ select-all-action send-action ] }
     { T{ button-down f { C+ } 1 } [ drop T{ button-down f f 3 } button-gesture ] }
     { T{ button-down f { A+ } 1 } [ drop T{ button-down f f 2 } button-gesture ] }
     { T{ button-down f { M+ } 1 } [ drop T{ button-down f f 2 } button-gesture ] }