diff --git a/basis/ui/gadgets/buttons/buttons.factor b/basis/ui/gadgets/buttons/buttons.factor index 3394607a81..c7609dbe06 100644 --- a/basis/ui/gadgets/buttons/buttons.factor +++ b/basis/ui/gadgets/buttons/buttons.factor @@ -1,11 +1,10 @@ ! Copyright (C) 2005, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors assocs colors colors.constants combinators -combinators.short-circuit combinators.smart fry kernel locals -math.vectors memoize models namespaces sequences system -ui.commands ui.gadgets ui.gadgets.borders ui.gadgets.labels -ui.gadgets.packs ui.gadgets.worlds ui.gestures ui.pens -ui.pens.image ui.pens.solid ui.pens.tile ui.theme +USING: accessors assocs colors combinators combinators.short-circuit +combinators.smart fry kernel locals math.vectors memoize models +namespaces sequences ui.commands ui.gadgets ui.gadgets.borders +ui.gadgets.labels ui.gadgets.packs ui.theme ui.gadgets.worlds +ui.gestures ui.pens ui.pens.image ui.pens.solid ui.pens.tile ui.theme.images ; FROM: models => change-model ; IN: ui.gadgets.buttons @@ -129,7 +128,7 @@ PRIVATE> ] 2dip ; : ( -- pen ) - "button" os windows? [ color: grey95 ] [ transparent ] if button-text-color + "button" transparent button-text-color dup "button-clicked" transparent button-clicked-text-color dup dup diff --git a/basis/ui/gadgets/labeled/labeled.factor b/basis/ui/gadgets/labeled/labeled.factor index ce9daeaae6..15eee9d44e 100644 --- a/basis/ui/gadgets/labeled/labeled.factor +++ b/basis/ui/gadgets/labeled/labeled.factor @@ -11,16 +11,10 @@ TUPLE: labeled-gadget < track content ; M: labeled-gadget focusable-child* content>> ; -! gradients don't work as backgrounds on windows, see #152 and #1397 -: title-bar-interior ( -- interior ) - os windows? - [ toolbar-background ] - [ title-bar-gradient ] - if ; - : ( title -- title-bar ) >label [ t >>bold? ] change-font - { 0 4 } title-bar-interior >>interior ; + { 0 4 } + title-bar-gradient >>interior ; PRIVATE> diff --git a/basis/windows/uniscribe/uniscribe.factor b/basis/windows/uniscribe/uniscribe.factor index b02b4a371f..1bfb55b7f9 100644 --- a/basis/windows/uniscribe/uniscribe.factor +++ b/basis/windows/uniscribe/uniscribe.factor @@ -1,10 +1,13 @@ ! 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 combinators destructors fonts init io.encodings.string -io.encodings.utf16n kernel literals locals math namespaces sequences -windows.errors windows.fonts windows.gdi32 windows.offscreen -windows.ole32 windows.types windows.usp10 ; +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 ; @@ -48,8 +51,17 @@ CONSTANT: ssa-dwFlags flags{ SSA_GLYPHS SSA_FALLBACK SSA_TAB } [ check-ole32-error ] [ |ScriptStringFree void* deref ] bi* ; : set-dc-colors ( dc font -- ) - [ background>> color>RGB SetBkColor drop ] - [ foreground>> color>RGB SetTextColor drop ] 2bi ; + dup background>> >rgba alpha>> 1 number= [ + ! 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 ) string>> dup selection? [ [ start>> ] [ end>> ] bi ] [ drop 0 0 ] if ; @@ -67,10 +79,27 @@ CONSTANT: ssa-dwFlags flags{ SSA_GLYPHS SSA_FALLBACK SSA_TAB } FALSE ! fDisabled 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' ) + 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 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 -- ) cache-font SelectObject win32-error=0/f ; diff --git a/extra/slides/slides.factor b/extra/slides/slides.factor index aac7aced6f..49647f96e0 100644 --- a/extra/slides/slides.factor +++ b/extra/slides/slides.factor @@ -27,7 +27,7 @@ CONSTANT: stylesheet } { code-style H{ - { page-color T{ rgba f 0.9 0.9 0.9 1 } } + { page-color T{ rgba f 0.4 0.4 0.4 0.3 } } } } { snippet-style @@ -55,35 +55,23 @@ CONSTANT: stylesheet } format ] ($block) ; -: divider-interior ( -- interior ) - os windows? [ - T{ rgba f 0.25 0.25 0.25 1.0 } - ] [ { - T{ rgba f 0.25 0.25 0.25 1.0 } - T{ rgba f 1.0 1.0 1.0 0.0 } - } - ] if ; - : $divider ( -- ) [ - divider-interior >>interior + { + T{ rgba f 0.25 0.25 0.25 1.0 } + T{ rgba f 1.0 1.0 1.0 0.0 } + } >>interior array[ default-font-size 67 * default-font-size 5/6 * ] >>dim { 1 0 } >>orientation gadget. ] ($block) ; -: page-interior ( -- interior ) - os windows? [ - T{ rgba f 0.8 0.8 1.0 1.0 } - ] [ { - T{ rgba f 0.8 0.8 1.0 1.0 } - T{ rgba f 0.8 1.0 1.0 1.0 } - } - ] if ; - : page-theme ( gadget -- gadget ) - page-interior >>interior ; + { + T{ rgba f 0.8 0.8 1.0 1.0 } + T{ rgba f 0.8 1.0 1.0 1.0 } + } >>interior ; : ( list -- gadget ) [