1 ! Copyright (C) 2010 Joe Groff.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors alien alien.c-types alien.data alien.enums alien.strings
4 assocs byte-arrays classes.struct destructors grouping images images.loader
5 io kernel libc locals math mime.types namespaces sequences specialized-arrays
6 system windows.com windows.gdiplus windows.streams windows.types ;
7 IN: images.loader.gdiplus
9 SPECIALIZED-ARRAY: ImageCodecInfo
14 { "png" "tif" "tiff" "gif" "jpg" "jpeg" "bmp" "ico" }
15 [ gdi+-image register-image-class ] each
22 : stream>gdi+-bitmap ( stream -- bitmap )
23 stream>IStream &com-release
24 { void* } [ GdipCreateBitmapFromStream check-gdi+-status ]
25 with-out-parameters &GdipFree ;
27 : gdi+-bitmap-width ( bitmap -- w )
28 { UINT } [ GdipGetImageWidth check-gdi+-status ]
31 : gdi+-bitmap-height ( bitmap -- h )
32 { UINT } [ GdipGetImageHeight check-gdi+-status ]
35 :: gdi+-lock-bitmap ( bitmap rect mode format -- data )
36 ! Copy the rect to stack space because the gc might move it
37 ! because calling GdipBitmapLockBits triggers callbacks to Factor.
38 { BitmapData GpRect } [
39 :> ( stack-data stack-rect )
40 stack-rect rect binary-object memcpy
41 bitmap stack-rect mode format stack-data GdipBitmapLockBits
43 ] with-out-parameters drop ;
45 :: gdi+-bitmap>data ( bitmap -- w h pixels )
46 bitmap [ gdi+-bitmap-width ] [ gdi+-bitmap-height ] bi :> ( w h )
47 bitmap 0 0 w h <GpRect> ImageLockModeRead enum>number
48 PixelFormat32bppARGB gdi+-lock-bitmap :> bitmap-data
49 bitmap-data [ Scan0>> ] [ Stride>> ] [ Height>> * ] tri
50 memory>byte-array :> pixels
51 bitmap bitmap-data GdipBitmapUnlockBits check-gdi+-status
54 :: data>image ( w h pixels -- image )
58 BGRA >>component-order
59 ubyte-components >>component-type
62 ! Loaded images usually have the format BGRA, text rendered BGRX.
63 ERROR: unsupported-pixel-format component-order ;
65 : check-pixel-format ( component-order -- )
66 dup { BGRX BGRA RGBA } member? [ drop ] [ unsupported-pixel-format ] if ;
68 : image>gdi+-bitmap ( image -- bitmap )
69 dup component-order>> check-pixel-format
70 [ dim>> first2 ] [ rowstride PixelFormat32bppARGB ] [ bitmap>> ] tri
72 GdipCreateBitmapFromScan0 check-gdi+-status
73 ] with-out-parameters &GdipFree ;
75 : image-encoders-size ( -- num size )
77 GdipGetImageEncodersSize check-gdi+-status
78 ] with-out-parameters ;
80 : image-encoders ( -- codec-infos )
81 image-encoders-size dup <byte-array> 3dup
82 GdipGetImageEncoders check-gdi+-status
83 nip swap ImageCodecInfo <c-direct-array> ;
85 : extension>mime-type ( extension -- mime-type )
86 mime-types ?at [ unknown-image-extension ] unless ;
88 : mime-type>clsid ( mime-type -- clsid )
89 image-encoders [ MimeType>> alien>native-string = ] with find nip Clsid>> ;
92 start-gdi+ &stop-gdi+ drop ;
94 : write-image-to-stream ( image stream extension -- )
96 [ stream>IStream &com-release ]
97 [ extension>mime-type mime-type>clsid ] tri*
98 f GdipSaveImageToStream check-gdi+-status ;
102 M: gdi+-image stream>image*
108 M: gdi+-image image>stream
109 drop startup-gdi+ output-stream get swap write-image-to-stream ;