win32 offscreen refinements

basis/ui/backend/backend.factor

@@ -27,7 +27,7 @@ GENERIC: select-gl-context ( handle -- )
 
 GENERIC: flush-gl-context ( handle -- )
 
-GENERIC: offscreen-pixels ( handle -- alien )
+HOOK: offscreen-pixels ui-backend ( world -- alien w h )
 
 HOOK: beep ui-backend ( -- )
 

basis/ui/cocoa/cocoa.factor

@@ -123,8 +123,8 @@ M: handle select-gl-context ( handle -- )
 M: handle flush-gl-context ( handle -- )
     (gl-context) -> flushBuffer ;
 
-M: offscreen-handle offscreen-pixels ( handle -- alien )
-    buffer>> ;
+M: cocoa-ui-backend offscreen-pixels ( world -- alien w h )
+    [ handle>> buffer>> ] [ dim>> first2 neg ] ;
 
 M: cocoa-ui-backend beep ( -- )
     NSBeep ;

basis/ui/windows/windows.factor

@@ -6,7 +6,7 @@ ui.gadgets ui.backend ui.clipboards ui.gadgets.worlds
 ui.gestures io kernel math math.vectors namespaces make
 sequences strings vectors words windows.kernel32 windows.gdi32
 windows.user32 windows.opengl32 windows.messages windows.types
-windows.nt windows threads libc combinators
+windows.nt windows threads libc combinators fry
 combinators.short-circuit continuations command-line shuffle
 opengl ui.render ascii math.bitwise locals symbols accessors
 math.geometry.rect math.order ascii calendar
@@ -544,8 +544,20 @@ M: windows-ui-backend (close-offscreen-buffer) ( handle -- )
     [ hDC>> DeleteDC drop ]
     [ hBitmap>> DeleteObject drop ] bi ;
 
-M: win-offscreen offscreen-pixels ( handle -- alien )
-    bits>> ;
+! Windows 32-bit bitmaps don't actually use the alpha byte of
+! each pixel; it's left as zero
+
+: (make-opaque) ( byte-array -- byte-array' )
+    [ length 4 / ]
+    [ '[ 255 swap 4 * 3 + _ set-nth ] each ]
+    [ ] tri ;
+
+: (opaque-pixels) ( world -- pixels )
+    [ handle>> bits>> ] [ dim>> first2 * 4 * ] bi
+    memory>byte-array (make-opaque) ;
+
+M: windows-ui-backend offscreen-pixels ( world -- alien w h )
+    [ (opaque-pixels) ] [ dim>> first2 ] bi ;
 
 M: windows-ui-backend raise-window* ( world -- )
     handle>> [

extra/ui/offscreen/offscreen.factor

@@ -23,9 +23,11 @@ M: offscreen-world ungraft*
     ungraft notify-queued ;
 
 : offscreen-world>bitmap ( world -- bitmap )
-    [ handle>> offscreen-pixels ] [ dim>> first2 neg ] bi
-    bgra>bitmap ;
+    offscreen-pixels bgra>bitmap ;
 
 : do-offscreen ( gadget quot: ( offscreen-world -- ) -- )
     [ open-offscreen ] dip
-    over [ slip ] [ close-offscreen ] [ ] cleanup ;
+    over [ slip ] [ close-offscreen ] [ ] cleanup ; inline
+
+: gadget>bitmap ( gadget -- bitmap )
+    [ offscreen-world>bitmap ] do-offscreen ;