basis/ui/gadgets/incremental/incremental.factor

   1 ! Copyright (C) 2005, 2008 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: io kernel math namespaces math.vectors ui.gadgets
   4 ui.gadgets.packs accessors math.geometry.rect ;
   5 IN: ui.gadgets.incremental
   6
   7 TUPLE: incremental < pack cursor ;
   8
   9 : <incremental> ( -- incremental )
  10     incremental new-gadget
  11         { 0 1 } >>orientation
  12         { 0 0 } >>cursor ;
  13
  14 M: incremental pref-dim*
  15     dup layout-state>> [
  16         dup call-next-method >>cursor
  17     ] when cursor>> ;
  18
  19 : next-cursor ( gadget incremental -- cursor )
  20     [
  21         [ rect-dim ] [ cursor>> ] bi*
  22         [ vmax ] [ v+ ] 2bi
  23     ] keep orientation>> set-axis ;
  24
  25 : update-cursor ( gadget incremental -- )
  26     tuck next-cursor >>cursor drop ;
  27
  28 : incremental-loc ( gadget incremental -- )
  29     [ cursor>> ] [ orientation>> ] bi v*
  30     >>loc drop ;
  31
  32 : prefer-incremental ( gadget -- ) USE: slots.private
  33     dup forget-pref-dim dup pref-dim >>dim drop ;
  34
  35 M: incremental dim-changed drop ;
  36
  37 : add-incremental ( gadget incremental -- )
  38     not-in-layout
  39     2dup swap (add-gadget) drop
  40     t in-layout? [
  41         over prefer-incremental
  42         over layout-later
  43         2dup incremental-loc
  44         tuck update-cursor
  45         dup prefer-incremental
  46         parent>> [ invalidate* ] when*
  47     ] with-variable ;
  48
  49 : clear-incremental ( incremental -- )
  50     not-in-layout
  51     dup (clear-gadget)
  52     dup forget-pref-dim
  53     { 0 0 } >>cursor
  54     parent>> [ relayout ] when* ;