basis/images/gdiplus/gdiplus.factor

   1 ! (c)2010 Joe Groff bsd license\r
   2 USING: accessors alien.c-types alien.data alien.enums\r
   3 classes.struct destructors images images.loader\r
   4 io.streams.limited kernel locals math windows.com\r
   5 windows.gdiplus windows.streams windows.types typed\r
   6 byte-arrays grouping sequences ;\r
   7 IN: images.gdiplus\r
   8 \r
   9 SINGLETON: gdi+-image\r
  10 "png" gdi+-image register-image-class\r
  11 "tif" gdi+-image register-image-class\r
  12 "tiff" gdi+-image register-image-class\r
  13 "gif" gdi+-image register-image-class\r
  14 "jpg" gdi+-image register-image-class\r
  15 "jpeg" gdi+-image register-image-class\r
  16 "bmp" gdi+-image register-image-class\r
  17 "ico" gdi+-image register-image-class\r
  18 \r
  19 <PRIVATE\r
  20 : <GpRect> ( x y w h -- rect )\r
  21     GpRect <struct-boa> ; inline\r
  22 \r
  23 : stream>gdi+-bitmap ( stream -- bitmap )\r
  24     stream>IStream &com-release\r
  25     { void* } [ GdipCreateBitmapFromStream check-gdi+-status ]\r
  26     [ ] with-out-parameters &GdipFree ;\r
  27 \r
  28 : gdi+-bitmap-width ( bitmap -- w )\r
  29     { UINT } [ GdipGetImageWidth check-gdi+-status ]\r
  30     [ ] with-out-parameters ;\r
  31 : gdi+-bitmap-height ( bitmap -- w )\r
  32     { UINT } [ GdipGetImageHeight check-gdi+-status ]\r
  33     [ ] with-out-parameters ;\r
  34 : gdi+-lock-bitmap ( bitmap rect mode format -- data )\r
  35     { BitmapData } [ GdipBitmapLockBits check-gdi+-status ]\r
  36     [ clone ] with-out-parameters ;\r
  37 \r
  38 :: gdi+-bitmap>data ( bitmap -- w h pixels )\r
  39     bitmap [ gdi+-bitmap-width ] [ gdi+-bitmap-height ] bi :> ( w h )\r
  40     bitmap 0 0 w h <GpRect> ImageLockModeRead enum>number\r
  41     PixelFormat32bppARGB gdi+-lock-bitmap :> bitmap-data\r
  42     bitmap-data [ Scan0>> ] [ Stride>> ] [ Height>> * ] tri\r
  43     memory>byte-array :> pixels\r
  44     bitmap bitmap-data GdipBitmapUnlockBits check-gdi+-status\r
  45     w h pixels ;\r
  46     \r
  47 :: data>image ( w h pixels -- image )\r
  48     image new\r
  49         { w h } >>dim\r
  50         pixels >>bitmap\r
  51         BGRA >>component-order\r
  52         ubyte-components >>component-type\r
  53         f >>upside-down? ;\r
  54 \r
  55 PRIVATE>\r
  56 \r
  57 M: gdi+-image stream>image\r
  58     drop [\r
  59         start-gdi+ &stop-gdi+ drop\r
  60         stream>gdi+-bitmap\r
  61         gdi+-bitmap>data\r
  62         data>image\r
  63     ] with-destructors ;\r