some UI cleanups

diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt
index 95140dc75fd841b053848c20779e0ec3a3c767f6..335038eabbd0bcda83c2c99235f1a72b57f6b0a4 100644 (file)
--- a/TODO.FACTOR.txt
+++ b/TODO.FACTOR.txt
@@ -24,7 +24,6 @@
 - tabular output\r
 - debugger should use outlining\r
 - support nested incremental layouts more efficiently\r
-- make-pane should not need world-theme\r
 - only redraw dirty gadgets\r
 - find out why so many small bignums get consed\r
 - use incremental strategy for all pack layouts where possible\r

diff --git a/library/freetype/freetype-gl.factor b/library/freetype/freetype-gl.factor
index 0668f9333228e70bc204d0b9a4330769ebf03df8..75b2970d5d906ab1ed18663ab93b69cf9428ff15 100644 (file)
--- a/library/freetype/freetype-gl.factor
+++ b/library/freetype/freetype-gl.factor
@@ -34,6 +34,8 @@ SYMBOL: open-fonts
 ! sprites is a vector.
 TUPLE: font ascent descent height handle sprites ;
 
+M: font = eq? ;
+
 : flush-font ( font -- )
     #! Only do this after re-creating a GL context!
     dup font-sprites [ ] subset free-sprites
@@ -109,9 +111,9 @@ C: font ( handle -- font )
     first3 >r open-face dup 0 r> 6 shift
     dpi dpi FT_Set_Char_Size freetype-error <font> ;
 
-: lookup-font ( font style ptsize -- font )
+: lookup-font ( { font style ptsize } -- font )
     #! Cache open fonts.
-    3array open-fonts get [ open-font ] cache ;
+    open-fonts get [ open-font ] cache ;
 
 : load-glyph ( font char -- glyph )
     >r font-handle r> dupd 0 FT_Load_Char

diff --git a/library/help/tutorial.factor b/library/help/tutorial.factor
index 93fe46c29140106b06fc163f7f2ddace4f790ca4..bd5ce08287c0f9c89400d963851b7f47fce0a647 100644 (file)
--- a/library/help/tutorial.factor
+++ b/library/help/tutorial.factor
@@ -9,8 +9,8 @@ namespaces sdl sequences strings styles ;
 \r
 : <underline> ( -- gadget )\r
     <gadget>\r
-    dup << gradient f @{ @{ 64 64 64 }@ @{ 255 255 255 }@ }@ >>\r
-    interior set-paint-prop\r
+    << gradient f @{ @{ 64 64 64 }@ @{ 255 255 255 }@ }@ >>\r
+    over set-gadget-interior\r
     @{ 0 10 0 }@ over set-gadget-dim\r
     @{ 1 0 0 }@ over set-gadget-orientation ;\r
 \r
@@ -31,8 +31,8 @@ M: general-list tutorial-line
 \r
 : page-theme\r
     dup @{ 204 204 255 }@ background set-paint-prop\r
-    dup << gradient f @{ @{ 204 204 255 }@ @{ 255 204 255 }@ }@ >>\r
-    interior set-paint-prop\r
+    << gradient f @{ @{ 204 204 255 }@ @{ 255 204 255 }@ }@ >>\r
+    over set-gadget-interior\r
     dup "Sans Serif" font set-paint-prop\r
     16 font-size set-paint-prop ;\r
 \r
@@ -355,7 +355,7 @@ M: general-list tutorial-line
             "* Learning more"\r
             "--"\r
             "Hopefully this tutorial has sparked your interest in Factor."\r
-            ""\r
+            ""  \r
             "You can learn more by reading the Factor developer's handbook:"\r
             ""\r
             "http://factor.sourceforge.net/handbook.pdf"\r

diff --git a/library/ui/books.factor b/library/ui/books.factor
index 3935e1e26e3493c250cfe2ecfab357e0c254abdc..eb815e5d5361cdd56471acc16af08c9f1f7270bc 100644 (file)
--- a/library/ui/books.factor
+++ b/library/ui/books.factor
@@ -2,7 +2,8 @@
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: gadgets-books
 USING: gadgets gadgets-buttons gadgets-labels gadgets-layouts
-gadgets-theme generic kernel lists math namespaces sequences ;
+gadgets-theme generic kernel lists math namespaces sequences
+styles ;
 
 TUPLE: book page ;
 
@@ -34,7 +35,7 @@ TUPLE: book-browser book ;
     [ book-browser? ] find-parent book-browser-book ;
 
 : <book-button> ( polygon quot -- button )
-    \ find-book swons >r <polygon-gadget> dup icon-theme r>
+    \ find-book swons >r gray swap <polygon-gadget> r>
     <bevel-button> ;
 
 : <book-buttons> ( book -- gadget )

diff --git a/library/ui/editors.factor b/library/ui/editors.factor
index e75289ada5c5cc83a4874e2c0c042192316ff938..2b5a851dc73786c89a096cceac066cc994f0569d 100644 (file)
--- a/library/ui/editors.factor
+++ b/library/ui/editors.factor
@@ -29,7 +29,7 @@ USE: line-editor
 ! An editor gadget wraps a line editor object and passes
 ! gestures to the line editor.
 
-TUPLE: editor line caret ;
+TUPLE: editor line caret font color ;
 
 : scroll>caret ( editor -- ) editor-caret scroll-to ;
 
@@ -64,7 +64,7 @@ TUPLE: editor line caret ;
 : set-caret-x ( x editor -- )
     #! Move the caret to a clicked location.
     dup [
-        gadget-font line-text get x>offset set-caret-pos
+        label-font* line-text get x>offset set-caret-pos
     ] with-editor ;
 
 : click-editor ( editor -- )
@@ -122,7 +122,7 @@ C: editor ( text -- )
     dup editor-actions ;
 
 : offset>x ( gadget offset str -- x )
-    head-slice >r gadget-font r> string-width ;
+    head-slice >r label-font* r> string-width ;
 
 : caret-loc ( editor -- x y )
     dup editor-line [ caret-pos line-text get ] bind offset>x
@@ -141,8 +141,17 @@ M: editor layout* ( editor -- )
     dup editor-caret over caret-dim swap set-gadget-dim
     dup editor-caret swap caret-loc swap set-rect-loc ;
 
-M: editor label-text ( editor -- string )
-    editor-text ;
+M: editor label-text editor-text ;
+
+M: editor label-color editor-color ;
+
+M: editor label-font editor-font ;
+
+M: editor set-label-text set-editor-text ;
+
+M: editor set-label-color set-editor-color ;
+
+M: editor set-label-font set-editor-font ;
 
 M: editor draw-gadget* ( editor -- ) draw-label ;
 

diff --git a/library/ui/gadgets.factor b/library/ui/gadgets.factor
index 837bf739a6f6ed9e9522e6ce96c98767d35bd3f6..901b9347a931800eeb98a84ee5504b0eb7aeb872 100644 (file)
--- a/library/ui/gadgets.factor
+++ b/library/ui/gadgets.factor
@@ -40,11 +40,10 @@ M: array rect-dim drop @{ 0 0 0 }@ ;
 : rect-union ( rect rect -- rect )
     2rect-extent vmax >r vmin r> <extent-rect> ;
 
-! A gadget is a rectangle, a paint, a mapping of gestures to
-! actions, and a reference to the gadget's parent.
 TUPLE: gadget
-    paint gestures visible? relayout? root?
-    parent children orientation ;
+    parent children orientation
+    gestures visible? relayout? root?
+    interior boundary ;
 
 : show-gadget t swap set-gadget-visible? ;
 

diff --git a/library/ui/labels.factor b/library/ui/labels.factor
index 98a74c55d3eb42c9e1363a9753ae96fa5d9920b7..f6cae65a1ab2ab48f5c95ac08ec015435d282813 100644 (file)
--- a/library/ui/labels.factor
+++ b/library/ui/labels.factor
@@ -1,29 +1,35 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: gadgets-labels
-USING: arrays freetype gadgets gadgets-layouts generic
-hashtables io kernel math namespaces opengl sequences styles ;
+USING: arrays freetype gadgets gadgets-layouts gadgets-theme
+generic hashtables io kernel math namespaces opengl sequences
+styles ;
 
 ! A label gadget draws a string.
-TUPLE: label text ;
+TUPLE: label text font color ;
 
 C: label ( text -- label )
-    dup delegate>gadget [ set-label-text ] keep ;
+    dup delegate>gadget
+    [ set-label-text ] keep
+    dup label-theme ;
 
 : set-label-text* ( text label -- )
     2dup label-text =
     [ 2dup [ set-label-text ] keep relayout ] unless 2drop ;
 
+: label-font* ( label -- font )
+    label-font lookup-font ;
+
 : label-size ( gadget text -- dim )
-    dup gadget-font dup font-height >r
+    dup label-font* dup font-height >r
     swap label-text string-width r> 0 3array ;
 
 M: label pref-dim ( label -- dim )
     label-size ;
 
 : draw-label ( label -- )
-    dup foreground paint-prop gl-color
-    dup gadget-font swap label-text draw-string ;
+    dup label-color gl-color
+    dup label-font* swap label-text draw-string ;
 
 M: label draw-gadget* ( label -- ) draw-label ;
 

diff --git a/library/ui/listener.factor b/library/ui/listener.factor
index 6334e8a501be73b812d744c84b8659ee7f65eaed..3e7c6039f0e35cd751b30202b1b86cbc6a2ce6a9 100644 (file)
--- a/library/ui/listener.factor
+++ b/library/ui/listener.factor
@@ -63,7 +63,7 @@ C: display ( -- display )
     1/2 <x-splitter> ;
 
 : <status-bar> ( -- gadget )
-    "" <label> dup solid-interior dup reverse-video-theme ;
+    "" <label> dup reverse-video-theme ;
 
 : listener-application ( -- )
     t t <pane> dup pane global set-hash

diff --git a/library/ui/outliner.factor b/library/ui/outliner.factor
index 42da01fdb16a9592c60c826da58887d91c518a71..3cb44821f13d3e196e9e7464f94c7941db247133 100644 (file)
--- a/library/ui/outliner.factor
+++ b/library/ui/outliner.factor
@@ -3,7 +3,7 @@
 IN: gadgets-outliner
 USING: arrays gadgets gadgets-borders gadgets-buttons
 gadgets-labels gadgets-layouts gadgets-panes gadgets-theme
-generic io kernel lists sequences ;
+generic io kernel lists sequences styles ;
 
 ! Outliner gadget.
 TUPLE: outliner quot ;
@@ -24,8 +24,7 @@ DEFER: <expand-button>
     [ outliner? ] find-parent ;
 
 : <expand-arrow> ( ? -- gadget )
-    arrow-right arrow-down ? <polygon-gadget>
-    dup icon-theme <border> ;
+    arrow-right arrow-down ? gray swap <polygon-gadget> <border> ;
 
 : <expand-button> ( ? -- gadget )
     #! If true, the button expands, otherwise it collapses.

diff --git a/library/ui/paint.factor b/library/ui/paint.factor
index 296c581518f6f559f6709279fc621a36965efb97..4c5ac6e3d4a6c7648f5d38cdaad2785dd07a1426 100644 (file)
--- a/library/ui/paint.factor
+++ b/library/ui/paint.factor
@@ -5,24 +5,12 @@ io kernel lists math namespaces opengl sdl sequences strings
 styles vectors ;
 IN: gadgets
 
-: paint-prop* ( gadget key -- value ) swap gadget-paint ?hash ;
-
-: paint-prop ( gadget key -- value )
-    over [
-        2dup paint-prop* dup
-        [ 2nip ] [ drop >r gadget-parent r> paint-prop ] if
-    ] [
-        2drop f
-    ] if ;
-
 GENERIC: draw-gadget* ( gadget -- )
 
 M: gadget draw-gadget* ( gadget -- ) drop ;
 
-SYMBOL: interior
-SYMBOL: boundary
-
 GENERIC: draw-interior ( gadget interior -- )
+
 GENERIC: draw-boundary ( gadget boundary -- )
 
 SYMBOL: clip
@@ -32,9 +20,9 @@ SYMBOL: clip
 DEFER: draw-gadget
 
 : (draw-gadget) ( gadget -- )
-    dup dup interior paint-prop* draw-interior
-    dup dup boundary paint-prop* draw-boundary
-    dup draw-gadget* ;
+    dup dup gadget-interior draw-interior
+    dup dup gadget-boundary draw-boundary
+    draw-gadget* ;
 
 : do-clip ( gadget -- )
     >absolute clip [ rect-intersect dup ] change
@@ -51,37 +39,24 @@ DEFER: draw-gadget
     clip get over inside? [
         [
             dup do-clip
-            [ dup (draw-gadget) ] with-translation
-            visible-children [ draw-gadget ] each
+            dup [ (draw-gadget) ] with-translation
+            dup visible-children [ draw-gadget ] each
         ] with-scope
     ] when drop ;
 
-: init-paint ( gadget -- gestures )
-    dup gadget-paint
-    [ ] [ {{ }} clone dup rot set-gadget-paint ] ?if ;
-
-: set-paint-prop ( gadget value key -- )
-    rot init-paint set-hash ;
-
-: add-paint ( gadget hash -- )
-    dup [ >r init-paint r> hash-update ] [ 2drop ] if ;
-
 ! Pen paint properties
 M: f draw-interior 2drop ;
 M: f draw-boundary 2drop ;
 
 ! Solid fill/border
-TUPLE: solid ;
-
-: rect>screen ( shape -- x1 y1 x2 y2 )
-    >r origin get dup r> rect-dim v+ [ first2 ] 2apply ;
+TUPLE: solid color ;
 
 ! Solid pen
 M: solid draw-interior
-    drop dup background paint-prop gl-color rect-dim gl-fill-rect ;
+    solid-color gl-color rect-dim gl-fill-rect ;
 
 M: solid draw-boundary
-    drop dup foreground paint-prop gl-color rect-dim gl-rect ;
+    solid-color gl-color rect-dim gl-rect ;
 
 ! Gradient pen
 TUPLE: gradient colors ;
@@ -91,15 +66,16 @@ M: gradient draw-interior ( gadget gradient -- )
     gl-gradient ;
 
 ! Polygon pen
-TUPLE: polygon points ;
+TUPLE: polygon color points ;
+
+: draw-polygon ( polygon quot -- )
+    >r dup polygon-color gl-color polygon-points r> each ; inline
 
 M: polygon draw-boundary ( gadget polygon -- )
-    swap foreground paint-prop gl-color
-    polygon-points [ gl-poly ] each ;
+    [ gl-poly ] draw-polygon drop ;
 
 M: polygon draw-interior ( gadget polygon -- )
-    swap background paint-prop gl-color
-    polygon-points [ gl-fill-poly ] each ;
+    [ gl-fill-poly ] draw-polygon drop ;
 
 : arrow-up    @{ @{ @{ 3 0 0 }@ @{ 6 6 0 }@ @{ 0 6 0 }@ }@ }@ ;
 : arrow-right @{ @{ @{ 0 0 0 }@ @{ 6 3 0 }@ @{ 0 6 0 }@ }@ }@ ;
@@ -112,13 +88,7 @@ M: polygon draw-interior ( gadget polygon -- )
 : arrow-|left
     @{ @{ @{ 1 0 0 }@ @{ 1 6 0 }@ }@ }@ arrow-left append ;
 
-: <polygon-gadget> ( points -- gadget )
+: <polygon-gadget> ( color points -- gadget )
     dup @{ 0 0 0 }@ [ max-dim vmax ] reduce
     >r <polygon> <gadget> r> over set-rect-dim
-    dup rot interior set-paint-prop ;
-
-: gadget-font ( gadget -- font )
-    [ font paint-prop ] keep
-    [ font-style paint-prop ] keep
-    [ font-size paint-prop ] keep
-    >r lookup-font r> drop ;
+    [ set-gadget-interior ] keep ;

diff --git a/library/ui/panes.factor b/library/ui/panes.factor
index 576e47b04d508f23b8354af0ff6116fa70acc551..ac8d69a8338d165e11c72dffd29eda77cc7147f9 100644 (file)
--- a/library/ui/panes.factor
+++ b/library/ui/panes.factor
@@ -57,13 +57,12 @@ SYMBOL: structured-input
     pane-input set-editor-text ;
 
 : <input-button> ( string -- button )
-    dup <label> swap [ nip pane get replace-input ] curry
+    dup <label> dup editor-theme
+    swap [ nip pane get replace-input ] curry
     <roll-button> ;
 
 : print-input ( string pane -- )
-    [
-        <input-button> dup bold font-style set-paint-prop gadget.
-    ] with-stream* ;
+    [ <input-button> gadget. ] with-stream* ;
 
 : pane-return ( pane -- )
     dup pane-input dup [
@@ -145,7 +144,7 @@ M: pane stream-close ( pane -- ) drop ;
 
 : make-pane ( quot -- pane )
     #! Execute the quotation with output to an output-only pane.
-    f f <pane> dup world-theme [ swap with-stream ] keep ; inline
+    f f <pane> [ swap with-stream ] keep ; inline
 
 : with-pane ( pane quot -- )
     #! Clear the pane and run the quotation in a scope with

diff --git a/library/ui/presentations.factor b/library/ui/presentations.factor
index b71364b21ff40b1f71fd127c194993d602ffe710..c43c221b48ae0eaa4452b66dd14431f3c84aaf77 100644 (file)
--- a/library/ui/presentations.factor
+++ b/library/ui/presentations.factor
@@ -39,10 +39,10 @@ M: command-button gadget-help ( button -- string )
     command-button-object dup word? [ synopsis ] [ summary ] if ;
 
 : init-commands ( gadget -- gadget )
-    dup presented paint-prop [ <command-button> ] when* ;
+    ( dup presented paint-prop [ <command-button> ] when* ) ;
 
 : <styled-label> ( style text -- label )
-    <label> dup rot dup [ alist>hash ] when add-paint ;
+    <label> nip ; ! dup rot dup [ alist>hash ] when add-paint ;
 
 : <presentation> ( style text -- presentation )
     gadget pick assoc dup

diff --git a/library/ui/sliders.factor b/library/ui/sliders.factor
index daad8ffeac9c0b55b478a2adf17d5134c5237381..b29b2b6652827cc639dd56daf665cc5dd8e39def 100644 (file)
--- a/library/ui/sliders.factor
+++ b/library/ui/sliders.factor
@@ -107,7 +107,7 @@ M: elevator layout* ( elevator -- )
 : slider-vertical? gadget-orientation @{ 0 1 0 }@ = ;
 
 : <slide-button> ( orientation polygon amount -- )
-    >r <polygon-gadget> dup icon-theme r>
+    >r gray swap <polygon-gadget> r>
     [ swap slide-by-line ] curry <repeat-button>
     [ set-gadget-orientation ] keep ;
 

diff --git a/library/ui/splitters.factor b/library/ui/splitters.factor
index c0dd5311ebac94c03a4b04bbf8d2d166079dc093..fd35831888f63be4e08da73e88ab0adceb3fa1f0 100644 (file)
--- a/library/ui/splitters.factor
+++ b/library/ui/splitters.factor
@@ -26,7 +26,9 @@ TUPLE: splitter split ;
     [ gadget-parent divider-motion ] [ drag 1 ] set-action ;
 
 C: divider ( -- divider )
-    dup delegate>gadget dup divider-theme dup divider-actions ;
+    dup delegate>gadget
+    dup reverse-video-theme
+    dup divider-actions ;
 
 C: splitter ( first second split vector -- splitter )
     [ delegate>pack ] keep

diff --git a/library/ui/theme.factor b/library/ui/theme.factor
index 1569416d297a29b61c7de53fcad32da895136807..2ab3df1abe83eedbd3b41f917869d7622d1c6516 100644 (file)
--- a/library/ui/theme.factor
+++ b/library/ui/theme.factor
@@ -3,14 +3,20 @@
 IN: gadgets-buttons
 DEFER: <button-paint>
 
+IN: gadgets-labels
+DEFER: set-label-color
+DEFER: set-label-font
+
 IN: gadgets-theme
 USING: arrays gadgets kernel sequences styles ;
 
-: solid-interior ( gadget -- )
-    << solid >> interior set-paint-prop ;
+: solid-black << solid f @{ 0 0 0 }@ >> ;
+
+: solid-white << solid f @{ 255 255 255 }@ >> ;
+
+: solid-interior solid-white swap set-gadget-interior ;
 
-: solid-boundary ( gadget -- )
-    << solid >> boundary set-paint-prop ;
+: solid-boundary solid-black swap set-gadget-boundary ;
 
 : plain-gradient
     << gradient f @{
@@ -38,56 +44,40 @@ USING: arrays gadgets kernel sequences styles ;
 
 : bevel-button-theme ( gadget -- )
     plain-gradient rollover-gradient pressed-gradient
-    <button-paint> interior set-paint-prop ;
+    <button-paint> swap set-gadget-interior ;
 
 : thumb-theme ( thumb -- )
-    plain-gradient interior set-paint-prop ;
-
-: editor-theme ( editor -- )
-    bold font-style set-paint-prop ;
+    plain-gradient swap set-gadget-interior ;
 
 : roll-button-theme ( button -- )
-    dup f f << solid >> << solid >> <button-paint> boundary set-paint-prop
-    dup f f f << solid >> <button-paint> interior set-paint-prop
-    @{ 236 230 232 }@ background set-paint-prop ;
+    f solid-black solid-black <button-paint> over set-gadget-boundary
+    f f << solid f @{ 236 230 232 }@ >> <button-paint> swap set-gadget-interior ;
 
 : caret-theme ( caret -- )
-    dup solid-interior
-    red background set-paint-prop ;
+    << solid f @{ 255 0 0 }@ >> swap set-gadget-interior ;
 
 : elevator-theme ( elevator -- )
-    dup << gradient f @{
+    << gradient f @{
         @{ 64 64 64 }@
         @{ 96 96 96 }@
         @{ 128 128 128 }@
-    }@ >> interior set-paint-prop
-    light-gray background set-paint-prop ;
+    }@ >> swap set-gadget-interior ;
 
 : reverse-video-theme ( gadget -- )
-    dup black background set-paint-prop
-    white foreground set-paint-prop ;
-
-: divider-theme ( divider -- )
-    dup solid-interior reverse-video-theme ;
+    solid-black swap set-gadget-interior ;
 
 : display-title-theme
-    dup @{ 216 232 255 }@ background set-paint-prop
-    solid-interior ;
+    << solid f @{ 216 232 255 }@ >> swap set-gadget-interior ;
 
 : menu-theme ( menu -- )
     dup solid-boundary
     << gradient f @{ @{ 216 216 216 }@ @{ 255 255 255 }@ }@ >>
-    interior set-paint-prop ;
-
-: icon-theme ( gadget -- )
-    dup gray background set-paint-prop
-    gray foreground set-paint-prop ;
-
-: world-theme
-    {{
-        [[ background @{ 255 255 255 }@ ]]
-        [[ foreground @{ 0 0 0 }@ ]]
-        [[ font "Monospaced" ]]
-        [[ font-size 12 ]]
-        [[ font-style plain ]]
-    }} add-paint ;
+    swap set-gadget-interior ;
+
+: label-theme ( label -- )
+    @{ 0 0 0 }@ over set-label-color
+    @{ "Monospaced" plain 12 }@ swap set-label-font ;
+
+: editor-theme ( editor -- )
+    @{ 0 0 0 }@ over set-label-color
+    @{ "Monospaced" bold 12 }@ swap set-label-font ;

diff --git a/library/ui/ui.factor b/library/ui/ui.factor
index f0b3140ae4f7438931a3839a7cb8a91fb63b28d3..0ec7a64fb738de77b44b54ddf1414085cc84f4df 100644 (file)
--- a/library/ui/ui.factor
+++ b/library/ui/ui.factor
@@ -15,7 +15,6 @@ global [ first-time on ] bind
         first-time get [
             <world> world set
             world get solid-interior
-            world get world-theme
             @{ 800 600 0 }@ world get set-gadget-dim
             <hand> hand set
             listener-application