Add horizontal and vertical orientation constants, working on baseline alignment

diff --git a/basis/ui/gadgets/buttons/buttons.factor b/basis/ui/gadgets/buttons/buttons.factor
index 86ba579e7e0a9bb42adb5efb53586f134b7153b6..43cdab53218d56ae2e5a2defc99331ee24c77c75 100644 (file)
--- a/basis/ui/gadgets/buttons/buttons.factor
+++ b/basis/ui/gadgets/buttons/buttons.factor
@@ -150,15 +150,10 @@ M: checkmark-paint draw-interior
 : toggle-model ( model -- )
     [ not ] change-model ;
 
-: checkbox-theme ( gadget -- gadget )
-    f >>interior
-    { 5 5 } >>gap
-    1/2 >>align ; inline
-
 TUPLE: checkbox < button ;
 
 : <checkbox> ( model label -- checkbox )
-    <checkmark> label-on-right checkbox-theme
+    <checkmark> label-on-right
     [ model>> toggle-model ]
     checkbox new-button
         swap >>model
@@ -173,7 +168,7 @@ TUPLE: radio-paint < caching-pen color interior-vertices boundary-vertices ;
 
 <PRIVATE
 
-: circle-steps 8 ;
+CONSTANT: circle-steps 8
 
 PRIVATE>
 
@@ -223,12 +218,8 @@ M: radio-control model-changed
 :: <radio-controls> ( parent model assoc quot: ( value model label -- gadget ) -- parent )
     assoc model [ parent swap quot call add-gadget ] assoc-each ; inline
 
-: radio-button-theme ( gadget -- gadget )
-    { 5 5 } >>gap
-    1/2 >>align ; inline
-
 : <radio-button> ( value model label -- gadget )
-    <radio-knob> label-on-right radio-button-theme <radio-control> ;
+    <radio-knob> label-on-right <radio-control> ;
 
 : <radio-buttons> ( model assoc -- gadget )
     <filled-pile>

diff --git a/basis/ui/gadgets/editors/editors.factor b/basis/ui/gadgets/editors/editors.factor
index 25a92a685217a051b5a297450515130b26011cfb..867158df4f65cab71b16fcbabd8355c0027520fb 100755 (executable)
--- a/basis/ui/gadgets/editors/editors.factor
+++ b/basis/ui/gadgets/editors/editors.factor
@@ -242,6 +242,9 @@ M: editor draw-gadget*
 M: editor pref-dim*
     [ font>> ] [ control-value ] bi text-dim ;
 
+M: editor baseline
+    font>> "" line-metrics ascent>> ;
+
 : contents-changed ( model editor -- )
     swap
     over caret>> [ over validate-loc ] (change-model)
@@ -585,7 +588,7 @@ TUPLE: field < wrapper editor min-width max-width ;
     gray <solid> >>boundary ; inline
 
 : <field-border> ( gadget -- border )
-    2 <border>
+    { 2 2 } <border>
         { 1 0 } >>fill
         field-theme ;
 

diff --git a/basis/ui/gadgets/gadgets.factor b/basis/ui/gadgets/gadgets.factor
index f9cad9525124f13c6895ea3494771e76ec99aa8b..34a0d5c92ff11dfbdac8a303cda9663983a7dac2 100644 (file)
--- a/basis/ui/gadgets/gadgets.factor
+++ b/basis/ui/gadgets/gadgets.factor
@@ -6,6 +6,10 @@ binary-search vectors dlists deques models threads
 concurrency.flags math.order math.geometry.rect fry ;
 IN: ui.gadgets
 
+! Values for orientation slot
+CONSTANT: horizontal { 1 0 }
+CONSTANT: vertical { 0 1 }
+
 TUPLE: gadget < rect pref-dim parent children orientation focus
 visible? root? clipped? layout-state graft-state graft-node
 interior boundary model ;
@@ -103,14 +107,14 @@ GENERIC: gadget-text* ( gadget -- )
 GENERIC: gadget-text-separator ( gadget -- str )
 
 M: gadget gadget-text-separator
-    orientation>> { 0 1 } = "\n" "" ? ;
+    orientation>> vertical = "\n" "" ? ;
 
 : gadget-seq-text ( seq gadget -- )
     gadget-text-separator swap
     [ dup % ] [ gadget-text* ] interleave drop ;
 
 M: gadget gadget-text*
-    dup children>> swap gadget-seq-text ;
+    [ children>> ] keep gadget-seq-text ;
 
 M: array gadget-text*
     [ gadget-text* ] each ;

diff --git a/basis/ui/gadgets/grid-lines/grid-lines.factor b/basis/ui/gadgets/grid-lines/grid-lines.factor
index a28f21c3ad52dc11b2af9f86ae6b1dfb231515bb..fd1847966246700c391ea3f1bd709a6128f41984 100755 (executable)
--- a/basis/ui/gadgets/grid-lines/grid-lines.factor
+++ b/basis/ui/gadgets/grid-lines/grid-lines.factor
@@ -28,7 +28,7 @@ M: grid-lines draw-boundary
         [ grid set ]
         [ dim>> half-gap v- grid-dim set ]
         [ compute-grid ] tri
-        [ { 1 0 } draw-grid-lines ]
-        [ { 0 1 } draw-grid-lines ]
+        [ horizontal draw-grid-lines ]
+        [ vertical draw-grid-lines ]
         bi*
     ] with-scope ;

diff --git a/basis/ui/gadgets/grids/grids.factor b/basis/ui/gadgets/grids/grids.factor
index 83542998e2b5f6a3f41e91729ef832def371e858..8a448fddf1b79911084e284e99e3852d4ab19cca 100644 (file)
--- a/basis/ui/gadgets/grids/grids.factor
+++ b/basis/ui/gadgets/grids/grids.factor
@@ -48,8 +48,8 @@ grid
     dupd add-gaps dim-sum v+ ;
 
 M: grid pref-dim*
-    dup gap>> swap compute-grid [ over ] dip
-    [ gap-sum ] 2bi@ (pair-up) ;
+    [ gap>> ] [ compute-grid ] bi
+    [ over ] dip [ gap-sum ] 2bi@ (pair-up) ;
 
 : do-grid ( dims grid quot -- )
     [ grid>> ] dip '[ _ 2each ] 2each ; inline

diff --git a/basis/ui/gadgets/incremental/incremental.factor b/basis/ui/gadgets/incremental/incremental.factor
index 81c980afbc486ac3079a24184a879a2871ef6fa9..29d8f8ab030baa323da14069b75b931414e20979 100644 (file)
--- a/basis/ui/gadgets/incremental/incremental.factor
+++ b/basis/ui/gadgets/incremental/incremental.factor
@@ -9,7 +9,7 @@ TUPLE: incremental < pack cursor ;
 
 : <incremental> ( -- incremental )
     incremental new-gadget
-        { 0 1 } >>orientation
+        vertical >>orientation
         { 0 0 } >>cursor ;
 
 M: incremental pref-dim*

diff --git a/basis/ui/gadgets/labelled/labelled.factor b/basis/ui/gadgets/labelled/labelled.factor
index 636e25cea5967bbdd18dcbef55cdced281784efa..6bcea200f3666a591511dbf57ddf66729f73a0f2 100644 (file)
--- a/basis/ui/gadgets/labelled/labelled.factor
+++ b/basis/ui/gadgets/labelled/labelled.factor
@@ -11,7 +11,7 @@ IN: ui.gadgets.labelled
 TUPLE: labelled-gadget < track content ;
 
 : <labelled-gadget> ( gadget title -- newgadget )
-    { 0 1 } labelled-gadget new-track
+    vertical labelled-gadget new-track
         swap <label> reverse-video-theme f track-add
         swap >>content
         dup content>> 1 track-add ;

diff --git a/basis/ui/gadgets/labels/labels.factor b/basis/ui/gadgets/labels/labels.factor
index 3739a9044c5c637f9d10b1cabfbb33f4357f8692..2eebdac7ffb03e6c2fef03cf046fde2e059dec47 100644 (file)
--- a/basis/ui/gadgets/labels/labels.factor
+++ b/basis/ui/gadgets/labels/labels.factor
@@ -1,9 +1,9 @@
 ! Copyright (C) 2005, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays hashtables io kernel math namespaces
-make opengl sequences strings splitting ui.gadgets
-ui.gadgets.tracks fonts ui.render
-ui.text colors models ;
+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.text
+colors models ;
 IN: ui.gadgets.labels
 
 ! A label gadget draws a string.
@@ -35,7 +35,8 @@ M: label pref-dim*
     >label< text-dim ;
 
 M: label baseline
-    >label< line-metrics ascent>> ;
+    >label< dup string? [ first ] unless
+    line-metrics ascent>> ceiling ;
 
 M: label draw-gadget*
     >label< origin get draw-text ;
@@ -64,12 +65,20 @@ M: array >label <label> ;
 M: object >label ;
 M: f >label drop <gadget> ;
 
+<PRIVATE
+
+: label-on-left/right ( -- track )
+    horizontal <track>
+        +baseline+ >>align
+        { 5 5 } >>gap ; inline
+PRIVATE>
+
 : label-on-left ( gadget label -- button )
-    { 1 0 } <track>
+    label-on-left/right
         swap >label f track-add
         swap 1 track-add ;
 
 : label-on-right ( label gadget -- button )
-    { 1 0 } <track>
+    label-on-left/right
         swap f track-add
         swap >label 1 track-add ;

diff --git a/basis/ui/gadgets/packs/packs-docs.factor b/basis/ui/gadgets/packs/packs-docs.factor
index 14a229067b25e2e94a51101648264769e10c2f95..c9196d127469ba209dde30450add00c2012207a1 100644 (file)
--- a/basis/ui/gadgets/packs/packs-docs.factor
+++ b/basis/ui/gadgets/packs/packs-docs.factor
@@ -1,5 +1,5 @@
 USING: ui.gadgets help.markup help.syntax generic kernel
-classes.tuple quotations ;
+classes.tuple quotations ui.gadgets.packs.private ;
 IN: ui.gadgets.packs
 
 ARTICLE: "ui-pack-layout" "Pack layouts"
@@ -38,7 +38,7 @@ HELP: pack-layout
 
 HELP: <pack>
 { $values { "orientation" "an orientation specifier" } { "pack" "a new " { $link pack } } }
-{ $description "Creates a new pack which lays out children along the given axis. Children are laid out vertically if the orientation is " { $snippet "{ 0 1 }" } " and horizontally if the orientation is " { $snippet "{ 1 0 }" } "." } ;
+{ $description "Creates a new pack which lays out children with the given orientation, either " { $link horizontal } " or " { $link vertical } "." } ;
 
 { <pack> <pile> <shelf> } related-words
 

diff --git a/basis/ui/gadgets/packs/packs-tests.factor b/basis/ui/gadgets/packs/packs-tests.factor
index 8b52a2ad2fbee5fb31be319c5d41c8dfb8f7880a..90d9e776c3cad798b8c1576a3bff2c03041d90ba 100644 (file)
--- a/basis/ui/gadgets/packs/packs-tests.factor
+++ b/basis/ui/gadgets/packs/packs-tests.factor
@@ -1,5 +1,6 @@
 IN: ui.gadgets.packs.tests
-USING: ui.gadgets.packs ui.gadgets.labels ui.gadgets ui.render
+USING: ui.gadgets.packs ui.gadgets.packs.private
+ui.gadgets.labels ui.gadgets ui.render
 kernel namespaces tools.test math.parser sequences math.geometry.rect
 accessors ;
 
@@ -7,7 +8,7 @@ accessors ;
     { 0 0 } { 100 100 } <rect> clip set
 
     <pile>
-      100 [ number>string <label> add-gadget ] each
+        100 [ number>string <label> add-gadget ] each
     dup layout
 
     visible-children [ label? ] all?
@@ -16,6 +17,30 @@ accessors ;
 [ { { 10 30 } } ] [
     { { 10 20 } }
     { { 100 30 } }
-    <gadget> { 0 1 } >>orientation
+    <gadget> vertical >>orientation
     orient
 ] unit-test
+
+TUPLE: baseline-gadget < gadget baseline ;
+
+M: baseline-gadget baseline baseline>> ;
+
+: <baseline-gadget> ( baseline dim -- gadget )
+    baseline-gadget new-gadget
+    swap >>dim
+    swap >>baseline ;
+
+<shelf> +baseline+ >>align
+    5 { 10 10 } <baseline-gadget> add-gadget
+    10 { 10 10 } <baseline-gadget> add-gadget
+"g" set
+
+[ ] [ "g" get prefer ] unit-test
+
+[ { 20 15 } ] [ "g" get dim>> ] unit-test
+
+[ V{ { 0 5 } { 10 0 } } ] [
+    "g" get
+    dup layout
+    children>> [ loc>> ] map
+] unit-test
\ No newline at end of file

diff --git a/basis/ui/gadgets/packs/packs.factor b/basis/ui/gadgets/packs/packs.factor
index 86dc6ea354f92d384004377abb41fc4d42c5fbb1..35919751f56bde00ea0f9997ce4c8b3e0d28e779 100644 (file)
--- a/basis/ui/gadgets/packs/packs.factor
+++ b/basis/ui/gadgets/packs/packs.factor
@@ -1,67 +1,95 @@
-! Copyright (C) 2005, 2008 Slava Pestov.
+! Copyright (C) 2005, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: sequences ui.gadgets kernel math math.functions
 math.vectors math.order math.geometry.rect namespaces accessors
-fry ;
+fry combinators arrays ;
 IN: ui.gadgets.packs
 
+SYMBOL: +baseline+
+
 TUPLE: pack < gadget
 { align initial: 0 } { fill initial: 0 } { gap initial: { 0 0 } } ;
 
-: packed-dim-2 ( gadget sizes -- list )
+<PRIVATE
+
+: (packed-dims) ( gadget sizes -- list )
     swap [ dim>> ] [ fill>> ] bi '[ _ over v- _ v*n v+ ] map ;
 
 : orient ( seq1 seq2 gadget -- seq )
     orientation>> '[ _ set-axis ] 2map ;
 
 : packed-dims ( gadget sizes -- seq )
-    [ packed-dim-2 ] [ nip ] [ drop ] 2tri orient ;
+    [ (packed-dims) ] [ nip ] [ drop ] 2tri orient ;
+
+: gap-locs ( sizes gap -- seq )
+    [ { 0 0 } ] dip '[ v+ _ v+ ] accumulate nip ;
 
-: gap-locs ( gap sizes -- seq )
-    { 0 0 } [ v+ over v+ ] accumulate 2nip ;
+: numerically-aligned-locs ( sizes pack -- seq )
+    [ align>> ] [ dim>> ] bi '[ [ _ _ ] dip v- n*v ] map ;
 
-: aligned-locs ( gadget sizes -- seq )
-    [ [ [ align>> ] [ dim>> ] bi ] dip v- n*v ] with map ;
+: baseline-aligned-locs ( pack -- seq )
+    children>> [ baseline ] map [ supremum ] keep
+    [ - 0 swap 2array ] with map ;
 
-: packed-locs ( gadget sizes -- seq )
-    [ aligned-locs ] [ [ gap>> ] dip gap-locs ] [ drop ] 2tri orient ;
+: aligned-locs ( sizes pack -- seq )
+    dup align>> +baseline+ eq?
+    [ nip baseline-aligned-locs ]
+    [ numerically-aligned-locs ]
+    if ;
+
+: packed-locs ( sizes pack -- seq )
+    [ aligned-locs ] [ gap>> gap-locs ] [ nip ] 2tri orient ;
 
 : round-dims ( seq -- newseq )
-    { 0 0 } swap
+    [ { 0 0 } ] dip
     [ swap v- dup [ ceiling >fixnum ] map [ swap v- ] keep ] map
     nip ;
 
+PRIVATE>
+
 : pack-layout ( pack sizes -- )
-    round-dims over children>>
-    [ dupd packed-dims ] dip
-    [ [ (>>dim) ] 2each ]
-    [ [ packed-locs ] dip [ (>>loc) ] 2each ] 2bi ;
+    [ round-dims packed-dims ] [ drop ] 2bi
+    [ children>> [ (>>dim) ] 2each ]
+    [ [ packed-locs ] [ children>> ] bi [ (>>loc) ] 2each ] 2bi ;
 
 : <pack> ( orientation -- pack )
     pack new-gadget
         swap >>orientation ;
 
-: <pile> ( -- pack ) { 0 1 } <pack> ;
+: <pile> ( -- pack ) vertical <pack> ;
 
 : <filled-pile> ( -- pack ) <pile> 1 >>fill ;
 
-: <shelf> ( -- pack ) { 1 0 } <pack> ;
+: <shelf> ( -- pack ) horizontal <pack> ;
 
-: gap-dims ( sizes gadget -- seeq )
-    [ [ dim-sum ] [ length 1 [-] ] bi ] [ gap>> ] bi* n*v v+ ;
+<PRIVATE
+
+: gap-dims ( gadget sizes -- seeq )
+    [ gap>> ] [ [ length 1 [-] ] [ dim-sum ] bi ] bi* [ v*n ] dip v+ ;
 
 : pack-pref-dim ( gadget sizes -- dim )
-    [ nip max-dim ]
-    [ swap gap-dims ]
-    [ drop orientation>> ]
-    2tri set-axis ;
+    [ nip max-dim ] [ gap-dims ] [ drop orientation>> ] 2tri set-axis ;
 
 M: pack pref-dim*
     dup children>> pref-dims pack-pref-dim ;
 
+: vertical-baseline ( pack -- y )
+    children>> [ 0 ] [ first baseline ] if-empty ;
+
+: horizontal-baseline ( pack -- y )
+    children>> [ baseline ] map supremum ;
+
+PRIVATE>
+
+M: pack baseline
+    dup orientation>> {
+        { vertical [ vertical-baseline ] }
+        { horizontal [ horizontal-baseline ] }
+    } case ;
+
 M: pack layout*
     dup children>> pref-dims pack-layout ;
 
 M: pack children-on ( rect gadget -- seq )
-    dup orientation>> swap children>>
+    [ orientation>> ] [ children>> ] bi
     [ fast-children-on ] keep <slice> ;

diff --git a/basis/ui/gadgets/panes/panes.factor b/basis/ui/gadgets/panes/panes.factor
index 0c3d739b98ebe59acf0326718bf65d5735ade823..98037b08bd882f2dd0956a86f0d3db55c4aa3387 100644 (file)
--- a/basis/ui/gadgets/panes/panes.factor
+++ b/basis/ui/gadgets/panes/panes.factor
@@ -48,8 +48,8 @@ M: pane gadget-selection ( pane -- string/f )
 
 : new-pane ( class -- pane )
     new-gadget
-        { 0 1 } >>orientation
-        <shelf> >>prototype
+        vertical >>orientation
+        <shelf> +baseline+ >>align >>prototype
         <incremental> add-output
         dup prepare-line
         selection-color >>selection-color ;
@@ -231,7 +231,7 @@ MEMO: specified-font ( assoc -- font )
     page-color [ solid-interior ] apply-style ;
 
 : apply-border-width-style ( style gadget -- style gadget )
-    border-width [ <border> ] apply-style ;
+    border-width [ dup 2array <border> ] apply-style ;
 
 : style-pane ( style pane -- pane )
     apply-border-width-style

diff --git a/basis/ui/gadgets/paragraphs/paragraphs.factor b/basis/ui/gadgets/paragraphs/paragraphs.factor
index 6e26a2989f0c7342ac0e6f268e6ce209d517d7bb..9cb32da1c3b4972ca634266382a14d54b199632b 100644 (file)
--- a/basis/ui/gadgets/paragraphs/paragraphs.factor
+++ b/basis/ui/gadgets/paragraphs/paragraphs.factor
@@ -18,7 +18,7 @@ TUPLE: paragraph < gadget margin ;
 
 : <paragraph> ( margin -- gadget )
     paragraph new-gadget
-    { 1 0 } >>orientation
+    horizontal >>orientation
     swap >>margin ;
 
 SYMBOL: x SYMBOL: max-x

diff --git a/basis/ui/gadgets/sliders/sliders.factor b/basis/ui/gadgets/sliders/sliders.factor
index 349bc38675740eaf490414c4041ecba3f9e35c90..29671ff0e3f5581ceafe9ee6abae71004d2904c6 100644 (file)
--- a/basis/ui/gadgets/sliders/sliders.factor
+++ b/basis/ui/gadgets/sliders/sliders.factor
@@ -76,13 +76,14 @@ thumb H{
 : slide-by-page ( amount slider -- ) model>> move-by-page ;
 
 : compute-direction ( elevator -- -1/1 )
-    dup find-slider swap hand-click-rel
-    over orientation>> v.
-    over screen>slider
-    swap slider-value - sgn ;
+    [ hand-click-rel ] [ find-slider ] bi
+    [ orientation>> v. ]
+    [ screen>slider ]
+    [ slider-value - sgn ]
+    tri ;
 
 : elevator-hold ( elevator -- )
-    dup direction>> swap find-slider slide-by-page ;
+    [ direction>> ] [ find-slider ] bi slide-by-page ;
 
 : elevator-click ( elevator -- )
     dup compute-direction >>direction
@@ -94,15 +95,15 @@ elevator H{
 } set-gestures
 
 : <elevator> ( vector -- elevator )
-  elevator new-gadget
-    swap             >>orientation
-    lowered-gradient >>interior ;
+    elevator new-gadget
+        swap >>orientation
+        lowered-gradient >>interior ;
 
 : (layout-thumb) ( slider n -- n thumb )
     over orientation>> n*v swap thumb>> ;
 
 : thumb-loc ( slider -- loc )
-    dup slider-value swap slider>screen ;
+    [ slider-value ] keep slider>screen ;
 
 : layout-thumb-loc ( slider -- )
     dup thumb-loc (layout-thumb)
@@ -136,8 +137,8 @@ M: elevator layout*
 
 : <left-button>  ( -- button ) { 0 1 } arrow-left -1 <slide-button> ;
 : <right-button> ( -- button ) { 0 1 } arrow-right 1 <slide-button> ;
-: <up-button>    ( -- button ) { 1 0 } arrow-up   -1 <slide-button> ;
-: <down-button>  ( -- button ) { 1 0 } arrow-down  1 <slide-button> ;
+: <up-button>    ( -- button ) horizontal arrow-up   -1 <slide-button> ;
+: <down-button>  ( -- button ) horizontal arrow-down  1 <slide-button> ;
 
 : <slider> ( range orientation -- slider )
     slider new-frame
@@ -146,15 +147,15 @@ M: elevator layout*
         32 >>line ;
 
 : <x-slider> ( range -- slider )
-    { 1 0 } <slider>
+    horizontal <slider>
         <left-button> @left grid-add
-        { 0 1 } elevator,
+        vertical elevator,
         <right-button> @right grid-add ;
 
 : <y-slider> ( range -- slider )
-    { 0 1 } <slider>
+    vertical <slider>
         <up-button> @top grid-add
-        { 1 0 } elevator,
+        horizontal elevator,
         <down-button> @bottom grid-add ;
 
 M: slider pref-dim*

diff --git a/basis/ui/gadgets/slots/slots.factor b/basis/ui/gadgets/slots/slots.factor
index 305f8f2b26fa300be4e94ff5ab53cae46201d4f0..592900d0cbf6867141f511e1c41302f6341ca5cf 100644 (file)
--- a/basis/ui/gadgets/slots/slots.factor
+++ b/basis/ui/gadgets/slots/slots.factor
@@ -65,7 +65,7 @@ TUPLE: slot-editor < track ref close-hook update-hook text ;
 } define-command
 
 : <slot-editor> ( close-hook update-hook ref -- gadget )
-    { 0 1 } slot-editor new-track
+    vertical slot-editor new-track
         swap >>ref
         swap >>update-hook
         swap >>close-hook

diff --git a/basis/ui/gadgets/tabbed/tabbed.factor b/basis/ui/gadgets/tabbed/tabbed.factor
index 92bf24bcd5cdb9ccf371668289d425d3108af8af..07c33bd796039d626ca51101673d975f7faffe69 100644 (file)
--- a/basis/ui/gadgets/tabbed/tabbed.factor
+++ b/basis/ui/gadgets/tabbed/tabbed.factor
@@ -7,7 +7,7 @@ IN: ui.gadgets.tabbed
 TUPLE: tabbed-gadget < track tabs book ;
 
 : <tabbed-gadget> ( -- gadget )
-    { 0 1 } tabbed-gadget new-track
+    vertical tabbed-gadget new-track
         0 <model> >>model
         <shelf> >>tabs
         dup tabs>> f track-add

diff --git a/basis/ui/gadgets/tracks/tracks-docs.factor b/basis/ui/gadgets/tracks/tracks-docs.factor
index 9ed5bf422394dbf5ec0026913f8d1099732ee988..b83865fd52f213479da54203ab05a65ad03b3254 100644 (file)
--- a/basis/ui/gadgets/tracks/tracks-docs.factor
+++ b/basis/ui/gadgets/tracks/tracks-docs.factor
@@ -15,7 +15,7 @@ HELP: track
 
 HELP: <track>
 { $values { "orientation" "an orientation specifier" } { "track" "a new " { $link track } } }
-{ $description "Creates a new track which lays out children along the given axis. Children are laid out vertically if the orientation is " { $snippet "{ 0 1 }" } " and horizontally if the orientation is " { $snippet "{ 1 0 }" } "." } ; 
+{ $description "Creates a new track which lays out children along the given orientation, either " { $link horizontal } " or " { $link vertical } "." } ;
 
 HELP: track-add
 { $values { "gadget" gadget } { "track" track } { "constraint" "a number between 0 and 1, or " { $link f } } }

diff --git a/basis/ui/gadgets/tracks/tracks-tests.factor b/basis/ui/gadgets/tracks/tracks-tests.factor
index 0ce348e9b711ec2a194dcc66ec39fb06a64ba8f0..f84b9084790181cb9db155234b73d64ede7cf745 100644 (file)
--- a/basis/ui/gadgets/tracks/tracks-tests.factor
+++ b/basis/ui/gadgets/tracks/tracks-tests.factor
@@ -3,27 +3,27 @@ USING: kernel ui.gadgets ui.gadgets.tracks tools.test
 IN: ui.gadgets.tracks.tests
 
 [ { 100 100 } ] [
-    { 0 1 } <track>
+    vertical <track>
         <gadget> { 100 100 } >>dim 1 track-add
     pref-dim    
 ] unit-test
 
 [ { 100 110 } ] [
-    { 0 1 } <track>
+    vertical <track>
         <gadget> { 10 10 } >>dim f track-add
         <gadget> { 100 100 } >>dim 1 track-add
     pref-dim
 ] unit-test
 
 [ { 10 10 } ] [
-    { 0 1 } <track>
+    vertical <track>
         <gadget> { 10 10 } >>dim 1 track-add
         <gadget> { 10 10 } >>dim 0 track-add
     pref-dim
 ] unit-test
 
 [ { 10 30 } ] [
-    { 0 1 } <track>
+    vertical <track>
         <gadget> { 10 10 } >>dim f track-add
         <gadget> { 10 10 } >>dim f track-add
         <gadget> { 10 10 } >>dim f track-add
@@ -31,7 +31,7 @@ IN: ui.gadgets.tracks.tests
 ] unit-test
 
 [ { 10 40 } ] [
-    { 0 1 } <track>
+    vertical <track>
         { 5 5 } >>gap
         <gadget> { 10 10 } >>dim f track-add
         <gadget> { 10 10 } >>dim f track-add

diff --git a/basis/ui/gadgets/worlds/worlds.factor b/basis/ui/gadgets/worlds/worlds.factor
index dce04b040cd3f3bff3ff2eb7781afda6212911c4..6baa4972ed9e0c33303ba3b468ef3c3bdf0a1f6a 100644 (file)
--- a/basis/ui/gadgets/worlds/worlds.factor
+++ b/basis/ui/gadgets/worlds/worlds.factor
@@ -39,7 +39,7 @@ M: world request-focus-on ( child gadget -- )
     [ 2drop ] [ dup focused?>> (request-focus) ] if ;
 
 : new-world ( gadget title status class -- world )
-    { 0 1 } swap new-track
+    vertical swap new-track
         t >>root?
         t >>active?
         H{ } clone >>fonts

diff --git a/basis/ui/gadgets/wrappers/wrappers.factor b/basis/ui/gadgets/wrappers/wrappers.factor
index 01585d01dba4d02c997eab69f343e1db15d0cce9..ba499f859292bb2f39daf103ea594dc06c6f1208 100644 (file)
--- a/basis/ui/gadgets/wrappers/wrappers.factor
+++ b/basis/ui/gadgets/wrappers/wrappers.factor
@@ -10,8 +10,10 @@ TUPLE: wrapper < gadget ;
 
 : <wrapper> ( child -- wrapper ) wrapper new-wrapper ;
 
-M: wrapper pref-dim* ( wrapper -- dim ) gadget-child pref-dim ;
+M: wrapper pref-dim* gadget-child pref-dim ;
 
-M: wrapper layout* ( wrapper -- ) [ dim>> ] [ gadget-child ] bi (>>dim) ;
+M: wrapper baseline gadget-child baseline ;
 
-M: wrapper focusable-child* ( wrapper -- child/t ) gadget-child ;
+M: wrapper layout* [ gadget-child ] [ dim>> ] bi >>dim drop ;
+
+M: wrapper focusable-child* gadget-child ;

diff --git a/basis/ui/tools/browser/browser.factor b/basis/ui/tools/browser/browser.factor
index 0c88f7b81bb791ba9ca3a3adb1b340a994831079..d18d72f2c6e11f2d9ba10ffaadfd50480cc388ef 100644 (file)
--- a/basis/ui/tools/browser/browser.factor
+++ b/basis/ui/tools/browser/browser.factor
@@ -30,13 +30,13 @@ TUPLE: browser-gadget < tool pane scroller search-field ;
 
 : <browser-toolbar> ( browser -- toolbar )
     <shelf>
+        +baseline+ >>align
         { 5 5 } >>gap
         over <toolbar> add-gadget
-        "Search:" <label> add-gadget
-        swap search-field>> add-gadget ;
+        swap search-field>> "Search:" label-on-left add-gadget ;
 
 : <browser-gadget> ( link -- gadget )
-    { 0 1 } browser-gadget new-track
+    vertical browser-gadget new-track
         swap >link <history> >>model
         dup <search-field> >>search-field
         dup <browser-toolbar> f track-add

diff --git a/basis/ui/tools/debugger/debugger.factor b/basis/ui/tools/debugger/debugger.factor
index cfe7baf0ae9b404a756d1f0df5107092a751bb8d..9bd7be33ea5123cea396b17489362be0390b6066 100644 (file)
--- a/basis/ui/tools/debugger/debugger.factor
+++ b/basis/ui/tools/debugger/debugger.factor
@@ -28,7 +28,7 @@ TUPLE: debugger < track error restarts restart-hook restart-list continuation ;
 PRIVATE>
 
 : <debugger> ( error restarts restart-hook -- gadget )
-    { 0 1 } debugger new-track
+    vertical debugger new-track
         add-toolbar
         swap >>restart-hook
         swap >>restarts

diff --git a/basis/ui/tools/inspector/inspector.factor b/basis/ui/tools/inspector/inspector.factor
index a2ec6df6a784939bcc6c8e1da8cec49a02b15529..fa45868c64fe0028e1c5b62dac7a7ad8959059cc 100644 (file)
--- a/basis/ui/tools/inspector/inspector.factor
+++ b/basis/ui/tools/inspector/inspector.factor
@@ -66,7 +66,7 @@ M: hashtable make-slot-descriptions
         monospace-font >>font ;
 
 : <inspector-gadget> ( obj -- gadget )
-    { 0 1 } inspector-gadget new-track
+    vertical inspector-gadget new-track
         add-toolbar
         swap <model> >>model
         dup model>> <inspector-table> >>table

diff --git a/basis/ui/tools/listener/listener.factor b/basis/ui/tools/listener/listener.factor
index 8a48d25db80241d38ad2c25ce56f81c9b6d6ab4e..c064906f70283e4a227df15269d6516f795f0d9d 100644 (file)
--- a/basis/ui/tools/listener/listener.factor
+++ b/basis/ui/tools/listener/listener.factor
@@ -176,7 +176,7 @@ TUPLE: listener-gadget < tool input output scroller popup ;
     <scroller> ;
 
 : <listener-gadget> ( -- gadget )
-    { 0 1 } listener-gadget new-track
+    vertical listener-gadget new-track
         add-toolbar
         init-listener
         dup <listener-scroller> >>scroller

diff --git a/basis/ui/tools/profiler/profiler.factor b/basis/ui/tools/profiler/profiler.factor
index e61ec25bd50e98d22063a4ceb44dbcb36ddcebf0..1dfc471c88075e56d61d66959955a8d59994d832 100644 (file)
--- a/basis/ui/tools/profiler/profiler.factor
+++ b/basis/ui/tools/profiler/profiler.factor
@@ -98,7 +98,7 @@ M: method-renderer row-value drop first ;
     } ;
 
 : <sort-options> ( model -- gadget )
-    sort-options <radio-buttons> { 1 0 } >>orientation ;
+    sort-options <radio-buttons> horizontal >>orientation ;
 
 : <profiler-tool-bar> ( profiler -- gadget )
     <shelf>
@@ -108,7 +108,7 @@ M: method-renderer row-value drop first ;
         swap sort>> <sort-options> add-gadget ;
 
 :: <words-tab> ( profiler -- gadget )
-    { 1 0 } <track>
+    horizontal <track>
         profiler vocabs>> <profiler-table>
             profiler vocab>> >>selected-value
             vocab-renderer >>renderer
@@ -120,8 +120,8 @@ M: method-renderer row-value drop first ;
     1/2 track-add ;
 
 :: <methods-tab> ( profiler -- gadget )
-    { 0 1 } <track>
-        { 1 0 } <track>
+    vertical <track>
+        horizontal <track>
             profiler <generic-model> <profiler-table>
                 profiler generic>> >>selected-value
                 word-renderer >>renderer
@@ -141,7 +141,7 @@ M: method-renderer row-value drop first ;
 : <selection-model> ( -- model ) { f 0 } <model> ;
 
 : <profiler-gadget> ( -- profiler )
-    { 0 1 } profiler-gadget new-track
+    vertical profiler-gadget new-track
         [ [ first ] compare ] <model> >>sort
         all-words counters <model> >>words
         <selection-model> >>vocab

diff --git a/basis/ui/tools/traceback/traceback.factor b/basis/ui/tools/traceback/traceback.factor
index e98787e1019a955c7eef8557e0e5e3d8f744b1f9..2d96dbb9c5c5c85233d5eac3b4aba6a86ed25c72 100644 (file)
--- a/basis/ui/tools/traceback/traceback.factor
+++ b/basis/ui/tools/traceback/traceback.factor
@@ -24,11 +24,11 @@ TUPLE: traceback-gadget < track ;
 M: traceback-gadget pref-dim* drop { 550 600 } ;
 
 : <traceback-gadget> ( model -- gadget )
-    { 0 1 } traceback-gadget new-track
+    vertical traceback-gadget new-track
         swap >>model
 
     dup model>>
-        { 1 0 } <track>
+        horizontal <track>
             over <datastack-display> 1/2 track-add
             swap <retainstack-display> 1/2 track-add
         1/3 track-add

diff --git a/basis/ui/tools/walker/walker.factor b/basis/ui/tools/walker/walker.factor
index c5d6dd7cdc56f4b3a942a5fad695002a19e61af8..80a40cb0e6f7d92a5b14a666f7189a710b8075d6 100644 (file)
--- a/basis/ui/tools/walker/walker.factor
+++ b/basis/ui/tools/walker/walker.factor
@@ -58,7 +58,7 @@ M: walker-gadget focusable-child*
     '[ _ walker-state-string ] <filter> <label-control> ;
 
 : <walker-gadget> ( status continuation thread -- gadget )
-    { 0 1 } walker-gadget new-track
+    vertical walker-gadget new-track
         swap >>thread
         swap >>continuation
         swap >>status

diff --git a/basis/ui/traverse/traverse.factor b/basis/ui/traverse/traverse.factor
index 7765b73d12184d141bd56eefcbad8427abd0935f..63c656205c9d410fcc1a17b5d759aae3d82aa324 100644 (file)
--- a/basis/ui/traverse/traverse.factor
+++ b/basis/ui/traverse/traverse.factor
@@ -78,7 +78,7 @@ DEFER: (gadget-subtree)
     [ (gadget-subtree) ] { } make ;
 
 M: node gadget-text*
-    dup children>> swap value>> gadget-seq-text ;
+    [ children>> ] [ value>> ] bi gadget-seq-text ;
 
 : gadget-text-range ( frompath topath gadget -- str )
     gadget-subtree gadget-text ;

diff --git a/basis/ui/ui-docs.factor b/basis/ui/ui-docs.factor
index fd3bf668905c8f5581e04ce389b1f1c05f0c78fa..4507bf230a490681a4b07604a2bdf6a2853fb057 100644 (file)
--- a/basis/ui/ui-docs.factor
+++ b/basis/ui/ui-docs.factor
@@ -71,7 +71,7 @@ ARTICLE: "ui-glossary" "UI glossary"
     { "font" { "an instance of " { $link font } } }
     { "gadget" { "a graphical element which responds to user input. Gadgets are tuples which (directly or indirectly) inherit from " { $link gadget } "." } }
     { "label specifier" { "a string, " { $link f } " or a gadget. See " { $link "ui.gadgets.buttons" } } }
-    { "orientation specifier" { "one of " { $snippet "{ 0 1 }" } " or " { $snippet "{ 1 0 }" } ", with the former denoting vertical orientation and the latter denoting horizontal. Using a vector instead of symbolic constants allows these values to be directly useful in co-ordinate calculations" } }
+    { "orientation specifier" { "one of " { $link horizontal } " or " { $link vertical } } }
     { "point" "a pair of integers denoting a pixel location on screen" }
 } ;