world API changes: open-window can take a world-attributes tuple with additional parameters besides title. new begin-world, end-world, and draw-world* generics

basis/ui/gadgets/worlds/worlds.factor

@@ -4,15 +4,27 @@ USING: accessors arrays assocs continuations kernel math models
 namespaces opengl opengl.textures sequences io combinators
 combinators.short-circuit fry math.vectors math.rectangles cache
 ui.gadgets ui.gestures ui.render ui.backend ui.gadgets.tracks
-ui.commands ui.pixel-formats destructors ;
+ui.commands ui.pixel-formats destructors literals ;
 IN: ui.gadgets.worlds
 
+CONSTANT: default-world-pixel-format-attributes
+    { windowed double-buffered T{ depth-bits { value 16 } } }
+
 TUPLE: world < track
-active? focused?
-layers
-title status status-owner
-text-handle handle images
-window-loc ;
+    active? focused?
+    layers
+    title status status-owner
+    text-handle handle images
+    window-loc
+    pixel-format-attributes ;
+
+TUPLE: world-attributes
+    { world-class initial: world }
+    title
+    status
+    gadgets
+    { pixel-format-attributes initial: $ default-world-pixel-format-attributes } ;
+C: <world-attributes> world-attributes
 
 : find-world ( gadget -- world/f ) [ world? ] find-parent ;
 
@@ -45,18 +57,23 @@ M: world request-focus-on ( child gadget -- )
     2dup eq?
     [ 2drop ] [ dup focused?>> (request-focus) ] if ;
 
-: new-world ( gadget title status class -- world )
+: new-world ( class -- world )
     vertical swap new-track
         t >>root?
         t >>active?
-        { 0 0 } >>window-loc
-        swap >>status
-        swap >>title
-        swap 1 track-add
-    dup request-focus ;
+        { 0 0 } >>window-loc ;
 
-: <world> ( gadget title status -- world )
-    world new-world ;
+: apply-world-attributes ( world attributes -- world )
+    {
+        [ title>> >>title ]
+        [ status>> >>status ]
+        [ pixel-format-attributes>> >>pixel-format-attributes ]
+        [ gadgets>> [ 1 track-add ] each ]
+    } cleave ;
+
+: <world> ( world-attributes -- world )
+    [ world-class>> new-world ] keep apply-world-attributes
+    dup request-focus ;
 
 : as-big-as-possible ( world gadget -- )
     dup [ { 0 0 } >>loc over dim>> >>dim ] when 2drop ; inline
@@ -77,7 +94,17 @@ SYMBOL: flush-layout-cache-hook
 
 flush-layout-cache-hook [ [ ] ] initialize
 
-: (draw-world) ( world -- )
+GENERIC: begin-world ( world -- )
+GENERIC: end-world ( world -- )
+
+M: world begin-world
+    drop ;
+M: world end-world
+    drop ;
+
+GENERIC: draw-world* ( world -- )
+
+M: world draw-world*
     dup handle>> [
         check-extensions
         {
@@ -108,7 +135,7 @@ 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
@@ -151,8 +178,7 @@ M: world handle-gesture ( gesture gadget -- ? )
     [ get-global find-world eq? ] keep '[ f _ set-global ] when ;
 
 M: world world-pixel-format-attributes
-    drop
-    { windowed double-buffered T{ depth-bits { value 16 } } } ;
+    pixel-format-attributes>> ;
 
 M: world check-world-pixel-format
     2drop ;
@@ -160,3 +186,4 @@ M: world check-world-pixel-format
 : with-world-pixel-format ( world quot -- )
     [ dup dup world-pixel-format-attributes <pixel-format> ]
     dip [ 2dup check-world-pixel-format ] prepose with-disposal ; inline
+

basis/ui/ui.factor

@@ -4,7 +4,8 @@ USING: arrays assocs io kernel math models namespaces make dlists
 deques sequences threads sequences words continuations init
 combinators combinators.short-circuit hashtables concurrency.flags
 sets accessors calendar fry destructors ui.gadgets ui.gadgets.private
-ui.gadgets.worlds ui.gadgets.tracks ui.gestures ui.backend ui.render ;
+ui.gadgets.worlds ui.gadgets.tracks ui.gestures ui.backend ui.render
+strings ;
 IN: ui
 
 <PRIVATE
@@ -49,8 +50,17 @@ SYMBOL: windows
     f >>focused?
     focus-path f swap focus-gestures ;
 
-M: world graft*
+: try-to-open-window ( world -- )
     [ (open-window) ]
+    [ handle>> select-gl-context ]
+    [
+        [ begin-world ]
+        [ [ handle>> (close-window) ] [ ui-error ] bi* ]
+        recover
+    ] tri ;
+
+M: world graft*
+    [ try-to-open-window ]
     [ [ title>> ] keep set-title ]
     [ request-focus ] tri ;
 
@@ -66,6 +76,7 @@ M: world graft*
         [ images>> [ dispose ] when* ]
         [ hand-clicked close-global ]
         [ hand-gadget close-global ]
+        [ end-world ]
     } cleave ;
 
 M: world ungraft*
@@ -166,13 +177,17 @@ PRIVATE>
 : restore-windows? ( -- ? )
     windows get empty? not ;
 
+: ?attributes ( gadget title/attributes -- attributes )
+    dup string? [ world-attributes new swap >>title ] when
+    swap [ [ [ 1array ] [ f ] if* ] curry unless* ] curry change-gadgets ;
+
 PRIVATE>
 
 : open-world-window ( world -- )
     dup pref-dim >>dim dup relayout graft ;
 
-: open-window ( gadget title -- )
-    f <world> open-world-window ;
+: open-window ( gadget title/attributes -- )
+    ?attributes <world> open-world-window ;
 
 : set-fullscreen? ( ? gadget -- )
     find-world set-fullscreen* ;