basis/windows/offscreen/offscreen.factor

   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 ;
   6 IN: windows.offscreen
   7
   8 : (bitmap-info) ( dim -- BITMAPINFO )
   9     [
  10         BITMAPINFO new
  11         dup bmiHeader>>
  12         BITMAPINFOHEADER heap-size >>biSize
  13     ] dip
  14         [ first >>biWidth ]
  15         [ second >>biHeight ]
  16         [ first2 * 4 * >>biSizeImage ] tri
  17         1 >>biPlanes
  18         32 >>biBitCount
  19         BI_RGB >>biCompression
  20         72 >>biXPelsPerMeter
  21         72 >>biYPelsPerMeter
  22         0 >>biClrUsed
  23         0 >>biClrImportant
  24         drop ;
  25
  26 : make-bitmap ( dim dc -- hBitmap bits )
  27     [ nip ]
  28     [
  29         swap (bitmap-info) DIB_RGB_COLORS { void* }
  30         [ f 0 CreateDIBSection ] with-out-parameters
  31     ] 2bi
  32     [ [ SelectObject drop ] keep ] dip ;
  33
  34 : make-offscreen-dc-and-bitmap ( dim -- dc hBitmap bits )
  35     [ f CreateCompatibleDC ] dip over make-bitmap ;
  36
  37 : bitmap>byte-array ( bits dim -- byte-array )
  38     product 4 * memory>byte-array ;
  39
  40 : bitmap>image ( bits dim -- image )
  41     [ bitmap>byte-array ] keep
  42     <image>
  43         swap >>dim
  44         swap >>bitmap
  45         BGRX >>component-order
  46         ubyte-components >>component-type
  47         t >>upside-down? ;
  48
  49 : with-memory-dc ( ..a quot: ( ..a hDC -- ..b ) -- ..b )
  50     [ [ f CreateCompatibleDC &DeleteDC ] dip call ] with-destructors ; inline
  51
  52 :: make-bitmap-image ( dim dc quot -- image )
  53     dim dc make-bitmap [ &DeleteObject drop ] dip
  54     quot dip
  55     dim bitmap>image ; inline