ui.theme.switching: default font colors.

locals-and-roots
John Benediktsson 2016-05-15 10:44:29 -07:00
parent 7bd0d51359
commit ff2f58ac4b
16 changed files with 37 additions and 43 deletions

View File

@ -1,6 +1,7 @@
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors colors.constants combinators kernel math ;
USING: accessors colors.constants combinators kernel math
namespaces ;
IN: fonts
CONSTANT: default-serif-font-name "serif"
@ -9,16 +10,18 @@ CONSTANT: default-monospace-font-name "monospace"
CONSTANT: default-font-size 12
TUPLE: font
name
size
bold?
italic?
{ foreground initial: COLOR: black }
{ background initial: COLOR: white } ;
SYMBOL: default-font-foreground-color
COLOR: black default-font-foreground-color set-global
SYMBOL: default-font-background-color
COLOR: white default-font-background-color set-global
TUPLE: font name size bold? italic? foreground background ;
: <font> ( -- font )
font new ; inline
font new
default-font-foreground-color get >>foreground
default-font-background-color get >>background ; inline
: font-with-foreground ( font color -- font' )
[ clone ] dip >>foreground ; inline

View File

@ -134,7 +134,7 @@ PRIVATE>
<button-pen> ;
: border-button-label-theme ( gadget -- )
dup label? [ [ clone t >>bold? text-color >>foreground ] change-font ] when drop ;
dup label? [ [ clone t >>bold? ] change-font ] when drop ;
: border-button-theme ( gadget -- gadget )
dup gadget-child border-button-label-theme

View File

@ -21,7 +21,7 @@ M: labeled-gadget focusable-child* content>> ;
: add-title-bar ( title track -- track )
swap >label
[ t >>bold? text-color >>foreground ] change-font
[ t >>bold? ] change-font
{ 0 4 } <border>
title-bar-interior >>interior
f track-add ;

View File

@ -67,10 +67,10 @@ M: label cap-height*
<PRIVATE
: label-background ( label -- color )
gadget-background background get or ; inline
gadget-background [ background get ] unless* ; inline
: label-foreground ( label -- color )
gadget-foreground foreground get or ; inline
gadget-foreground [ foreground get ] unless* ; inline
PRIVATE>
@ -91,13 +91,6 @@ M: label-control model-changed
"" label-control new-label
swap >>model ;
: text-theme ( gadget -- gadget )
monospace-font >>font theme-font-colors ;
: reverse-video-theme ( label -- label )
sans-serif-font reverse-video-font >>font
COLOR: black <solid> >>interior ;
GENERIC: >label ( obj -- gadget )
M: string >label <label> ;
M: array >label <label> ;

View File

@ -321,7 +321,7 @@ M: paragraph dispose drop ;
: gadget-write ( string gadget -- )
swap dup empty?
[ 2drop ] [ <label> text-theme add-gadget drop ] if ;
[ 2drop ] [ <label> monospace-font >>font add-gadget drop ] if ;
M: pack stream-write gadget-write ;

View File

@ -3,10 +3,5 @@
USING: accessors io.pathnames sequences ui.images ui.theme ;
IN: ui.gadgets.theme
SLOT: font ! Temporarily necessary to fix Windows bootstrap.
: theme-image ( name -- image-name )
"vocab:ui/gadgets/theme/" prepend-path ".tiff" append <image-name> ;
: theme-font-colors ( gadget -- gadget )
[ content-background >>background text-color >>foreground ] change-font ;

View File

@ -1,8 +1,8 @@
! Copyright (C) 2016 Nicolas Pénet.
! See http://factorcode.org/license.txt for BSD license.
USING: assocs fry hashtables help.stylesheet help.tips io.styles
kernel listener namespaces prettyprint.stylesheet sequences
ui.theme ui.tools.listener vocabs.prettyprint words ;
USING: assocs fonts fry hashtables help.stylesheet help.tips
io.styles kernel listener namespaces prettyprint.stylesheet
sequences ui.theme ui.tools.listener vocabs.prettyprint words ;
IN: ui.theme.switching
<PRIVATE
@ -11,6 +11,10 @@ IN: ui.theme.switching
'[ _ _ rot ?set-at ] change-global ;
: update-stylesheet ( -- )
! fonts
text-color default-font-foreground-color set-global
content-background default-font-background-color set-global
! help.stylesheet
default-span-style text-color foreground update-style
link-style link-color foreground update-style

View File

@ -101,7 +101,6 @@ CONSTANT: next 1
: <search-field> ( browser -- field )
'[ _ search-browser ] <action-field>
[ theme-font-colors ] change-editor
"Search" >>default-text
10 >>min-cols
10 >>max-cols

View File

@ -44,7 +44,7 @@ SLOT: scroller
{ 9 9 } <filled-border> ;
: with-lines ( track -- track )
dup orientation>> >>gap
dup orientation>> >>gap
line-color <solid> >>interior ;
: white-interior ( track -- track )

View File

@ -36,7 +36,7 @@ M: restart-renderer row-columns
[ error>> <error-pane> add-gadget ]
[
dup restart-hook>> [
[ "To continue, pick one of the options below:" <label> theme-font-colors add-gadget ] dip
[ "To continue, pick one of the options below:" <label> add-gadget ] dip
restart-list>> add-gadget
] [ drop ] if
] bi ;
@ -49,7 +49,7 @@ PRIVATE>
swap >>restarts
swap >>continuation
swap >>error
dup <restart-list> theme-font-colors >>restart-list
dup <restart-list> >>restart-list
dup <error-display> margins white-interior f track-add
add-toolbar ;

View File

@ -74,7 +74,7 @@ M: hashtable make-slot-descriptions
: <inspector-table> ( model -- table )
[ make-slot-descriptions ] <arrow> inspector-renderer <table>
[ invoke-primary-operation ] >>action
monospace-font >>font theme-font-colors
monospace-font >>font
line-color >>column-line-color
6 >>gap
15 >>min-rows

View File

@ -141,7 +141,7 @@ GENERIC# accept-completion-hook 1 ( item popup -- )
: <completion-table> ( interactor completion-mode -- table )
[ completion-element ] [ completion-quot ] [ nip ] 2tri
[ <completion-model> ] dip <table>
monospace-font >>font theme-font-colors
monospace-font >>font
t >>selection-required?
t >>single-click?
30 >>min-cols

View File

@ -74,7 +74,6 @@ M: color-completion (word-at-caret) 2drop f ;
: <interactor> ( -- gadget )
interactor new-editor
theme-font-colors
<flag> >>flag
dup one-word-elt <element-model> >>token-model
dup <word-model> >>word-model

View File

@ -28,7 +28,7 @@ M: stack-entry-renderer row-value drop object>> ;
10 >>max-rows
40 >>min-cols
40 >>max-cols
monospace-font >>font theme-font-colors
monospace-font >>font
[ i:inspector ] >>action
t >>single-click? ;

View File

@ -78,9 +78,9 @@ M: thread-status model-changed
: add-thread-status ( track -- track )
horizontal <track> { 5 5 } >>gap
"Thread:" <label>
[ t >>bold? text-color >>foreground ] change-font
[ t >>bold? ] change-font
f track-add
self name>> <label> [ text-color >>foreground ] change-font f track-add
self name>> <label> f track-add
over status>> <thread-status>
dup font>> t >>bold? drop
f track-add

View File

@ -1,8 +1,8 @@
! Copyright (C) 2006, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel locals math math.order math.rectangles
math.vectors models namespaces opengl sequences ui.commands
ui.gadgets ui.gadgets.labels ui.gadgets.packs
USING: accessors fonts kernel locals math math.order
math.rectangles math.vectors models namespaces opengl sequences
ui.commands ui.gadgets ui.gadgets.labels ui.gadgets.packs
ui.gadgets.presentations ui.gadgets.scrollers
ui.gadgets.viewports ui.gestures ui.render ui.theme ;
IN: ui.gadgets.lists
@ -32,7 +32,8 @@ TUPLE: list < pack index presenter color hook ;
hook>> [ [ list? ] find-parent ] prepend ;
: <list-presentation> ( hook elt presenter -- gadget )
[ call( elt -- obj ) ] [ drop ] 2bi [ >label text-theme ] dip
[ call( elt -- obj ) ] [ drop ] 2bi
[ >label monospace-font >>font ] dip
<presentation>
swap >>hook ; inline