From daee5345876415895570582de1f2c0c6c3b35c0e Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Sat, 30 Aug 2008 21:58:13 -0500 Subject: [PATCH] Update accessors from ui.gadgets.{grid-lines,grids,incremental,labelled,labels,lists,panes} --- .../gadgets/grid-lines/grid-lines-docs.factor | 2 +- basis/ui/gadgets/grid-lines/grid-lines.factor | 6 +++--- basis/ui/gadgets/grids/grids-docs.factor | 4 ++-- basis/ui/gadgets/grids/grids.factor | 6 +++--- .../ui/gadgets/incremental/incremental.factor | 12 +++++------ basis/ui/gadgets/labelled/labelled.factor | 4 ++-- basis/ui/gadgets/labels/labels.factor | 4 ++-- basis/ui/gadgets/lists/lists.factor | 20 +++++++++---------- basis/ui/gadgets/panes/panes.factor | 8 ++++---- 9 files changed, 33 insertions(+), 33 deletions(-) diff --git a/basis/ui/gadgets/grid-lines/grid-lines-docs.factor b/basis/ui/gadgets/grid-lines/grid-lines-docs.factor index 92f6846774..0838f1ded7 100755 --- a/basis/ui/gadgets/grid-lines/grid-lines-docs.factor +++ b/basis/ui/gadgets/grid-lines/grid-lines-docs.factor @@ -3,4 +3,4 @@ ui.render ; IN: ui.gadgets.grid-lines HELP: grid-lines -{ $class-description "A class implementing the " { $link draw-boundary } " generic word to draw lines between the cells of a " { $link grid } ". The color of the lines is a color specifier stored in the " { $link grid-lines-color } " slot." } ; +{ $class-description "A class implementing the " { $link draw-boundary } " generic word to draw lines between the cells of a " { $link grid } ". The color of the lines is a color specifier stored in the " { $snippet "color" } " slot." } ; diff --git a/basis/ui/gadgets/grid-lines/grid-lines.factor b/basis/ui/gadgets/grid-lines/grid-lines.factor index 3f08425e95..f4266adba1 100755 --- a/basis/ui/gadgets/grid-lines/grid-lines.factor +++ b/basis/ui/gadgets/grid-lines/grid-lines.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2006, 2007 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel math namespaces opengl opengl.gl sequences +USING: kernel accessors math namespaces opengl opengl.gl sequences math.vectors ui.gadgets ui.gadgets.grids ui.render math.geometry.rect ; IN: ui.gadgets.grid-lines @@ -10,7 +10,7 @@ C: grid-lines SYMBOL: grid-dim -: half-gap grid get grid-gap [ 2/ ] map ; inline +: half-gap grid get gap>> [ 2/ ] map ; inline : grid-line-from/to ( orientation point -- from to ) half-gap v- @@ -25,7 +25,7 @@ SYMBOL: grid-dim M: grid-lines draw-boundary origin get [ -0.5 -0.5 0.0 glTranslated - grid-lines-color set-color [ + color>> set-color [ dup grid set dup rect-dim half-gap v- grid-dim set compute-grid diff --git a/basis/ui/gadgets/grids/grids-docs.factor b/basis/ui/gadgets/grids/grids-docs.factor index 3217392dd5..64e14c4961 100755 --- a/basis/ui/gadgets/grids/grids-docs.factor +++ b/basis/ui/gadgets/grids/grids-docs.factor @@ -14,9 +14,9 @@ ARTICLE: "ui-grid-layout" "Grid layouts" HELP: grid { $class-description "A grid gadget lays out its children so that all gadgets in a column have equal width and all gadgets in a row have equal height." $nl -"The " { $link grid-gap } " slot stores a pair of integers, the horizontal and vertical gap between children, respectively." +"The " { $snippet "gap" } " slot stores a pair of integers, the horizontal and vertical gap between children, respectively." $nl -"The " { $link grid-fill? } " slot stores a boolean, indicating if grid cells should assume their preferred size, or if they should fill the dimensions of the cell. The default is " { $link t } "." +"The " { $snippet "fill?" } " slot stores a boolean, indicating if grid cells should assume their preferred size, or if they should fill the dimensions of the cell. The default is " { $link t } "." $nl "Grids are created by calling " { $link } " and children are managed with " { $link grid-add } " and " { $link grid-remove } "." $nl diff --git a/basis/ui/gadgets/grids/grids.factor b/basis/ui/gadgets/grids/grids.factor index 4b60b9e5c8..83e5e73662 100644 --- a/basis/ui/gadgets/grids/grids.factor +++ b/basis/ui/gadgets/grids/grids.factor @@ -48,7 +48,7 @@ grid dupd add-gaps dim-sum v+ ; M: grid pref-dim* - dup grid-gap swap compute-grid >r over r> + dup gap>> swap compute-grid >r over r> gap-sum >r gap-sum r> (pair-up) ; : do-grid ( dims grid quot -- ) @@ -57,7 +57,7 @@ M: grid pref-dim* drop ; inline : grid-positions ( grid dims -- locs ) - >r grid-gap dup r> add-gaps swap [ v+ ] accumulate nip ; + >r gap>> dup r> add-gaps swap [ v+ ] accumulate nip ; : position-grid ( grid horiz vert -- ) pick >r @@ -65,7 +65,7 @@ M: grid pref-dim* pair-up r> [ set-rect-loc ] do-grid ; : resize-grid ( grid horiz vert -- ) - pick grid-fill? [ + pick fill?>> [ pair-up swap [ (>>dim) ] do-grid ] [ 2drop grid>> [ [ prefer ] each ] each diff --git a/basis/ui/gadgets/incremental/incremental.factor b/basis/ui/gadgets/incremental/incremental.factor index 826be68b97..77b88959c9 100755 --- a/basis/ui/gadgets/incremental/incremental.factor +++ b/basis/ui/gadgets/incremental/incremental.factor @@ -24,20 +24,20 @@ TUPLE: incremental < pack cursor ; M: incremental pref-dim* dup layout-state>> [ - dup call-next-method over set-incremental-cursor - ] when incremental-cursor ; + dup call-next-method over (>>cursor) + ] when cursor>> ; : next-cursor ( gadget incremental -- cursor ) [ - swap rect-dim swap incremental-cursor + swap rect-dim swap cursor>> 2dup v+ >r vmax r> ] keep orientation>> set-axis ; : update-cursor ( gadget incremental -- ) - [ next-cursor ] keep set-incremental-cursor ; + [ next-cursor ] keep (>>cursor) ; : incremental-loc ( gadget incremental -- ) - dup incremental-cursor swap orientation>> v* + dup cursor>> swap orientation>> v* swap set-rect-loc ; : prefer-incremental ( gadget -- ) @@ -57,5 +57,5 @@ M: incremental pref-dim* not-in-layout dup (clear-gadget) dup forget-pref-dim - { 0 0 } over set-incremental-cursor + { 0 0 } over (>>cursor) parent>> [ relayout ] when* ; diff --git a/basis/ui/gadgets/labelled/labelled.factor b/basis/ui/gadgets/labelled/labelled.factor index 49ccd5aabe..6c7d463b0b 100755 --- a/basis/ui/gadgets/labelled/labelled.factor +++ b/basis/ui/gadgets/labelled/labelled.factor @@ -16,7 +16,7 @@ TUPLE: labelled-gadget < track content ; swap >>content dup content>> 1 track-add ; -M: labelled-gadget focusable-child* labelled-gadget-content ; +M: labelled-gadget focusable-child* content>> ; : ( gadget title -- gadget ) >r r> ; @@ -53,4 +53,4 @@ TUPLE: closable-gadget < frame content ; swap >>content dup content>> @center grid-add ; -M: closable-gadget focusable-child* closable-gadget-content ; +M: closable-gadget focusable-child* content>> ; diff --git a/basis/ui/gadgets/labels/labels.factor b/basis/ui/gadgets/labels/labels.factor index 24dbd04fde..af7dff0039 100755 --- a/basis/ui/gadgets/labels/labels.factor +++ b/basis/ui/gadgets/labels/labels.factor @@ -14,9 +14,9 @@ TUPLE: label < gadget text font color ; : set-label-string ( string label -- ) CHAR: \n pick memq? [ - >r string-lines r> set-label-text + >r string-lines r> (>>text) ] [ - set-label-text + (>>text) ] if ; inline : label-theme ( gadget -- gadget ) diff --git a/basis/ui/gadgets/lists/lists.factor b/basis/ui/gadgets/lists/lists.factor index 795307cf25..67c0ccc496 100755 --- a/basis/ui/gadgets/lists/lists.factor +++ b/basis/ui/gadgets/lists/lists.factor @@ -27,8 +27,8 @@ TUPLE: list < pack index presenter color hook ; control-value length 1- min 0 max ; : bound-index ( list -- ) - dup list-index over calc-bounded-index - swap set-list-index ; + dup index>> over calc-bounded-index + swap (>>index) ; : list-presentation-hook ( list -- quot ) hook>> [ [ list? ] find-parent ] prepend ; @@ -53,18 +53,18 @@ M: list model-changed bound-index ; : selected-rect ( list -- rect ) - dup list-index swap children>> ?nth ; + dup index>> swap children>> ?nth ; M: list draw-gadget* origin get [ - dup list-color set-color + dup color>> set-color selected-rect [ rect-extent gl-fill-rect ] when* ] with-translation ; M: list focusable-child* drop t ; : list-value ( list -- object ) - dup list-index swap control-value ?nth ; + dup index>> swap control-value ?nth ; : scroll>selected ( list -- ) #! We change the rectangle's width to zero to avoid @@ -79,22 +79,22 @@ M: list focusable-child* drop t ; 2drop ] [ [ control-value length rem ] keep - [ set-list-index ] keep + [ (>>index) ] keep [ relayout-1 ] keep scroll>selected ] if ; : select-previous ( list -- ) - dup list-index 1- swap select-index ; + dup index>> 1- swap select-index ; : select-next ( list -- ) - dup list-index 1+ swap select-index ; + dup index>> 1+ swap select-index ; : invoke-value-action ( list -- ) dup list-empty? [ - dup list-hook call + dup hook>> call ] [ - dup list-index swap nth-gadget invoke-secondary + dup index>> swap nth-gadget invoke-secondary ] if ; : select-gadget ( gadget list -- ) diff --git a/basis/ui/gadgets/panes/panes.factor b/basis/ui/gadgets/panes/panes.factor index dfbeccaad1..b17c66768a 100755 --- a/basis/ui/gadgets/panes/panes.factor +++ b/basis/ui/gadgets/panes/panes.factor @@ -173,7 +173,7 @@ M: pane-stream make-span-stream >r pick at r> when* ; inline : apply-foreground-style ( style gadget -- style gadget ) - foreground [ over set-label-color ] apply-style ; + foreground [ over (>>color) ] apply-style ; : apply-background-style ( style gadget -- style gadget ) background [ solid-interior ] apply-style ; @@ -184,7 +184,7 @@ M: pane-stream make-span-stream font-size swap at 12 or 3array ; : apply-font-style ( style gadget -- style gadget ) - over specified-font over set-label-font ; + over specified-font over (>>font) ; : apply-presentation-style ( style gadget -- style gadget ) presented [ ] apply-style ; @@ -255,7 +255,7 @@ M: pane-stream make-block-stream ! Tables : apply-table-gap-style ( style grid -- style grid ) - table-gap [ over set-grid-gap ] apply-style ; + table-gap [ over (>>gap) ] apply-style ; : apply-table-border-style ( style grid -- style grid ) table-border [ over (>>boundary) ] @@ -263,7 +263,7 @@ M: pane-stream make-block-stream : styled-grid ( style grid -- grid ) - f over set-grid-fill? + f over (>>fill?) apply-table-gap-style apply-table-border-style nip ;