Use factor.com to get stdout

[factor.git] / basis / windows / offscreen / offscreen.factor

diff --git a/basis/windows/offscreen/offscreen.factor b/basis/windows/offscreen/offscreen.factor
index 4eee68c37a7b4b455b36b956e00f6144e16278d0..ae05d801b6404cca5983573a30d33036883e749f 100644 (file)
--- a/basis/windows/offscreen/offscreen.factor
+++ b/basis/windows/offscreen/offscreen.factor
@@ -1,47 +1,55 @@
 ! Copyright (C) 2009 Joe Groff, Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: alien.c-types kernel combinators sequences
-math windows.gdi32 windows.types images destructors
-accessors fry ;
+! See https://factorcode.org/license.txt for BSD license.
+USING: alien.c-types alien.data kernel combinators
+sequences math windows.gdi32 windows.types images
+destructors accessors fry locals classes.struct ;
 IN: windows.offscreen
 
 : (bitmap-info) ( dim -- BITMAPINFO )
-    "BITMAPINFO" <c-object> [
-        BITMAPINFO-bmiHeader {
-            [ nip "BITMAPINFOHEADER" heap-size swap set-BITMAPINFOHEADER-biSize ]
-            [ [ first ] dip set-BITMAPINFOHEADER-biWidth ]
-            [ [ second ] dip set-BITMAPINFOHEADER-biHeight ]
-            [ nip 1 swap set-BITMAPINFOHEADER-biPlanes ]
-            [ nip 32 swap set-BITMAPINFOHEADER-biBitCount ]
-            [ nip BI_RGB swap set-BITMAPINFOHEADER-biCompression ]
-            [ [ first2 * 4 * ] dip set-BITMAPINFOHEADER-biSizeImage ]
-            [ nip 72 swap set-BITMAPINFOHEADER-biXPelsPerMeter ]
-            [ nip 72 swap set-BITMAPINFOHEADER-biYPelsPerMeter ]
-            [ nip 0 swap set-BITMAPINFOHEADER-biClrUsed ]
-            [ nip 0 swap set-BITMAPINFOHEADER-biClrImportant ]
-        } 2cleave
-    ] keep ;
+    [
+        BITMAPINFO new
+        dup bmiHeader>>
+        BITMAPINFOHEADER heap-size >>biSize
+    ] dip
+        [ first >>biWidth ]
+        [ second >>biHeight ]
+        [ first2 * 4 * >>biSizeImage ] tri
+        1 >>biPlanes
+        32 >>biBitCount
+        BI_RGB >>biCompression
+        72 >>biXPelsPerMeter
+        72 >>biYPelsPerMeter
+        0 >>biClrUsed
+        0 >>biClrImportant
+        drop ;
 
-: make-offscreen-dc-and-bitmap ( dim -- hDC hBitmap bits )
-    f CreateCompatibleDC
+: make-bitmap ( dim dc -- hBitmap bits )
     [ nip ]
     [
-        swap (bitmap-info) DIB_RGB_COLORS f <void*>
-        [ f 0 CreateDIBSection ] keep *void*
+        swap (bitmap-info) DIB_RGB_COLORS { void* }
+        [ f 0 CreateDIBSection ] with-out-parameters
     ] 2bi
-    [ 2dup SelectObject drop ] dip ;
+    [ [ SelectObject drop ] keep ] dip ;
+
+: make-offscreen-dc-and-bitmap ( dim -- dc hBitmap bits )
+    [ f CreateCompatibleDC ] dip over make-bitmap ;
 
 : bitmap>byte-array ( bits dim -- byte-array )
     product 4 * memory>byte-array ;
 
 : bitmap>image ( bits dim -- image )
     [ bitmap>byte-array ] keep
-    <image> swap >>dim swap >>bitmap XBGR >>component-order ;
+    <image>
+        swap >>dim
+        swap >>bitmap
+        BGRX >>component-order
+        ubyte-components >>component-type
+        t >>upside-down? ;
+
+: with-memory-dc ( ..a quot: ( ..a hDC -- ..b ) -- ..b )
+    [ [ f CreateCompatibleDC &DeleteDC ] dip call ] with-destructors ; inline
 
-: make-bitmap-image ( dim quot: ( hDC -- ) -- image )
-    '[
-        [
-            make-offscreen-dc-and-bitmap
-            [ &DeleteDC @ ] [ &DeleteObject drop ] [ ] tri*
-        ] keep bitmap>byte-array
-    ] with-destructors ; inline
\ No newline at end of file
+:: make-bitmap-image ( dim dc quot -- image )
+    dim dc make-bitmap [ &DeleteObject drop ] dip
+    quot dip
+    dim bitmap>image ; inline