From 958e08690378c26341cab4aaff481852f04eda62 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Tue, 6 Jul 2010 22:37:14 -0700
Subject: [PATCH] new vocab images.gdiplus: image loading using standard
 windows gdi+ library

---
 basis/images/gdiplus/gdiplus.factor | 64 +++++++++++++++++++++++++++++
 1 file changed, 64 insertions(+)
 create mode 100644 basis/images/gdiplus/gdiplus.factor

diff --git a/basis/images/gdiplus/gdiplus.factor b/basis/images/gdiplus/gdiplus.factor
new file mode 100644
index 0000000000..bc5d031820
--- /dev/null
+++ b/basis/images/gdiplus/gdiplus.factor
@@ -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 ;