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

diff --git a/basis/images/gdiplus/gdiplus.factor b/basis/images/gdiplus/gdiplus.factor
new file mode 100644 (file)
index 0000000..bc5d031
--- /dev/null
+++ b/basis/images/gdiplus/gdiplus.factor
@@ -0,0 +1,64 @@
+! (c)2010 Joe Groff bsd license\r
+USING: accessors alien.c-types alien.data alien.enums\r
+classes.struct destructors images images.loader\r
+io.streams.limited kernel locals math windows.com\r
+windows.gdiplus windows.streams windows.types ;\r
+FROM: images => ARGB ;\r
+IN: images.gdiplus\r
+\r
+SINGLETON: gdi+-image\r
+! "png" gdi+-image register-image-class\r
+! "tif" gdi+-image register-image-class\r
+! "tiff" gdi+-image register-image-class\r
+! "gif" gdi+-image register-image-class\r
+! "jpg" gdi+-image register-image-class\r
+! "jpeg" gdi+-image register-image-class\r
+! "bmp" gdi+-image register-image-class\r
+! "ico" gdi+-image register-image-class\r
+\r
+<PRIVATE\r
+: <GpRect> ( x y w h -- rect )\r
+    GpRect <struct-boa> ; inline\r
+\r
+: stream>gdi+-bitmap ( stream -- bitmap )\r
+    stream>IStream &com-release\r
+    { void* } [ GdipCreateBitmapFromStream check-gdi+-status ]\r
+    [ ] with-out-parameters &GdipFree ;\r
+\r
+: gdi+-bitmap-width ( bitmap -- w )\r
+    { UINT } [ GdipGetImageWidth check-gdi+-status ]\r
+    [ ] with-out-parameters ;\r
+: gdi+-bitmap-height ( bitmap -- w )\r
+    { UINT } [ GdipGetImageHeight check-gdi+-status ]\r
+    [ ] with-out-parameters ;\r
+: gdi+-lock-bitmap ( bitmap rect mode format -- data )\r
+    { BitmapData } [ GdipBitmapLockBits check-gdi+-status ]\r
+    [ clone ] with-out-parameters ;\r
+\r
+:: gdi+-bitmap>data ( bitmap -- w h pixels )\r
+    bitmap [ gdi+-bitmap-width ] [ gdi+-bitmap-height ] bi :> ( w h )\r
+    bitmap 0 0 w h <GpRect> ImageLockModeRead enum>number\r
+    PixelFormat32bppARGB gdi+-lock-bitmap :> bitmap-data\r
+    bitmap-data [ Scan0>> ] [ Stride>> ] [ Height>> * 4 * ] tri\r
+    memory>byte-array :> pixels\r
+    bitmap bitmap-data GdipBitmapUnlockBits check-gdi+-status\r
+    w h pixels ;\r
+    \r
+:: data>image ( w h pixels -- image )\r
+    image new\r
+        { w h } >>dim\r
+        pixels >>bitmap\r
+        ARGB >>component-order\r
+        ubyte-components >>component-type\r
+        f >>upside-down? ;\r
+\r
+PRIVATE>\r
+\r
+M: gdi+-image stream>image\r
+    drop\r
+    dup limited-stream? [ stream-eofs >>mode ] when [\r
+        start-gdi+ &stop-gdi+ drop\r
+        stream>gdi+-bitmap\r
+        gdi+-bitmap>data\r
+        data>image\r
+    ] with-destructors ;\r