! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien.c-types alien.data arrays assocs cache
-classes.struct colors colors.constants combinators destructors
-fonts images init io.encodings.string io.encodings.utf16n kernel
-literals locals math namespaces sequences windows.errors
+USING: accessors alien.c-types alien.data arrays assocs
+byte-arrays cache classes.struct colors colors.constants
+combinators destructors fonts images init io.encodings.string
+io.encodings.utf16n kernel literals locals math math.bitwise
+namespaces sequences specialized-arrays windows.errors
windows.fonts windows.gdi32 windows.offscreen windows.ole32
windows.types windows.usp10 ;
+SPECIALIZED-ARRAY: uint32_t
IN: windows.uniscribe
TUPLE: script-string < disposable font string metrics ssa size image ;
! the entire image a rectangle of the given color with varying
! transparency.
:: color-to-alpha ( image color -- image' )
- image color >rgba-components drop [ 255 * >integer ] tri@ 3array [
- swap first suffix -rot image set-pixel-at
- ] curry each-pixel 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