windows.uniscribe: speed up pixel array processing for transparent fonts

The approach was suggested by John Benediktsson in a GitHub comment.
clean-macosx-x86-32
Alexander Iljin 2019-06-08 12:11:35 +02:00
parent f445b44af6
commit 3d56183360
1 changed files with 11 additions and 7 deletions

View File

@ -1,11 +1,13 @@
! Copyright (C) 2009 Slava Pestov. ! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien.c-types alien.data arrays assocs cache USING: accessors alien.c-types alien.data arrays assocs
classes.struct colors colors.constants combinators destructors byte-arrays cache classes.struct colors colors.constants
fonts images init io.encodings.string io.encodings.utf16n kernel combinators destructors fonts images init io.encodings.string
literals locals math namespaces sequences windows.errors io.encodings.utf16n kernel literals locals math math.bitwise
namespaces sequences specialized-arrays windows.errors
windows.fonts windows.gdi32 windows.offscreen windows.ole32 windows.fonts windows.gdi32 windows.offscreen windows.ole32
windows.types windows.usp10 ; windows.types windows.usp10 ;
SPECIALIZED-ARRAY: uint32_t
IN: windows.uniscribe IN: windows.uniscribe
TUPLE: script-string < disposable font string metrics ssa size image ; TUPLE: script-string < disposable font string metrics ssa size image ;
@ -83,9 +85,11 @@ CONSTANT: ssa-dwFlags flags{ SSA_GLYPHS SSA_FALLBACK SSA_TAB }
! the entire image a rectangle of the given color with varying ! the entire image a rectangle of the given color with varying
! transparency. ! transparency.
:: color-to-alpha ( image color -- image' ) :: color-to-alpha ( image color -- image' )
image color >rgba-components drop [ 255 * >integer ] tri@ 3array [ color >rgba-components drop [ 255 * >integer ] tri@
swap first suffix -rot image set-pixel-at 3byte-array uint32_t deref 24 bits :> rgb
] curry each-pixel image RGBA >>component-order ; image bitmap>> uint32_t cast-array [
0xff bitand 24 shift rgb bitor
] map! drop image RGBA >>component-order ;
:: render-image ( dc ssa script-string -- image ) :: render-image ( dc ssa script-string -- image )
script-string size>> :> size script-string size>> :> size