steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

windows.uniscribe: support text with transparent background 

This fixes issues #152 and #1658.
clean-macosx-x86-32
Alexander Iljin 2019-06-02 01:42:50 +02:00
parent f84cfc7209
commit f445b44af6
1 changed files with 29 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
basis/windows/uniscribe/uniscribe.factor
View File

@ -1,10 +1,11 @@
! 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 cache
classes.struct combinators destructors fonts init io.encodings.string classes.struct colors colors.constants combinators destructors
io.encodings.utf16n kernel literals locals math namespaces sequences fonts images init io.encodings.string io.encodings.utf16n kernel
windows.errors windows.fonts windows.gdi32 windows.offscreen literals locals math namespaces sequences windows.errors
windows.ole32 windows.types windows.usp10 ; windows.fonts windows.gdi32 windows.offscreen windows.ole32
windows.types windows.usp10 ;
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 ;
@ -48,8 +49,17 @@ CONSTANT: ssa-dwFlags flags{ SSA_GLYPHS SSA_FALLBACK SSA_TAB }
[ check-ole32-error ] [ |ScriptStringFree void* deref ] bi* ; [ check-ole32-error ] [ |ScriptStringFree void* deref ] bi* ;
: set-dc-colors ( dc font -- ) : set-dc-colors ( dc font -- )
[ background>> color>RGB SetBkColor drop ] dup background>> >rgba alpha>> 1 number= [
[ foreground>> color>RGB SetTextColor drop ] 2bi ; ! No transparency needed, set colors from the font.
[ background>> color>RGB SetBkColor drop ]
[ foreground>> color>RGB SetTextColor drop ] 2bi
] [
! Draw white text on black background. The resulting grayscale
! image will be used as transparency mask for the actual color.
drop
[ COLOR: black color>RGB SetBkColor drop ]
[ COLOR: white color>RGB SetTextColor drop ] bi
] if ;
: selection-start/end ( script-string -- iMinSel iMaxSel ) : selection-start/end ( script-string -- iMinSel iMaxSel )
string>> dup selection? [ [ start>> ] [ end>> ] bi ] [ drop 0 0 ] if ; string>> dup selection? [ [ start>> ] [ end>> ] bi ] [ drop 0 0 ] if ;
@ -67,10 +77,22 @@ CONSTANT: ssa-dwFlags flags{ SSA_GLYPHS SSA_FALLBACK SSA_TAB }
FALSE ! fDisabled FALSE ! fDisabled
ScriptStringOut check-ole32-error ; ScriptStringOut check-ole32-error ;
! The image is a grayscale rendering of a text string. We want the text to
! have the given color. Move the blue channel of the image (any color
! channel will do, since it's grayscale) into its alpha channel, and make
! 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 ;
:: render-image ( dc ssa script-string -- image ) :: render-image ( dc ssa script-string -- image )
script-string size>> :> size script-string size>> :> size
size dc size dc
[ ssa size script-string draw-script-string ] make-bitmap-image ; [ ssa size script-string draw-script-string ] make-bitmap-image
script-string font>> [ foreground>> ] [ background>> ] bi
>rgba alpha>> 1 number= [ drop ] [ color-to-alpha ] if ;
: set-dc-font ( dc font -- ) : set-dc-font ( dc font -- )
cache-font SelectObject win32-error=0/f ; cache-font SelectObject win32-error=0/f ;