2005-03-10 17:57:22 -05:00
|
|
|
! Copyright (C) 2005 Slava Pestov.
|
|
|
|
|
! See http://factor.sf.net/license.txt for BSD license.
|
|
|
|
|
IN: gadgets
|
2005-06-28 16:25:27 -04:00
|
|
|
USING: errors generic hashtables kernel lists math matrices
|
|
|
|
|
namespaces sdl sequences ;
|
2005-03-10 17:57:22 -05:00
|
|
|
|
|
|
|
|
! A stack just lays out all its children on top of each other.
|
|
|
|
|
TUPLE: stack ;
|
|
|
|
|
C: stack ( list -- stack )
|
|
|
|
|
<empty-gadget> over set-delegate
|
|
|
|
|
swap [ over add-gadget ] each ;
|
|
|
|
|
|
2005-06-28 16:25:27 -04:00
|
|
|
: max-dim ( shapelist -- dim )
|
|
|
|
|
{ 0 0 0 } [ shape-dim vmax ] reduce ;
|
2005-03-10 17:57:22 -05:00
|
|
|
|
2005-06-28 16:25:27 -04:00
|
|
|
M: stack pref-size gadget-children max-dim 3unseq drop ;
|
2005-03-10 17:57:22 -05:00
|
|
|
|
|
|
|
|
M: stack layout* ( stack -- )
|
2005-06-28 16:25:27 -04:00
|
|
|
dup shape-dim swap gadget-children
|
|
|
|
|
[ set-gadget-dim ] each-with ;
|