Convert a bunch of code to use '(>>dim)' instead of 'set-layout-dim'.
parent
4f2dc6b8d2
commit
a1cdd65b66
|
@ -25,6 +25,6 @@ M: book model-changed ( model book -- )
|
||||||
M: book pref-dim* ( book -- dim ) children>> pref-dims max-dim ;
|
M: book pref-dim* ( book -- dim ) children>> pref-dims max-dim ;
|
||||||
|
|
||||||
M: book layout* ( book -- )
|
M: book layout* ( book -- )
|
||||||
[ dim>> ] [ children>> ] bi [ set-layout-dim ] with each ;
|
[ dim>> ] [ children>> ] bi [ (>>dim) ] with each ;
|
||||||
|
|
||||||
M: book focusable-child* ( book -- child/t ) current-page ;
|
M: book focusable-child* ( book -- child/t ) current-page ;
|
||||||
|
|
|
@ -42,7 +42,7 @@ M: border pref-dim*
|
||||||
M: border layout*
|
M: border layout*
|
||||||
dup border-child-rect swap gadget-child
|
dup border-child-rect swap gadget-child
|
||||||
over loc>> over set-rect-loc
|
over loc>> over set-rect-loc
|
||||||
swap dim>> swap set-layout-dim ;
|
swap dim>> swap (>>dim) ;
|
||||||
|
|
||||||
M: border focusable-child*
|
M: border focusable-child*
|
||||||
gadget-child ;
|
gadget-child ;
|
||||||
|
|
|
@ -65,15 +65,9 @@ HELP: relayout-1
|
||||||
|
|
||||||
{ relayout relayout-1 } related-words
|
{ relayout relayout-1 } related-words
|
||||||
|
|
||||||
HELP: set-layout-dim
|
|
||||||
{ $values { "dim" "a pair of integers" } { "gadget" gadget } }
|
|
||||||
{ $description "Resizes a gadget inside a " { $link layout* } " method." }
|
|
||||||
{ $warning "Do not call this word outside of a " { $link layout* } " method, or otherwise the gadget will not be relayout automatically. Instead, use " { $link set-gadget-dim } "." } ;
|
|
||||||
|
|
||||||
HELP: set-gadget-dim
|
HELP: set-gadget-dim
|
||||||
{ $values { "dim" "a pair of integers" } { "gadget" gadget } }
|
{ $values { "dim" "a pair of integers" } { "gadget" gadget } }
|
||||||
{ $description "Resizes and relayouts a gadget before the next iteration of the event loop." }
|
{ $description "Resizes and relayouts a gadget before the next iteration of the event loop." } ;
|
||||||
{ $warning "Do not call this word inside a " { $link layout* } " method, or otherwise unnecessary work will be done by the UI to ensure the gadget is relayout. Instead, use " { $link set-layout-dim } "." } ;
|
|
||||||
|
|
||||||
HELP: pref-dim*
|
HELP: pref-dim*
|
||||||
{ $values { "gadget" gadget } { "dim" "a pair of integers" } }
|
{ $values { "gadget" gadget } { "dim" "a pair of integers" } }
|
||||||
|
|
|
@ -198,7 +198,7 @@ GENERIC: layout* ( gadget -- )
|
||||||
|
|
||||||
M: gadget layout* drop ;
|
M: gadget layout* drop ;
|
||||||
|
|
||||||
: prefer ( gadget -- ) dup pref-dim swap set-layout-dim ;
|
: prefer ( gadget -- ) dup pref-dim swap (>>dim) ;
|
||||||
|
|
||||||
: validate ( gadget -- ) f swap (>>layout-state) ;
|
: validate ( gadget -- ) f swap (>>layout-state) ;
|
||||||
|
|
||||||
|
|
|
@ -66,7 +66,7 @@ M: grid pref-dim*
|
||||||
|
|
||||||
: resize-grid ( grid horiz vert -- )
|
: resize-grid ( grid horiz vert -- )
|
||||||
pick grid-fill? [
|
pick grid-fill? [
|
||||||
pair-up swap [ set-layout-dim ] do-grid
|
pair-up swap [ (>>dim) ] do-grid
|
||||||
] [
|
] [
|
||||||
2drop grid>> [ [ prefer ] each ] each
|
2drop grid>> [ [ prefer ] each ] each
|
||||||
] if ;
|
] if ;
|
||||||
|
|
|
@ -31,7 +31,7 @@ TUPLE: pack < gadget
|
||||||
|
|
||||||
: pack-layout ( pack sizes -- )
|
: pack-layout ( pack sizes -- )
|
||||||
round-dims over gadget-children
|
round-dims over gadget-children
|
||||||
>r dupd packed-dims r> 2dup [ set-layout-dim ] 2each
|
>r dupd packed-dims r> 2dup [ (>>dim) ] 2each
|
||||||
>r packed-locs r> [ set-rect-loc ] 2each ;
|
>r packed-locs r> [ set-rect-loc ] 2each ;
|
||||||
|
|
||||||
: <pack> ( orientation -- pack )
|
: <pack> ( orientation -- pack )
|
||||||
|
|
|
@ -110,7 +110,7 @@ elevator H{
|
||||||
dup dup thumb-dim (layout-thumb) >r
|
dup dup thumb-dim (layout-thumb) >r
|
||||||
>r dup rect-dim r>
|
>r dup rect-dim r>
|
||||||
rot gadget-orientation set-axis [ ceiling ] map
|
rot gadget-orientation set-axis [ ceiling ] map
|
||||||
r> set-layout-dim ;
|
r> (>>dim) ;
|
||||||
|
|
||||||
: layout-thumb ( slider -- )
|
: layout-thumb ( slider -- )
|
||||||
dup layout-thumb-loc layout-thumb-dim ;
|
dup layout-thumb-loc layout-thumb-dim ;
|
||||||
|
|
|
@ -23,7 +23,7 @@ TUPLE: viewport < gadget ;
|
||||||
M: viewport layout*
|
M: viewport layout*
|
||||||
dup rect-dim viewport-gap 2 v*n v-
|
dup rect-dim viewport-gap 2 v*n v-
|
||||||
over gadget-child pref-dim vmax
|
over gadget-child pref-dim vmax
|
||||||
swap gadget-child set-layout-dim ;
|
swap gadget-child (>>dim) ;
|
||||||
|
|
||||||
M: viewport focusable-child*
|
M: viewport focusable-child*
|
||||||
gadget-child ;
|
gadget-child ;
|
||||||
|
|
|
@ -46,7 +46,7 @@ M: world request-focus-on ( child gadget -- )
|
||||||
M: world layout*
|
M: world layout*
|
||||||
dup call-next-method
|
dup call-next-method
|
||||||
dup world-glass [
|
dup world-glass [
|
||||||
>r dup rect-dim r> set-layout-dim
|
>r dup rect-dim r> (>>dim)
|
||||||
] when* drop ;
|
] when* drop ;
|
||||||
|
|
||||||
M: world focusable-child* gadget-child ;
|
M: world focusable-child* gadget-child ;
|
||||||
|
|
|
@ -244,7 +244,6 @@ ARTICLE: "ui-layout-impl" "Implementing layout gadgets"
|
||||||
{ $subsection layout* }
|
{ $subsection layout* }
|
||||||
"When a " { $link layout* } " method is called, the size and location of the gadget has already been determined by its parent, and the method's job is to lay out the gadget's children. Children can be positioned and resized with a pair of words:"
|
"When a " { $link layout* } " method is called, the size and location of the gadget has already been determined by its parent, and the method's job is to lay out the gadget's children. Children can be positioned and resized with a pair of words:"
|
||||||
{ $subsection set-rect-loc }
|
{ $subsection set-rect-loc }
|
||||||
{ $subsection set-layout-dim }
|
|
||||||
"Some assorted utility words which are useful for implementing layout logic:"
|
"Some assorted utility words which are useful for implementing layout logic:"
|
||||||
{ $subsection pref-dim }
|
{ $subsection pref-dim }
|
||||||
{ $subsection pref-dims }
|
{ $subsection pref-dims }
|
||||||
|
|
Loading…
Reference in New Issue