67 lines
2.1 KiB
Factor
67 lines
2.1 KiB
Factor
! (c)2010 Joe Groff bsd license
|
|
USING: accessors alien.c-types alien.data alien.enums
|
|
classes.struct destructors images images.loader kernel locals
|
|
math windows.com windows.gdiplus windows.streams windows.types
|
|
typed byte-arrays grouping sequences ;
|
|
FROM: system => os windows? ;
|
|
IN: images.gdiplus
|
|
|
|
SINGLETON: gdi+-image
|
|
|
|
os windows? [
|
|
"png" gdi+-image register-image-class
|
|
"tif" gdi+-image register-image-class
|
|
"tiff" gdi+-image register-image-class
|
|
"gif" gdi+-image register-image-class
|
|
"jpg" gdi+-image register-image-class
|
|
"jpeg" gdi+-image register-image-class
|
|
"bmp" gdi+-image register-image-class
|
|
"ico" gdi+-image register-image-class
|
|
] when
|
|
|
|
<PRIVATE
|
|
: <GpRect> ( x y w h -- rect )
|
|
GpRect <struct-boa> ; inline
|
|
|
|
: stream>gdi+-bitmap ( stream -- bitmap )
|
|
stream>IStream &com-release
|
|
{ void* } [ GdipCreateBitmapFromStream check-gdi+-status ]
|
|
with-out-parameters &GdipFree ;
|
|
|
|
: gdi+-bitmap-width ( bitmap -- w )
|
|
{ UINT } [ GdipGetImageWidth check-gdi+-status ]
|
|
with-out-parameters ;
|
|
: gdi+-bitmap-height ( bitmap -- w )
|
|
{ UINT } [ GdipGetImageHeight check-gdi+-status ]
|
|
with-out-parameters ;
|
|
: gdi+-lock-bitmap ( bitmap rect mode format -- data )
|
|
{ BitmapData } [ GdipBitmapLockBits check-gdi+-status ]
|
|
with-out-parameters ;
|
|
|
|
:: gdi+-bitmap>data ( bitmap -- w h pixels )
|
|
bitmap [ gdi+-bitmap-width ] [ gdi+-bitmap-height ] bi :> ( w h )
|
|
bitmap 0 0 w h <GpRect> ImageLockModeRead enum>number
|
|
PixelFormat32bppARGB gdi+-lock-bitmap :> bitmap-data
|
|
bitmap-data [ Scan0>> ] [ Stride>> ] [ Height>> * ] tri
|
|
memory>byte-array :> pixels
|
|
bitmap bitmap-data GdipBitmapUnlockBits check-gdi+-status
|
|
w h pixels ;
|
|
|
|
:: data>image ( w h pixels -- image )
|
|
image new
|
|
{ w h } >>dim
|
|
pixels >>bitmap
|
|
BGRA >>component-order
|
|
ubyte-components >>component-type
|
|
f >>upside-down? ;
|
|
|
|
PRIVATE>
|
|
|
|
M: gdi+-image stream>image
|
|
drop [
|
|
start-gdi+ &stop-gdi+ drop
|
|
stream>gdi+-bitmap
|
|
gdi+-bitmap>data
|
|
data>image
|
|
] with-destructors ;
|