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

Merge remote-tracking branch 'origin/master' into modern-harvey3

modern-harvey3
Doug Coleman 2019-06-09 10:40:23 -05:00
parent add6234fd1 4a7644e509
commit 502f4e7fd8
4 changed files with 54 additions and 44 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
basis/ui/gadgets/buttons/buttons.factor
View File

@ -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 <tile-pen> ;
: <border-button-pen> ( -- pen )
"button" os windows? [ color: grey95 ] [ transparent ] if button-text-color
"button" transparent button-text-color
<border-button-state-pen> dup
"button-clicked" transparent button-clicked-text-color
<border-button-state-pen> dup dup

10
basis/ui/gadgets/labeled/labeled.factor
View File

@ -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 <solid> ]
[ title-bar-gradient <gradient> ]
if ;
: <title-bar> ( title -- title-bar )
>label [ t >>bold? ] change-font
{ 0 4 } <border> title-bar-interior >>interior ;
{ 0 4 } <border>
title-bar-gradient <gradient> >>interior ;
PRIVATE>

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

@ -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 ;

30
extra/slides/slides.factor
View File

@ -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 } <solid>
] [ {
T{ rgba f 0.25 0.25 0.25 1.0 }
T{ rgba f 1.0 1.0 1.0 0.0 }
} <gradient>
] if ;
: $divider ( -- )
[
<gadget>
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 }
} <gradient> >>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 } <solid>
] [ {
T{ rgba f 0.8 0.8 1.0 1.0 }
T{ rgba f 0.8 1.0 1.0 1.0 }
} <gradient>
] 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 }
} <gradient> >>interior ;
: <page> ( list -- gadget )
[