basis/ui/gadgets/books/books.factor

   1 ! Copyright (C) 2006, 2008 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors kernel sequences models ui.gadgets
   4 math.rectangles fry ;
   5 IN: ui.gadgets.books
   6
   7 TUPLE: book < gadget ;
   8
   9 : hide-all ( book -- ) children>> [ hide-gadget ] each ;
  10
  11 : current-page ( book -- gadget ) [ control-value ] keep nth-gadget ;
  12
  13 M: book model-changed
  14     nip
  15     dup hide-all
  16     dup current-page show-gadget
  17     relayout ;
  18
  19 : new-book ( model class -- book )
  20     new
  21         swap >>model ; inline
  22
  23 : <book> ( pages model -- book )
  24     book new-book swap add-gadgets ;
  25
  26 : <empty-book> ( model -- book )
  27     book new-book ;
  28
  29 M: book pref-dim* children>> pref-dims max-dims ;
  30
  31 M: book layout*
  32     [ children>> ] [ dim>> ] bi '[ _ >>dim drop ] each ;
  33
  34 M: book focusable-child* current-page ;