new vocab images.gdiplus: image loading using standard windows gdi+ library

db4
Joe Groff 2010-07-06 22:37:14 -07:00
parent 099607bfdd
commit 958e086903
1 changed files with 64 additions and 0 deletions
basis/images/gdiplus

View File

@ -0,0 +1,64 @@
! (c)2010 Joe Groff bsd license
USING: accessors alien.c-types alien.data alien.enums
classes.struct destructors images images.loader
io.streams.limited kernel locals math windows.com
windows.gdiplus windows.streams windows.types ;
FROM: images => ARGB ;
IN: images.gdiplus
SINGLETON: gdi+-image
! "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
<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 ]
[ clone ] 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>> * 4 * ] 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
ARGB >>component-order
ubyte-components >>component-type
f >>upside-down? ;
PRIVATE>
M: gdi+-image stream>image
drop
dup limited-stream? [ stream-eofs >>mode ] when [
start-gdi+ &stop-gdi+ drop
stream>gdi+-bitmap
gdi+-bitmap>data
data>image
] with-destructors ;