Update accessors from

ui.gadgets.{grid-lines,grids,incremental,labelled,labels,lists,panes}
db4
Eduardo Cavazos 2008-08-30 21:58:13 -05:00
parent 7a75d2e070
commit daee534587
9 changed files with 33 additions and 33 deletions

View File

@ -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." } ;

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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* ;

View File

@ -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>> ;

View File

@ -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 )

View File

@ -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 -- )

View File

@ -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 ;