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

Rename font key in io.styles to font-name for clarity; clean up some nefarious stack shuffling in ui.gadgets.panes

db4
Slava Pestov 2009-01-26 16:25:57 -06:00
parent d48a175207
commit 5aec661b92
5 changed files with 65 additions and 59 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
basis/help/stylesheet/stylesheet.factor
View File

@ -1,11 +1,11 @@
! Copyright (C) 2005, 2006 Slava Pestov. ! Copyright (C) 2005, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: io.styles namespaces colors ; USING: io.styles namespaces colors ;
IN: help.stylesheet IN: help.stylesheet
SYMBOL: default-span-style SYMBOL: default-span-style
H{ H{
{ font "sans-serif" } { font-name "sans-serif" }
{ font-size 12 } { font-size 12 }
{ font-style plain } { font-style plain }
} default-span-style set-global } default-span-style set-global
@ -29,7 +29,7 @@ H{ { font-style bold } } strong-style set-global
SYMBOL: title-style SYMBOL: title-style
H{ H{
{ font "sans-serif" } { font-name "sans-serif" }
{ font-size 18 } { font-size 18 }
{ font-style bold } { font-style bold }
{ wrap-margin 500 } { wrap-margin 500 }
@ -42,21 +42,21 @@ H{ { font-size 10 } } help-path-style set-global
SYMBOL: heading-style SYMBOL: heading-style
H{ H{
{ font "sans-serif" } { font-name "sans-serif" }
{ font-size 16 } { font-size 16 }
{ font-style bold } { font-style bold }
} heading-style set-global } heading-style set-global
SYMBOL: subsection-style SYMBOL: subsection-style
H{ H{
{ font "sans-serif" } { font-name "sans-serif" }
{ font-size 14 } { font-size 14 }
{ font-style bold } { font-style bold }
} subsection-style set-global } subsection-style set-global
SYMBOL: snippet-style SYMBOL: snippet-style
H{ H{
{ font "monospace" } { font-name "monospace" }
{ font-size 12 } { font-size 12 }
{ foreground T{ rgba f 0.1 0.1 0.4 1 } } { foreground T{ rgba f 0.1 0.1 0.4 1 } }
} snippet-style set-global } snippet-style set-global
@ -73,7 +73,7 @@ H{ { font-style bold } } input-style set-global
SYMBOL: url-style SYMBOL: url-style
H{ H{
{ font "monospace" } { font-name "monospace" }
{ foreground T{ rgba f 0.0 0.0 1.0 1.0 } } { foreground T{ rgba f 0.0 0.0 1.0 1.0 } }
} url-style set-global } url-style set-global

2
basis/html/streams/streams.factor
View File

@ -86,7 +86,7 @@ TUPLE: html-sub-stream < html-stream style parent ;
[ [
foreground [ fg-css, ] apply-style foreground [ fg-css, ] apply-style
background [ bg-css, ] apply-style background [ bg-css, ] apply-style
font [ font-css, ] apply-style font-name [ font-css, ] apply-style
font-style [ style-css, ] apply-style font-style [ style-css, ] apply-style
font-size [ size-css, ] apply-style font-size [ size-css, ] apply-style
] make-css ; ] make-css ;

6
basis/io/styles/styles-docs.factor
View File

@ -115,7 +115,7 @@ ARTICLE: "character-styles" "Character styles"
"Character styles for " { $link stream-format } " and " { $link with-style } ":" "Character styles for " { $link stream-format } " and " { $link with-style } ":"
{ $subsection foreground } { $subsection foreground }
{ $subsection background } { $subsection background }
{ $subsection font } { $subsection font-name }
{ $subsection font-size } { $subsection font-size }
{ $subsection font-style } { $subsection font-style }
{ $subsection presented } ; { $subsection presented } ;
@ -195,11 +195,11 @@ HELP: background
} }
} ; } ;
HELP: font HELP: font-name
{ $description "Character style. Font family named by a string." } { $description "Character style. Font family named by a string." }
{ $examples { $examples
"This example outputs some different font sizes:" "This example outputs some different font sizes:"
{ $code "{ \"monospace\" \"serif\" \"sans-serif\" }\n[ dup font associate format nl ] each" } { $code "{ \"monospace\" \"serif\" \"sans-serif\" }\n[ dup font-name associate format nl ] each" }
} ; } ;
HELP: font-size HELP: font-size

2
basis/io/styles/styles.factor
View File

@ -130,7 +130,7 @@ SYMBOL: bold-italic
! Character styles ! Character styles
SYMBOL: foreground SYMBOL: foreground
SYMBOL: background SYMBOL: background
SYMBOL: font SYMBOL: font-name
SYMBOL: font-size SYMBOL: font-size
SYMBOL: font-style SYMBOL: font-style

100
basis/ui/gadgets/panes/panes.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2005, 2009 Slava Pestov. ! Copyright (C) 2005, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: arrays hashtables io kernel namespaces sequences USING: arrays hashtables io kernel namespaces sequences
io.styles strings quotations math opengl combinators io.styles strings quotations math opengl combinators memoize
math.vectors sorting splitting assocs classes.tuple models math.vectors sorting splitting assocs classes.tuple models
continuations destructors accessors math.geometry.rect fry continuations destructors accessors math.geometry.rect fry
ui.gadgets ui.gadgets.borders ui.gadgets.buttons ui.gadgets ui.gadgets.borders ui.gadgets.buttons
@ -19,15 +19,15 @@ selection-color caret mark selecting? ;
: clear-selection ( pane -- pane ) : clear-selection ( pane -- pane )
f >>caret f >>mark ; f >>caret f >>mark ;
: add-output ( pane current -- pane ) : add-output ( pane current -- pane )
[ >>output ] [ add-gadget ] bi ; [ >>output ] [ add-gadget ] bi ;
: add-current ( pane current -- pane ) : add-current ( pane current -- pane )
[ >>current ] [ add-gadget ] bi ; [ >>current ] [ add-gadget ] bi ;
: prepare-line ( pane -- pane ) : prepare-line ( pane -- )
clear-selection clear-selection
dup prototype>> clone add-current ; dup prototype>> clone add-current drop ;
: pane-caret&mark ( pane -- caret mark ) : pane-caret&mark ( pane -- caret mark )
[ caret>> ] [ mark>> ] bi ; [ caret>> ] [ mark>> ] bi ;
@ -51,7 +51,7 @@ M: pane gadget-selection ( pane -- string/f )
{ 0 1 } >>orientation { 0 1 } >>orientation
<shelf> >>prototype <shelf> >>prototype
<incremental> add-output <incremental> add-output
prepare-line dup prepare-line
selection-color >>selection-color ; selection-color >>selection-color ;
: <pane> ( -- pane ) pane new-pane ; : <pane> ( -- pane ) pane new-pane ;
@ -77,12 +77,12 @@ M: node draw-selection ( loc node -- )
M: pane draw-gadget* M: pane draw-gadget*
dup gadget-selection? [ dup gadget-selection? [
dup selection-color>> gl-color [ selection-color>> gl-color ]
origin get over rect-loc v- swap selected-children [
[ draw-selection ] with each [ [ origin get ] dip loc>> v- ] keep selected-children
] [ [ draw-selection ] with each
drop ] bi
] if ; ] [ drop ] if ;
: scroll-pane ( pane -- ) : scroll-pane ( pane -- )
dup scrolls?>> [ scroll>bottom ] [ drop ] if ; dup scrolls?>> [ scroll>bottom ] [ drop ] if ;
@ -100,20 +100,22 @@ C: <pane-stream> pane-stream
: smash-pane ( pane -- gadget ) output>> smash-line ; : smash-pane ( pane -- gadget ) output>> smash-line ;
: pane-nl ( pane -- pane ) : pane-nl ( pane -- )
dup current>> dup unparent smash-line [
over output>> add-incremental [ current>> [ unparent ] [ smash-line ] bi ] [ output>> ] bi
prepare-line ; add-incremental
]
[ prepare-line ] bi ;
: pane-write ( pane seq -- ) : pane-write ( seq pane -- )
[ pane-nl ] [ '[ _ pane-nl ] ]
[ over current>> stream-write ] [ '[ _ current>> stream-write ] ] bi
interleave drop ; interleave ;
: pane-format ( style pane seq -- ) : pane-format ( seq style pane -- )
[ pane-nl ] [ '[ _ drop _ pane-nl ] ]
[ 2over current>> stream-format ] [ '[ _ _ current>> stream-format ] ] 2bi
interleave 2drop ; interleave ;
GENERIC: write-gadget ( gadget stream -- ) GENERIC: write-gadget ( gadget stream -- )
@ -157,16 +159,16 @@ M: pane-control model-changed ( model pane-control -- )
[ pane>> ] dip keep scroll-pane ; inline [ pane>> ] dip keep scroll-pane ; inline
M: pane-stream stream-nl M: pane-stream stream-nl
[ pane-nl drop ] do-pane-stream ; [ pane-nl ] do-pane-stream ;
M: pane-stream stream-write1 M: pane-stream stream-write1
[ current>> stream-write1 ] do-pane-stream ; [ current>> stream-write1 ] do-pane-stream ;
M: pane-stream stream-write M: pane-stream stream-write
[ swap string-lines pane-write ] do-pane-stream ; [ [ string-lines ] dip pane-write ] do-pane-stream ;
M: pane-stream stream-format M: pane-stream stream-format
[ rot string-lines pane-format ] do-pane-stream ; [ [ string-lines ] 2dip pane-format ] do-pane-stream ;
M: pane-stream dispose drop ; M: pane-stream dispose drop ;
@ -186,24 +188,28 @@ M: pane-stream make-span-stream
: apply-background-style ( style gadget -- style gadget ) : apply-background-style ( style gadget -- style gadget )
background [ solid-interior ] apply-style ; background [ solid-interior ] apply-style ;
: specified-font ( style -- font ) MEMO: specified-font ( font style size -- font )
<font> #! We memoize here to avoid creating lots of duplicate font objects.
swap [ <font> ] 3dip
[ font swap at "monospace" or >>name ] [ "monospace" or >>name ]
[ [
font-style swap at { {
{ f [ ] } { f [ ] }
{ plain [ ] } { plain [ ] }
{ bold [ t >>bold? ] } { bold [ t >>bold? ] }
{ italic [ t >>italic? ] } { italic [ t >>italic? ] }
{ bold-italic [ t >>bold? t >>italic? ] } { bold-italic [ t >>bold? t >>italic? ] }
} case } case
] ]
[ font-size swap at 12 or >>size ] [ 12 or >>size ]
tri ; tri* ;
: apply-font-style ( style gadget -- style gadget ) : apply-font-style ( style gadget -- style gadget )
over specified-font >>font ; over
[ font-name swap at ]
[ font-style swap at ]
[ font-size swap at ]
tri specified-font >>font ;
: apply-presentation-style ( style gadget -- style gadget ) : apply-presentation-style ( style gadget -- style gadget )
presented [ <presentation> ] apply-style ; presented [ <presentation> ] apply-style ;
@ -331,10 +337,10 @@ M: paragraph stream-format
presented pick at [ presented pick at [
gadget-format gadget-format
] [ ] [
rot " " split [ " " split ] 2dip
[ 2dup gadget-bl ] [ '[ _ _ gadget-bl ] ]
[ 2over gadget-format ] interleave [ '[ _ _ gadget-format ] ] 2bi
2drop interleave
] if ; ] if ;
: caret>mark ( pane -- pane ) : caret>mark ( pane -- pane )