basis/ui/gadgets/incremental/incremental.factor

   1 ! Copyright (C) 2005, 2009 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors combinators kernel math.vectors namespaces
   4 ui.gadgets ui.gadgets.packs ui.gadgets.private ;
   5 IN: ui.gadgets.incremental
   6
   7 TUPLE: incremental < pack cursor ;
   8
   9 : <incremental> ( -- incremental )
  10     incremental new
  11         vertical >>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         [ dim>> ] [ cursor>> ] bi*
  22         [ vmax ] [ v+ ] 2bi
  23     ] keep orientation>> set-axis ;
  24
  25 : update-cursor ( gadget incremental -- )
  26     [ nip ] [ next-cursor ] 2bi >>cursor drop ;
  27
  28 : incremental-loc ( gadget incremental -- )
  29     [ cursor>> ] [ orientation>> ] bi v*
  30     >>loc drop ;
  31
  32 : prefer-incremental ( gadget -- )
  33     dup forget-pref-dim prefer ;
  34
  35 M: incremental dim-changed drop ;
  36
  37 : add-incremental ( gadget incremental -- )
  38     not-in-layout
  39     2dup (add-gadget)
  40     t in-layout? [
  41         {
  42             [ drop prefer-incremental ]
  43             [ drop layout-later ]
  44             [ incremental-loc ]
  45             [ update-cursor ]
  46             [ nip prefer-incremental ]
  47             [ nip parent>> [ invalidate* ] when* ]
  48         } 2cleave
  49     ] with-variable ;
  50
  51 : clear-incremental ( incremental -- )
  52     not-in-layout
  53     [ (clear-gadget) ]
  54     [ forget-pref-dim ]
  55     [ { 0 0 } >>cursor parent>> [ relayout ] when* ]
  56     tri ;