offscreen-world widgets and offscreen pixel format fixes

basis/cocoa/views/views.factor

@@ -58,8 +58,6 @@ PRIVATE>
 : <PixelFormat> ( attributes -- pixelfmt )
     NSOpenGLPixelFormat -> alloc swap [
         %
-        NSOpenGLPFAWindow ,
-        NSOpenGLPFADoubleBuffer ,
         NSOpenGLPFADepthSize , 16 ,
         +software-renderer+ get [
             NSOpenGLPFARendererID , kCGLRendererGenericFloatID ,
@@ -75,7 +73,8 @@ PRIVATE>
     -> autorelease ;
 
 : <GLView> ( class dim -- view )
-    [ -> alloc 0 0 ] dip first2 <NSRect> { } <PixelFormat>
+    [ -> alloc 0 0 ] dip first2 <NSRect>
+    NSOpenGLPFAWindow NSOpenGLPFADoubleBuffer 2array <PixelFormat>
     -> initWithFrame:pixelFormat:
     dup 1 -> setPostsBoundsChangedNotifications:
     dup 1 -> setPostsFrameChangedNotifications: ;

basis/ui/cocoa/cocoa.factor

@@ -16,6 +16,7 @@ TUPLE: offscreen-handle < handle context buffer ;
 C: <window-handle> window-handle
 C: <offscreen-handle> offscreen-handle
 
+! XXX gross!
 M: offscreen-handle window>> drop f ;
 M: offscreen-handle view>>   drop f ;
 
@@ -104,9 +105,9 @@ M: cocoa-ui-backend raise-window* ( world -- )
     { [ * * malloc ] [ 2drop ] [ drop nip ] [ nip * ] } 3cleave ;
 
 : gadget-offscreen-context ( world -- context buffer )
-    { NSOpenGLPFAOffScreen } <PixelFormat>
-    [ NSOpenGLContext -> alloc swap f -> initWithFormat:shareContext: dup ]
-    [ offscreen-buffer ] bi
+    NSOpenGLPFAOffScreen 1array <PixelFormat>
+    [ nip NSOpenGLContext -> alloc swap f -> initWithFormat:shareContext: dup ]
+    [ offscreen-buffer ] 2bi
     4 npick [ -> setOffScreen:width:height:rowbytes: ] dip ;
 
 M: cocoa-ui-backend (open-offscreen-buffer) ( world -- )

basis/ui/gadgets/worlds/worlds.factor

@@ -13,6 +13,8 @@ title status
 fonts handle
 window-loc ;
 
+TUPLE: offscreen-world < world ;
+
 : find-world ( gadget -- world/f ) [ world? ] find-parent ;
 
 : show-status ( string/f gadget -- )
@@ -38,8 +40,8 @@ M: world request-focus-on ( child gadget -- )
     2dup eq?
     [ 2drop ] [ dup focused?>> (request-focus) ] if ;
 
-: <world> ( gadget title status -- world )
-    { 0 1 } world new-track
+: new-world ( gadget title status class -- world )
+    { 0 1 } swap new-track
         t >>root?
         t >>active?
         H{ } clone >>fonts
@@ -49,6 +51,11 @@ M: world request-focus-on ( child gadget -- )
         swap 1 track-add
     dup request-focus ;
 
+: <world> ( gadget title status -- world )
+    world new-world ;
+: <offscreen-world> ( gadget title status -- world )
+    offscreen-world new-world ;
+
 M: world layout*
     dup call-next-method
     dup glass>> [

basis/ui/ui.factor

@@ -60,23 +60,34 @@ SYMBOL: stop-after-last-window?
     focus-path f swap focus-gestures ;
 
 M: world graft*
-    dup (open-window)
-    dup title>> over set-title
-    request-focus ;
+    [ (open-window) ]
+    [ [ title>> ] keep set-title ]
+    [ request-focus ] tri ;
 
 : reset-world ( world -- )
     #! This is used when a window is being closed, but also
     #! when restoring saved worlds on image startup.
-    dup fonts>> clear-assoc
-    dup unfocus-world
-    f >>handle drop ;
+    [ fonts>> clear-assoc ]
+    [ unfocus-world ]
+    [ f >>handle drop ] tri ;
+
+: (ungraft-world) ( world -- )
+    [ free-fonts ]
+    [ hand-clicked close-global ]
+    [ hand-gadget close-global ] tri ;
 
 M: world ungraft*
-    dup free-fonts
-    dup hand-clicked close-global
-    dup hand-gadget close-global
-    dup handle>> (close-window)
-    reset-world ;
+    [ (ungraft-world) ]
+    [ handle>> (close-window) ]
+    [ reset-world ] tri ;
+
+M: offscreen-world graft*
+    (open-offscreen-buffer) ;
+
+M: offscreen-world ungraft*
+    [ (ungraft-world) ]
+    [ handle>> (close-offscreen-buffer) ]
+    [ reset-world ] tri ;
 
 : find-window ( quot -- world )
     windows get values

extra/graphics/bitmap/bitmap.factor

@@ -23,6 +23,14 @@ TUPLE: bitmap magic size reserved offset header-length width
         swap [ >>array ] [ >>color-index ] bi
         24 >>bit-count ;
 
+: bgra>bitmap ( array height width -- bitmap )
+    bitmap new
+        2over * 4 * >>size-image
+        swap >>height
+        swap >>width
+        swap [ >>array ] [ >>color-index ] bi
+        32 >>bit-count ;
+
 : 8bit>array ( bitmap -- array )
     [ rgb-quads>> 4 <sliced-groups> [ 3 head-slice ] map ]
     [ color-index>> >array ] bi [ swap nth ] with map concat ;