diff --git a/basis/fonts/fonts.factor b/basis/fonts/fonts.factor index fb89bdbfb0..5806becd1a 100644 --- a/basis/fonts/fonts.factor +++ b/basis/fonts/fonts.factor @@ -9,7 +9,8 @@ size bold? italic? { foreground initial: COLOR: black } -{ background initial: COLOR: white } ; +{ background initial: COLOR: white } +shadow ; : ( -- font ) font new ; inline @@ -37,6 +38,7 @@ italic? [ [ italic?>> ] either? >>italic? ] [ [ foreground>> ] either? >>foreground ] [ [ background>> ] either? >>background ] + [ [ shadow>> ] either? >>shadow ] } 2cleave ] when* ; @@ -56,7 +58,7 @@ italic? 12 >>size ; : strip-font-colors ( font -- font' ) - clone f >>background f >>foreground ; + clone f >>background f >>foreground f >>shadow ; TUPLE: metrics width ascent descent height leading cap-height x-height ; diff --git a/basis/help/markup/markup.factor b/basis/help/markup/markup.factor index 2270088490..6e75adc8aa 100644 --- a/basis/help/markup/markup.factor +++ b/basis/help/markup/markup.factor @@ -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 diff --git a/basis/help/stylesheet/stylesheet.factor b/basis/help/stylesheet/stylesheet.factor index c7811a605d..28861794fe 100644 --- a/basis/help/stylesheet/stylesheet.factor +++ b/basis/help/stylesheet/stylesheet.factor @@ -17,7 +17,7 @@ H{ SYMBOL: link-style H{ - { foreground COLOR: dark-blue } + { foreground COLOR: DodgerBlue4 } { font-style bold } } link-style set-global @@ -33,12 +33,14 @@ H{ { font-size 18 } { font-style bold } { wrap-margin 500 } - { page-color COLOR: light-gray } + { foreground T{ rgba f 0.216 0.243 0.282 1.0 } } + { shadow COLOR: white } + { page-color T{ rgba f 0.94 0.94 0.91 1.0 } } { border-width 5 } } title-style set-global SYMBOL: help-path-style -H{ { font-size 10 } } help-path-style set-global +H{ { font-size 10 } { shadow f } } help-path-style set-global SYMBOL: heading-style H{ @@ -58,12 +60,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 T{ rgba f 0.94 0.94 0.91 1.0 } } { border-width 5 } { wrap-margin f } } code-style set-global @@ -101,7 +109,7 @@ H{ SYMBOL: table-style H{ { table-gap { 5 5 } } - { table-border COLOR: light-gray } + { table-border T{ rgba f 0.94 0.94 0.91 1.0 } } } table-style set-global SYMBOL: list-style diff --git a/basis/io/styles/styles-docs.factor b/basis/io/styles/styles-docs.factor index 8fcf12aae9..d5219b5522 100755 --- a/basis/io/styles/styles-docs.factor +++ b/basis/io/styles/styles-docs.factor @@ -121,6 +121,7 @@ ARTICLE: "character-styles" "Character styles" "Character styles for " { $link stream-format } " and " { $link with-style } ":" { $subsection foreground } { $subsection background } +{ $subsection shadow } { $subsection font-name } { $subsection font-size } { $subsection font-style } @@ -205,6 +206,18 @@ HELP: background } } ; +HELP: shadow +{ $description "Character style. An instance of " { $link color } ". See " { $link "colors" } "." } +{ $examples + { $code + "\"Hello world\\n\"" + "H{ { background COLOR: gray }" + " { shadow COLOR: white }" + " { font-size 72 }" + "} format" + } +} ; + HELP: font-name { $description "Character style. Font family named by a string." } { $examples diff --git a/basis/io/styles/styles.factor b/basis/io/styles/styles.factor index 2d25016919..7dbb90ffb4 100644 --- a/basis/io/styles/styles.factor +++ b/basis/io/styles/styles.factor @@ -116,6 +116,7 @@ SYMBOL: bold-italic ! Character styles SYMBOL: foreground SYMBOL: background +SYMBOL: shadow SYMBOL: font-name SYMBOL: font-size SYMBOL: font-style diff --git a/basis/prettyprint/backend/backend.factor b/basis/prettyprint/backend/backend.factor index 76cf8806f4..90e2388934 100644 --- a/basis/prettyprint/backend/backend.factor +++ b/basis/prettyprint/backend/backend.factor @@ -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 ; diff --git a/basis/prettyprint/stylesheet/stylesheet.factor b/basis/prettyprint/stylesheet/stylesheet.factor new file mode 100644 index 0000000000..2be959cc9b --- /dev/null +++ b/basis/prettyprint/stylesheet/stylesheet.factor @@ -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 ; \ No newline at end of file diff --git a/basis/see/see.factor b/basis/see/see.factor index 1b3bd4bfb5..3b15e0ee6e 100644 --- a/basis/see/see.factor +++ b/basis/see/see.factor @@ -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* ; { $values { "label" gadget } { "quot" { $quotation "( button -- )" } } { "button" "a new " { $link button } } } diff --git a/basis/ui/gadgets/buttons/buttons.factor b/basis/ui/gadgets/buttons/buttons.factor index ec11bac2d3..c65309e06d 100644 --- a/basis/ui/gadgets/buttons/buttons.factor +++ b/basis/ui/gadgets/buttons/buttons.factor @@ -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 ; >>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 ) @@ -132,11 +138,14 @@ CONSTANT: button-clicked-background } : ( -- pen ) - "button" button-background COLOR: black dup - "button-clicked" button-clicked-background COLOR: white dup dup + "button" button-background button-clicked-background + dup + "button-clicked" button-clicked-background COLOR: white + dup dup ; : border-button-theme ( gadget -- gadget ) + dup children>> first font>> t >>bold? drop horizontal >>orientation >>interior dup dup interior>> pen-pref-dim >>min-dim @@ -235,9 +244,12 @@ PRIVATE> : command-button-quot ( target command -- quot ) '[ _ _ invoke-command ] ; +: gesture>tooltip ( gesture -- str ) + [ gesture>string "Shortcut: " prepend ] [ "Shortcut Unassigned" ] if* ; + : ( target gesture command -- button ) - [ command-string swap ] keep command-button-quot - '[ drop @ ] ; + swapd [ command-name swap ] keep command-button-quot + '[ drop @ ] swap gesture>tooltip >>tooltip ; : ( target -- toolbar ) diff --git a/basis/ui/gadgets/labels/labels.factor b/basis/ui/gadgets/labels/labels.factor index eb992f1428..9a6d7d47b3 100644 --- a/basis/ui/gadgets/labels/labels.factor +++ b/basis/ui/gadgets/labels/labels.factor @@ -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. @@ -65,14 +65,25 @@ M: label baseline M: label cap-height label-metrics cap-height>> round ; -M: label draw-gadget* - >label< - [ - background get [ font-with-background ] when* - foreground get [ font-with-foreground ] when* - ] dip +: draw-text* ( font text fg bg -- ) + [ rot ] dip + [ font-with-background ] when* swap + [ font-with-foreground ] when* swap draw-text ; +: draw-shadowed-text ( font text -- ) + [ + { 0 1 } [ over shadow>> background get draw-text* ] + with-translation + ] [ foreground get transparent draw-text* ] 2bi ; + +: draw-normal-text ( font text -- ) + foreground get background get draw-text* ; + +M: label draw-gadget* + >label< over shadow>> + [ draw-shadowed-text ] [ draw-normal-text ] if ; + M: label gadget-text* string>> % ; TUPLE: label-control < label ; diff --git a/basis/ui/gadgets/panes/panes.factor b/basis/ui/gadgets/panes/panes.factor index 6f68c32ff0..4c922141f6 100644 --- a/basis/ui/gadgets/panes/panes.factor +++ b/basis/ui/gadgets/panes/panes.factor @@ -11,7 +11,7 @@ ui.gadgets.menus ui.clipboards ui.gestures ui.traverse ui.render ui.text ui.gadgets.presentations ui.gadgets.grids ui.gadgets.tracks ui.gadgets.icons ui.gadgets.grid-lines ui.baseline-alignment colors io.styles ; -FROM: io.styles => foreground background ; +FROM: io.styles => foreground background shadow ; IN: ui.gadgets.panes TUPLE: pane < track @@ -199,11 +199,12 @@ MEMO: specified-font ( assoc -- font ) [ font-size swap at >>size ] [ foreground swap at >>foreground ] [ background swap at >>background ] + [ shadow swap at >>shadow ] } cleave derive-font ; : apply-font-style ( style gadget -- style gadget ) - { font-name font-style font-size foreground background } + { font-name font-style font-size foreground background shadow } pick extract-keys specified-font >>font ; : apply-style ( style gadget key quot -- style gadget ) diff --git a/basis/ui/gadgets/status-bar/status-bar.factor b/basis/ui/gadgets/status-bar/status-bar.factor index 0d3015508e..e8f0648727 100644 --- a/basis/ui/gadgets/status-bar/status-bar.factor +++ b/basis/ui/gadgets/status-bar/status-bar.factor @@ -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 + T{ rgba f 0.216 0.243 0.282 1.0 } >>background + COLOR: white >>foreground ; + +: status-bar-theme ( label -- label ) + status-bar-font >>font + T{ rgba f 0.216 0.243 0.282 1.0 } >>interior ; + : ( model -- gadget ) 1/10 seconds [ "" like ] - reverse-video-theme + status-bar-theme t >>root? ; : open-status-window ( gadget title/attributes -- ) diff --git a/basis/ui/tools/browser/browser.factor b/basis/ui/tools/browser/browser.factor index 21d827da9b..d3aa56a694 100644 --- a/basis/ui/tools/browser/browser.factor +++ b/basis/ui/tools/browser/browser.factor @@ -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 dup >>search-field dup { 3 3 } { 1 0 } >>fill f track-add - dup >>pane - dup pane>> >>scroller - dup scroller>> 1 track-add ; + dup dup { 10 0 } { 1 1 } >>fill + >>scroller scroller>> 1 track-add ; M: browser-gadget graft* [ add-definition-observer ] [ call-next-method ] bi ; diff --git a/basis/vocabs/prettyprint/prettyprint.factor b/basis/vocabs/prettyprint/prettyprint.factor index 66bc277ef7..20f7c15293 100644 --- a/basis/vocabs/prettyprint/prettyprint.factor +++ b/basis/vocabs/prettyprint/prettyprint.factor @@ -2,11 +2,11 @@ ! 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 ; +prettyprint.stylesheet vocabs.parser make fry math.order ; 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 +85,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 T{ rgba f 0.94 0.94 0.91 1.0 } } } [ manifest get pprint-manifest ] with-nesting nl nl ] print-use-hook set-global \ No newline at end of file