factor/basis/ui/gadgets/incremental/incremental.factor

58 lines
1.5 KiB
Factor
Raw Normal View History

2009-01-25 18:55:27 -05:00
! Copyright (C) 2005, 2009 Slava Pestov.
2007-09-20 18:09:08 -04:00
! See http://factorcode.org/license.txt for BSD license.
USING: io kernel math namespaces math.vectors ui.gadgets
ui.gadgets.private ui.gadgets.packs accessors
math.rectangles combinators ;
2007-09-20 18:09:08 -04:00
IN: ui.gadgets.incremental
TUPLE: incremental < pack cursor ;
2007-09-20 18:09:08 -04:00
: <incremental> ( -- incremental )
incremental new
vertical >>orientation
{ 0 0 } >>cursor ;
2007-09-20 18:09:08 -04:00
M: incremental pref-dim*
2008-08-29 19:44:19 -04:00
dup layout-state>> [
dup call-next-method >>cursor
] when cursor>> ;
2007-09-20 18:09:08 -04:00
: next-cursor ( gadget incremental -- cursor )
[
[ dim>> ] [ cursor>> ] bi*
2008-09-27 18:54:51 -04:00
[ vmax ] [ v+ ] 2bi
2008-08-29 19:44:19 -04:00
] keep orientation>> set-axis ;
2007-09-20 18:09:08 -04:00
: update-cursor ( gadget incremental -- )
2009-01-23 19:20:47 -05:00
[ nip ] [ next-cursor ] 2bi >>cursor drop ;
2007-09-20 18:09:08 -04:00
: incremental-loc ( gadget incremental -- )
2008-09-01 23:43:56 -04:00
[ cursor>> ] [ orientation>> ] bi v*
>>loc drop ;
2007-09-20 18:09:08 -04:00
2009-01-25 18:55:27 -05:00
: prefer-incremental ( gadget -- )
2008-08-31 17:22:25 -04:00
dup forget-pref-dim dup pref-dim >>dim drop ;
2007-09-20 18:09:08 -04:00
2008-09-27 18:54:51 -04:00
M: incremental dim-changed drop ;
2007-09-20 18:09:08 -04:00
: add-incremental ( gadget incremental -- )
2007-11-16 01:19:13 -05:00
not-in-layout
2dup (add-gadget)
2008-09-27 18:54:51 -04:00
t in-layout? [
2009-01-25 18:55:27 -05:00
{
[ drop prefer-incremental ]
[ drop layout-later ]
[ incremental-loc ]
[ update-cursor ]
[ nip prefer-incremental ]
[ nip parent>> [ invalidate* ] when* ]
} 2cleave
2008-09-27 18:54:51 -04:00
] with-variable ;
2007-09-20 18:09:08 -04:00
: clear-incremental ( incremental -- )
2007-11-16 01:19:13 -05:00
not-in-layout
2009-01-25 18:55:27 -05:00
[ (clear-gadget) ]
[ forget-pref-dim ]
[ { 0 0 } >>cursor parent>> [ relayout ] when* ]
tri ;