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.
USING: io.styles namespaces colors ;
IN: help.stylesheet
SYMBOL: default-span-style
H{
{ font "sans-serif" }
{ font-name "sans-serif" }
{ font-size 12 }
{ font-style plain }
} default-span-style set-global
@ -29,7 +29,7 @@ H{ { font-style bold } } strong-style set-global
SYMBOL: title-style
H{
{ font "sans-serif" }
{ font-name "sans-serif" }
{ font-size 18 }
{ font-style bold }
{ wrap-margin 500 }
@ -42,21 +42,21 @@ H{ { font-size 10 } } help-path-style set-global
SYMBOL: heading-style
H{
{ font "sans-serif" }
{ font-name "sans-serif" }
{ font-size 16 }
{ font-style bold }
} heading-style set-global
SYMBOL: subsection-style
H{
{ font "sans-serif" }
{ font-name "sans-serif" }
{ font-size 14 }
{ font-style bold }
} subsection-style set-global
SYMBOL: snippet-style
H{
{ font "monospace" }
{ font-name "monospace" }
{ font-size 12 }
{ foreground T{ rgba f 0.1 0.1 0.4 1 } }
} snippet-style set-global
@ -73,7 +73,7 @@ H{ { font-style bold } } input-style set-global
SYMBOL: url-style
H{
{ font "monospace" }
{ font-name "monospace" }
{ foreground T{ rgba f 0.0 0.0 1.0 1.0 } }
} 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
background [ bg-css, ] apply-style
font [ font-css, ] apply-style
font-name [ font-css, ] apply-style
font-style [ style-css, ] apply-style
font-size [ size-css, ] apply-style
] 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 } ":"
{ $subsection foreground }
{ $subsection background }
{ $subsection font }
{ $subsection font-name }
{ $subsection font-size }
{ $subsection font-style }
{ $subsection presented } ;
@ -195,11 +195,11 @@ HELP: background
}
} ;
HELP: font
HELP: font-name
{ $description "Character style. Font family named by a string." }
{ $examples
"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

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

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

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

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