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
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
20 : <GpRect> ( x y w h -- rect )
\r
21 GpRect <struct-boa> ; inline
\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
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 with-out-parameters ;
\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
47 :: data>image ( w h pixels -- image )
\r
51 BGRA >>component-order
\r
52 ubyte-components >>component-type
\r
57 M: gdi+-image stream>image
\r
59 start-gdi+ &stop-gdi+ drop
\r
63 ] with-destructors ;
\r