From daee5345876415895570582de1f2c0c6c3b35c0e Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
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> 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 <grid> } " 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>> ;
: <labelled-scroller> ( gadget title -- gadget )
>r <scroller> r> <labelled-gadget> ;
@@ -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 [ <presentation> ] 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 [ <grid-lines> over (>>boundary) ]
@@ -263,7 +263,7 @@ M: pane-stream make-block-stream
: styled-grid ( style grid -- grid )
<grid>
- f over set-grid-fill?
+ f over (>>fill?)
apply-table-gap-style
apply-table-border-style
nip ;