start unifying piles and shelves
parent
ebdcb51063
commit
0c35f20a03
|
@ -1,8 +1,8 @@
|
|||
! Copyright (C) 2005 Slava Pestov.
|
||||
! See http://factor.sf.net/license.txt for BSD license.
|
||||
IN: gadgets
|
||||
USING: errors generic hashtables kernel lists math namespaces
|
||||
sdl sequences ;
|
||||
USING: errors generic hashtables kernel lists math matrices
|
||||
namespaces sdl sequences ;
|
||||
|
||||
: layout ( gadget -- )
|
||||
#! Set the gadget's width and height to its preferred width
|
||||
|
@ -28,3 +28,11 @@ sdl sequences ;
|
|||
[ 0 x set 0 y set call ] with-scope ; inline
|
||||
|
||||
: default-gap 3 ;
|
||||
|
||||
: packed-pref-dim ( children gap axis -- dim )
|
||||
#! The preferred size of the gadget, if all children are
|
||||
#! packed in the direction of the given axis.
|
||||
>r
|
||||
over length 0 max v*n >r [ pref-dim ] map r>
|
||||
2dup [ v+ ] reduce >r [ vmax ] reduce r>
|
||||
r> set-axis ;
|
||||
|
|
|
@ -2,7 +2,7 @@
|
|||
! See http://factor.sf.net/license.txt for BSD license.
|
||||
IN: gadgets
|
||||
USING: errors generic hashtables kernel lists math namespaces
|
||||
sdl sequences ;
|
||||
sdl sequences vectors ;
|
||||
|
||||
! A pile is a box that lays out its contents vertically.
|
||||
TUPLE: pile align gap fill ;
|
||||
|
@ -20,15 +20,8 @@ C: pile ( align gap fill -- pile )
|
|||
: <line-pile> 0 0 1 <pile> ;
|
||||
|
||||
M: pile pref-size ( pile -- w h )
|
||||
[
|
||||
dup pile-gap swap gadget-children
|
||||
[ length 1 - 0 max * height set ] keep
|
||||
[
|
||||
pref-size
|
||||
height [ + ] change
|
||||
width [ max ] change
|
||||
] each
|
||||
] with-pref-size ;
|
||||
dup gadget-children swap pile-gap dup dup 3vector { 0 1 0 }
|
||||
packed-pref-dim 3unseq drop ;
|
||||
|
||||
: w- swap shape-w swap pref-size drop - ;
|
||||
: pile-x/y ( pile gadget offset -- )
|
||||
|
|
|
@ -44,11 +44,8 @@ C: splitter ( first second vector -- splitter )
|
|||
: <y-splitter> { 1 0 0 } <splitter> ;
|
||||
|
||||
M: splitter pref-size
|
||||
[
|
||||
gadget-children [ pref-dim ] map
|
||||
dup { 0 0 0 } [ vmax ] reduce
|
||||
swap { 0 0 0 } [ v+ ] reduce
|
||||
] keep splitter-vector set-axis 3unseq drop ;
|
||||
dup gadget-children swap splitter-vector { 0 0 0 } swap
|
||||
packed-pref-dim 3unseq drop ;
|
||||
|
||||
: splitter-part ( splitter -- vec )
|
||||
dup splitter-split swap shape-dim n*v divider-size 1/2 v*n v- ;
|
||||
|
|
|
@ -1,8 +1,8 @@
|
|||
! Copyright (C) 2005 Slava Pestov.
|
||||
! See http://factor.sf.net/license.txt for BSD license.
|
||||
IN: gadgets
|
||||
USING: errors generic hashtables kernel lists math namespaces
|
||||
sdl sequences ;
|
||||
USING: errors generic hashtables kernel lists math matrices
|
||||
namespaces sdl sequences ;
|
||||
|
||||
! A stack just lays out all its children on top of each other.
|
||||
TUPLE: stack ;
|
||||
|
@ -10,18 +10,11 @@ C: stack ( list -- stack )
|
|||
<empty-gadget> over set-delegate
|
||||
swap [ over add-gadget ] each ;
|
||||
|
||||
: max-size ( stack -- w h )
|
||||
[
|
||||
[
|
||||
dup
|
||||
shape-w width [ max ] change
|
||||
shape-h height [ max ] change
|
||||
] each
|
||||
] with-pref-size ;
|
||||
: max-dim ( shapelist -- dim )
|
||||
{ 0 0 0 } [ shape-dim vmax ] reduce ;
|
||||
|
||||
M: stack pref-size gadget-children max-size ;
|
||||
M: stack pref-size gadget-children max-dim 3unseq drop ;
|
||||
|
||||
M: stack layout* ( stack -- )
|
||||
dup gadget-children [
|
||||
>r dup shape-w over shape-h r> resize-gadget
|
||||
] each drop ;
|
||||
dup shape-dim swap gadget-children
|
||||
[ set-gadget-dim ] each-with ;
|
||||
|
|
Loading…
Reference in New Issue