]> gitweb.factorcode.org Git - factor.git/blobdiff - basis/windows/offscreen/offscreen.factor
vm: fix arm files
[factor.git] / basis / windows / offscreen / offscreen.factor
old mode 100755 (executable)
new mode 100644 (file)
index 6e65958..ae05d80
@@ -1,32 +1,33 @@
 ! 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 locals ;
+! 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-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
     [ [ SelectObject drop ] keep ] dip ;
 
@@ -42,12 +43,13 @@ IN: windows.offscreen
         swap >>dim
         swap >>bitmap
         BGRX >>component-order
+        ubyte-components >>component-type
         t >>upside-down? ;
 
-: with-memory-dc ( quot: ( hDC -- ) -- )
+: with-memory-dc ( ..a quot: ( ..a hDC -- ..b ) -- ..b )
     [ [ f CreateCompatibleDC &DeleteDC ] dip call ] with-destructors ; inline
 
 :: make-bitmap-image ( dim dc quot -- image )
     dim dc make-bitmap [ &DeleteObject drop ] dip
     quot dip
-    dim bitmap>image ; inline
\ No newline at end of file
+    dim bitmap>image ; inline