1 ! Copyright (C) 2009 Joe Groff, Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: alien.c-types alien.data kernel combinators
4 sequences math windows.gdi32 windows.types images
5 destructors accessors fry locals classes.struct ;
8 : (bitmap-info) ( dim -- BITMAPINFO )
12 BITMAPINFOHEADER heap-size >>biSize
16 [ first2 * 4 * >>biSizeImage ] tri
19 BI_RGB >>biCompression
26 : make-bitmap ( dim dc -- hBitmap bits )
29 swap (bitmap-info) DIB_RGB_COLORS f <void*>
30 [ f 0 CreateDIBSection ] keep *void*
32 [ [ SelectObject drop ] keep ] dip ;
34 : make-offscreen-dc-and-bitmap ( dim -- dc hBitmap bits )
35 [ f CreateCompatibleDC ] dip over make-bitmap ;
37 : bitmap>byte-array ( bits dim -- byte-array )
38 product 4 * memory>byte-array ;
40 : bitmap>image ( bits dim -- image )
41 [ bitmap>byte-array ] keep
45 BGRX >>component-order
46 ubyte-components >>component-type
49 : with-memory-dc ( ..a quot: ( ..a hDC -- ..b ) -- ..b )
50 [ [ f CreateCompatibleDC &DeleteDC ] dip call ] with-destructors ; inline
52 :: make-bitmap-image ( dim dc quot -- image )
53 dim dc make-bitmap [ &DeleteObject drop ] dip
55 dim bitmap>image ; inline