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

Merge branch 'ui-tweaks' of git://github.com/klazuka/factor

db4
Slava Pestov 2009-09-08 14:37:05 -05:00
parent a0e1af5891 ab7e2fc69b
commit 6d1e4947e8
14 changed files with 117 additions and 73 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
basis/colors/constants/constants-docs.factor
View File

@ -23,7 +23,7 @@ HELP: COLOR:
} ;
ARTICLE: "colors.constants" "Standard color database"
"The " { $vocab-link "colors.constants" } " vocabulary bundles the X11 " { $snippet "rgb.txt" } " database and provides words for looking up color values."
"The " { $vocab-link "colors.constants" } " vocabulary bundles the X11 " { $snippet "rgb.txt" } " database and Factor's " { $snippet "factor-colors.txt" } " theme database to provide words for looking up color values by name."
{ $subsection named-color }
{ $subsection named-colors }
{ $subsection POSTPONE: COLOR: } ;

4
basis/colors/constants/constants.factor
View File

@ -19,7 +19,9 @@ IN: colors.constants
[ parse-color ] H{ } map>assoc ;
MEMO: rgb.txt ( -- assoc )
"resource:basis/colors/constants/rgb.txt" utf8 file-lines parse-rgb.txt ;
"resource:basis/colors/constants/rgb.txt"
"resource:basis/colors/constants/factor-colors.txt"
[ utf8 file-lines parse-rgb.txt ] bi@ assoc-union ;
PRIVATE>

5
basis/colors/constants/factor-colors.txt Normal file
View File

@ -0,0 +1,5 @@
! Factor UI theme colors
227 226 219 FactorLightTan
172 167 147 FactorDarkTan
81 91 105 FactorLightSlateBlue
55 62 72 FactorDarkSlateBlue

4
basis/help/markup/markup.factor
View File

@ -87,7 +87,7 @@ ALIAS: $slot $snippet
: ($code) ( presentation quot -- )
[
snippet-style get [
code-char-style get [
last-element off
[ ($code-style) ] dip with-nesting
] with-style
@ -307,7 +307,7 @@ M: f ($instance)
: ($see) ( word quot -- )
[
snippet-style get [
code-char-style get [
code-style get swap with-nesting
] with-style
] ($block) ; inline

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

@ -17,7 +17,7 @@ H{
SYMBOL: link-style
H{
{ foreground COLOR: dark-blue }
{ foreground COLOR: DodgerBlue4 }
{ font-style bold }
} link-style set-global
@ -33,7 +33,8 @@ H{
{ font-size 18 }
{ font-style bold }
{ wrap-margin 500 }
{ page-color COLOR: light-gray }
{ foreground COLOR: FactorDarkSlateBlue }
{ page-color COLOR: FactorLightTan }
{ border-width 5 }
} title-style set-global
@ -58,12 +59,18 @@ SYMBOL: snippet-style
H{
{ font-name "monospace" }
{ font-size 12 }
{ foreground COLOR: navy-blue }
{ foreground COLOR: DarkOrange4 }
} snippet-style set-global
SYMBOL: code-char-style
H{
{ font-name "monospace" }
{ font-size 12 }
} code-char-style set-global
SYMBOL: code-style
H{
{ page-color COLOR: gray80 }
{ page-color COLOR: FactorLightTan }
{ border-width 5 }
{ wrap-margin f }
} code-style set-global
@ -74,7 +81,7 @@ H{ { font-style bold } } input-style set-global
SYMBOL: url-style
H{
{ font-name "monospace" }
{ foreground COLOR: blue }
{ foreground COLOR: DodgerBlue4 }
} url-style set-global
SYMBOL: warning-style
@ -101,7 +108,7 @@ H{
SYMBOL: table-style
H{
{ table-gap { 5 5 } }
{ table-border COLOR: light-gray }
{ table-border COLOR: FactorLightTan }
} table-style set-global
SYMBOL: list-style

33
basis/prettyprint/backend/backend.factor
View File

@ -1,11 +1,12 @@
! Copyright (C) 2003, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays byte-arrays byte-vectors continuations
generic hashtables assocs kernel math namespaces make sequences
strings sbufs vectors words prettyprint.config prettyprint.custom
prettyprint.sections quotations io io.pathnames io.styles math.parser
effects classes.tuple math.order classes.tuple.private classes
combinators colors ;
USING: accessors arrays assocs byte-arrays byte-vectors classes
classes.tuple classes.tuple.private colors colors.constants
combinators continuations effects generic hashtables io
io.pathnames io.styles kernel make math math.order math.parser
namespaces prettyprint.config prettyprint.custom
prettyprint.sections prettyprint.stylesheet quotations sbufs
sequences strings vectors words words.symbol ;
IN: prettyprint.backend
M: effect pprint* effect>string "(" ")" surround text ;
@ -20,17 +21,6 @@ M: effect pprint* effect>string "(" ")" surround text ;
?effect-height 0 < [ end-group ] when ;
! Atoms
: word-style ( word -- style )
dup "word-style" word-prop >hashtable [
[
[ presented set ]
[
[ parsing-word? ] [ delimiter? ] [ t eq? ] tri or or
[ bold font-style set ] when
] bi
] bind
] keep ;
: word-name* ( word -- str )
name>> "( no name )" or ;
@ -59,6 +49,9 @@ M: real pprint* number>string text ;
M: f pprint* drop \ f pprint-word ;
: pprint-effect ( effect -- )
[ effect>string ] [ effect-style ] bi styled-text ;
! Strings
: ch>ascii-escape ( ch -- str )
H{
@ -82,12 +75,6 @@ M: f pprint* drop \ f pprint-word ;
] when
] when ;
: string-style ( obj -- hash )
[
presented set
T{ rgba f 0.3 0.3 0.3 1.0 } foreground set
] H{ } make-assoc ;
: unparse-string ( str prefix suffix -- str )
[ [ % do-string-limit [ unparse-ch ] each ] dip % ] "" make ;

34
basis/prettyprint/stylesheet/stylesheet.factor Normal file
View File

@ -0,0 +1,34 @@
! Copyright (C) 2009 Your name.
! See http://factorcode.org/license.txt for BSD license.
USING: colors.constants hashtables io.styles kernel namespaces
words words.symbol ;
IN: prettyprint.stylesheet
: word-style ( word -- style )
dup "word-style" word-prop >hashtable [
[
[ presented set ] [
[ parsing-word? ] [ delimiter? ] [ symbol? ] tri
or or [ COLOR: DarkSlateGray ] [ COLOR: black ] if
foreground set
] bi
] bind
] keep ;
: string-style ( obj -- style )
[
presented set
COLOR: LightSalmon4 foreground set
] H{ } make-assoc ;
: vocab-style ( vocab -- style )
[
presented set
COLOR: cornsilk4 foreground set
] H{ } make-assoc ;
: effect-style ( effect -- style )
[
presented set
COLOR: DarkGreen foreground set
] H{ } make-assoc ;

2
basis/see/see.factor
View File

@ -39,7 +39,7 @@ M: word print-stack-effect? drop t ;
: stack-effect. ( word -- )
[ print-stack-effect? ] [ stack-effect ] bi and
[ effect>string comment. ] when* ;
[ pprint-effect ] when* ;
<PRIVATE

4
basis/ui/gadgets/buttons/buttons-docs.factor
View File

@ -7,7 +7,9 @@ HELP: button
$nl
"A button's appearance can vary depending on the state of the mouse button if the " { $snippet "interior" } " or " { $snippet "boundary" } " slots are set to instances of " { $link button-pen } "."
$nl
"A button can be selected, which is distinct from being pressed. This state is held in the " { $snippet "selected?" } " slot, and is used by " { $link checkbox } " instances to render themselves when they're checked." } ;
"A button can be selected, which is distinct from being pressed. This state is held in the " { $snippet "selected?" } " slot, and is used by " { $link checkbox } " instances to render themselves when they're checked."
$nl
"A button can optionally display a message in the window's status bar whenever the mouse cursor hovers over the button. To enable this behavior, just set a string to the button's " { $snippet "tooltip" } " slot." } ;
HELP: <button>
{ $values { "label" gadget } { "quot" { $quotation "( button -- )" } } { "button" "a new " { $link button } } }

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

@ -10,7 +10,7 @@ combinators.smart ;
FROM: models => change-model ;
IN: ui.gadgets.buttons
TUPLE: button < border pressed? selected? quot ;
TUPLE: button < border pressed? selected? quot tooltip ;
<PRIVATE
@ -35,6 +35,12 @@ PRIVATE>
>>pressed?
relayout-1 ;
: button-enter ( button -- )
dup dup tooltip>> [ swap show-status ] [ drop ] if* button-update ;
: button-leave ( button -- )
dup "" swap show-status button-update ;
: button-clicked ( button -- )
dup button-update
dup button-rollover?
@ -43,8 +49,8 @@ PRIVATE>
button H{
{ T{ button-up } [ button-clicked ] }
{ T{ button-down } [ button-update ] }
{ mouse-leave [ button-update ] }
{ mouse-enter [ button-update ] }
{ mouse-leave [ button-leave ] }
{ mouse-enter [ button-enter ] }
} set-gestures
: new-button ( label quot class -- button )
@ -113,30 +119,18 @@ PRIVATE>
[ append theme-image ] tri-curry@ tri
] 2dip <tile-pen> ;
CONSTANT: button-background
T{ rgba
f
0.8901960784313725
0.8862745098039215
0.8588235294117647
1.0
}
CONSTANT: button-clicked-background
T{ rgba
f
0.2156862745098039
0.2431372549019608
0.2823529411764706
1.0
}
CONSTANT: button-background COLOR: FactorLightTan
CONSTANT: button-clicked-background COLOR: FactorDarkSlateBlue
: <border-button-pen> ( -- pen )
"button" button-background COLOR: black <border-button-state-pen> dup
"button-clicked" button-clicked-background COLOR: white <border-button-state-pen> dup dup
"button" button-background button-clicked-background
<border-button-state-pen> dup
"button-clicked" button-clicked-background COLOR: white
<border-button-state-pen> dup dup
<button-pen> ;
: border-button-theme ( gadget -- gadget )
dup children>> first font>> t >>bold? drop
horizontal >>orientation
<border-button-pen> >>interior
dup dup interior>> pen-pref-dim >>min-dim
@ -235,9 +229,12 @@ PRIVATE>
: command-button-quot ( target command -- quot )
'[ _ _ invoke-command ] ;
: gesture>tooltip ( gesture -- str )
[ gesture>string "Shortcut: " prepend ] [ "Shortcut Unassigned" ] if* ;
: <command-button> ( target gesture command -- button )
[ command-string swap ] keep command-button-quot
'[ drop @ ] <border-button> ;
swapd [ command-name swap ] keep command-button-quot
'[ drop @ ] <border-button> swap gesture>tooltip >>tooltip ;
: <toolbar> ( target -- toolbar )
<shelf>

2
basis/ui/gadgets/labels/labels.factor
View File

@ -4,7 +4,7 @@ USING: accessors arrays hashtables io kernel math math.functions
namespaces make opengl sequences strings splitting ui.gadgets
ui.gadgets.tracks ui.gadgets.packs fonts ui.render ui.pens.solid
ui.baseline-alignment ui.text colors colors.constants models
combinators ;
combinators opengl.gl ;
IN: ui.gadgets.labels
! A label gadget draws a string.

18
basis/ui/gadgets/status-bar/status-bar.factor
View File

@ -1,13 +1,23 @@
! Copyright (C) 2007, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors models models.delay models.arrow
sequences ui.gadgets.labels ui.gadgets.tracks
ui.gadgets.worlds ui.gadgets ui ui.private kernel calendar summary ;
USING: accessors calendar colors colors.constants fonts kernel
models models.arrow models.delay sequences summary ui
ui.gadgets ui.gadgets.labels ui.gadgets.tracks
ui.gadgets.worlds ui.pens.solid ui.private ;
IN: ui.gadgets.status-bar
: status-bar-font ( -- font )
sans-serif-font clone
COLOR: FactorDarkSlateBlue >>background
COLOR: white >>foreground ;
: status-bar-theme ( label -- label )
status-bar-font >>font
COLOR: FactorDarkSlateBlue <solid> >>interior ;
: <status-bar> ( model -- gadget )
1/10 seconds <delay> [ "" like ] <arrow> <label-control>
reverse-video-theme
status-bar-theme
t >>root? ;
: open-status-window ( gadget title/attributes -- )

7
basis/ui/tools/browser/browser.factor
View File

@ -11,7 +11,7 @@ ui.gadgets.viewports ui.tools.common ui.tools.browser.popups
ui.tools.browser.history ;
IN: ui.tools.browser
TUPLE: browser-gadget < tool history pane scroller search-field popup ;
TUPLE: browser-gadget < tool history scroller search-field popup ;
{ 650 400 } browser-gadget set-tool-dim
@ -59,9 +59,8 @@ M: browser-gadget set-history-value
dup <history> >>history
dup <search-field> >>search-field
dup <browser-toolbar> { 3 3 } <border> { 1 0 } >>fill f track-add
dup <help-pane> >>pane
dup pane>> <scroller> >>scroller
dup scroller>> 1 track-add ;
dup dup <help-pane> { 10 0 } <border> { 1 1 } >>fill
<scroller> >>scroller scroller>> 1 track-add ;
M: browser-gadget graft*
[ add-definition-observer ] [ call-next-method ] bi ;

11
basis/vocabs/prettyprint/prettyprint.factor
View File

@ -1,12 +1,13 @@
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel sorting sequences vocabs io io.styles arrays assocs
namespaces sets parser colors prettyprint.backend prettyprint.sections
vocabs.parser make fry math.order ;
USING: accessors arrays assocs colors colors.constants fry io
io.styles kernel make math.order namespaces parser
prettyprint.backend prettyprint.sections prettyprint.stylesheet
sequences sets sorting vocabs vocabs.parser ;
IN: vocabs.prettyprint
: pprint-vocab ( vocab -- )
[ vocab-name ] [ vocab ] bi present-text ;
[ vocab-name ] [ vocab vocab-style ] bi styled-text ;
: pprint-in ( vocab -- )
[ \ IN: pprint-word pprint-vocab ] with-pprint ;
@ -85,7 +86,7 @@ PRIVATE>
"To avoid doing this in the future, add the following forms" print
"at the top of the source file:" print nl
] with-style
{ { page-color T{ rgba f 0.8 0.8 0.8 1.0 } } }
{ { page-color COLOR: FactorLightTan } }
[ manifest get pprint-manifest ] with-nesting
nl nl
] print-use-hook set-global