start unifying piles and shelves

cvs
Slava Pestov 2005-06-28 20:25:27 +00:00
parent ebdcb51063
commit 0c35f20a03
4 changed files with 22 additions and 31 deletions

View File

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

View File

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

View File

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

View File

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