From 0d35e277ea4fe0d46c02fbab6fe602efc61d3cfb Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Sun, 27 Jun 2010 13:44:16 -0700
Subject: [PATCH] images, opengl.textures, images.cocoa: add support for
 premultiplied alpha so we can use data from cocoa images

---
 Raytrace.app/Contents/Info.plist      | 18 ++++++++++++++++++
 basis/images/cocoa/cocoa.factor       |  6 ++++--
 basis/images/images.factor            |  5 ++++-
 basis/opengl/textures/textures.factor | 15 ++++++++++++---
 extra/gpu/textures/textures.factor    |  2 +-
 5 files changed, 39 insertions(+), 7 deletions(-)
 create mode 100644 Raytrace.app/Contents/Info.plist

diff --git a/Raytrace.app/Contents/Info.plist b/Raytrace.app/Contents/Info.plist
new file mode 100644
index 0000000000..776fd81472
--- /dev/null
+++ b/Raytrace.app/Contents/Info.plist
@@ -0,0 +1,18 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
+<plist version="1.0">
+<dict>
+	<key>CFBundleExecutable</key>
+	<string>gpu.demos.raytrace</string>
+	<key>CFBundleIconFile</key>
+	<string>Icon.icns</string>
+	<key>CFBundleIdentifier</key>
+	<string>org.factor.gpu.demos.raytrace</string>
+	<key>CFBundleInfoDictionaryVersion</key>
+	<string>6.0</string>
+	<key>CFBundleName</key>
+	<string>Raytrace.app</string>
+	<key>CFBundlePackageType</key>
+	<string>APPL</string>
+</dict>
+</plist>
diff --git a/basis/images/cocoa/cocoa.factor b/basis/images/cocoa/cocoa.factor
index 1d71738904..166a5f8196 100644
--- a/basis/images/cocoa/cocoa.factor
+++ b/basis/images/cocoa/cocoa.factor
@@ -1,7 +1,8 @@
 ! (c)2010 Joe Groff bsd license
 USING: accessors alien.data cocoa cocoa.classes cocoa.messages
 combinators core-foundation.data core-graphics.types fry images
-images.loader io io.streams.limited kernel literals ;
+images.loader io io.streams.limited kernel literals math 
+sequences ;
 IN: images.cocoa
 
 SINGLETON: ns-image
@@ -52,12 +53,13 @@ PRIVATE>
 
 : image-rep>image ( image-rep -- image )
     image new swap {
-        [ -> size CGSize>dim >>dim ]
+        [ -> size CGSize>dim [ >integer ] map >>dim ]
         [ -> bitmapData ]
         [ -> bytesPerPlane memory>byte-array >>bitmap ]
     } cleave
         RGBA >>component-order
         ubyte-components >>component-type
+        t >>premultiplied-alpha?
         f >>upside-down? ;
 
 M: ns-image stream>image
diff --git a/basis/images/images.factor b/basis/images/images.factor
index 6cbcdb9508..db731d2045 100644
--- a/basis/images/images.factor
+++ b/basis/images/images.factor
@@ -62,7 +62,10 @@ UNION: alpha-channel BGRA RGBA ABGR ARGB LA A INTENSITY ;
 
 UNION: alpha-channel-precedes-colors ABGR ARGB XBGR XRGB ;
 
-TUPLE: image dim component-order component-type upside-down? bitmap ;
+TUPLE: image
+    dim component-order component-type
+    upside-down? premultiplied-alpha?
+    bitmap ;
 
 : <image> ( -- image ) image new ; inline
 
diff --git a/basis/opengl/textures/textures.factor b/basis/opengl/textures/textures.factor
index dacea0888a..bba4165304 100644
--- a/basis/opengl/textures/textures.factor
+++ b/basis/opengl/textures/textures.factor
@@ -312,12 +312,21 @@ TUPLE: single-texture < disposable image dim loc texture-coords texture display-
     [ init-texture texture-coords>> gl-texture-coord-pointer ] tri
     swap gl-fill-rect ;
 
+: set-blend-mode ( texture -- )
+    image>> dup has-alpha?
+    [ premultiplied-alpha?>> [ GL_ONE GL_ONE_MINUS_SRC_ALPHA glBlendFunc ] when ]
+    [ drop GL_BLEND glDisable ] if ;
+
+: reset-blend-mode ( texture -- )
+    image>> dup has-alpha?
+    [ premultiplied-alpha?>> [ GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA glBlendFunc ] when ]
+    [ drop GL_BLEND glEnable ] if ;
+
 : draw-textured-rect ( dim texture -- )
     [
-        [ image>> has-alpha? [ GL_BLEND glDisable ] unless ]
+        [ set-blend-mode ]
         [ (draw-textured-rect) GL_TEXTURE_2D 0 glBindTexture ]
-        [ image>> has-alpha? [ GL_BLEND glEnable ] unless ]
-        tri
+        [ reset-blend-mode ] tri
     ] with-texturing ;
 
 : texture-coords ( texture -- coords )
diff --git a/extra/gpu/textures/textures.factor b/extra/gpu/textures/textures.factor
index a240aae945..55e6f7c0f4 100644
--- a/extra/gpu/textures/textures.factor
+++ b/extra/gpu/textures/textures.factor
@@ -309,7 +309,7 @@ TYPED: read-compressed-texture ( tdt: texture-data-target level: integer -- byte
 
 : read-texture-image ( tdt level -- image )
     [ texture-dim ]
-    [ drop texture-object [ component-order>> ] [ component-type>> ] bi f ]
+    [ drop texture-object [ component-order>> ] [ component-type>> ] bi f f ]
     [ read-texture ] 2tri
     image boa ; inline