windows.uniscribe: remove <cache-assoc> &dispose.

[factor.git] / basis / windows / uniscribe / uniscribe.factor

diff --git a/basis/windows/uniscribe/uniscribe.factor b/basis/windows/uniscribe/uniscribe.factor
index 6f3b436c4933613ac4418d10b3451a28f8d93b40..b1d892462a0b4285ff2befee45f79af8a5ff7efc 100644 (file)
--- a/basis/windows/uniscribe/uniscribe.factor
+++ b/basis/windows/uniscribe/uniscribe.factor
@@ -85,11 +85,14 @@ CONSTANT: ssa-dwFlags flags{ SSA_GLYPHS SSA_FALLBACK SSA_TAB }
 ! the entire image a rectangle of the given color with varying
 ! transparency.
 :: color-to-alpha ( image color -- image' )
-    color >rgba-components drop [ 255 * >integer ] tri@
-    3byte-array uint32_t deref 24 bits :> rgb
-    image bitmap>> uint32_t cast-array [
-        0xff bitand 24 shift rgb bitor
-    ] map! drop image RGBA >>component-order ;
+    color >rgba-components :> alpha
+    [ 255 * >integer ] tri@ 3byte-array uint32_t deref 24 bits :> rgb
+    image bitmap>> uint32_t cast-array
+        alpha 1 <
+        [ [ 0xff bitand alpha * >integer 24 shift rgb bitor ] map! ]
+        [ [ 0xff bitand                  24 shift rgb bitor ] map! ]
+        if drop
+    image RGBA >>component-order ;
 
 :: render-image ( dc ssa script-string -- image )
     script-string size>> :> size
@@ -147,5 +150,5 @@ SYMBOL: cached-script-strings
         ] with-memory-dc
     ] unless image>> ;
 
-[ <cache-assoc> &dispose cached-script-strings set-global ]
+[ <cache-assoc> cached-script-strings set-global ]
 "windows.uniscribe" add-startup-hook