basis/ui/gadgets/viewports/viewports.factor

   1 ! Copyright (C) 2005, 2009 Slava Pestov.
   2 ! See https://factorcode.org/license.txt for BSD license.
   3 USING: accessors kernel math.vectors models ui.gadgets ;
   4 IN: ui.gadgets.viewports
   5
   6 TUPLE: viewport < gadget { constraint initial: { 1 1 } } ;
   7
   8 : find-viewport ( gadget -- viewport )
   9     [ viewport? ] find-parent ;
  10
  11 : <viewport> ( content model -- viewport )
  12     viewport new
  13         swap >>model
  14         t >>clipped?
  15         swap add-gadget ;
  16
  17 M: viewport layout*
  18     [ gadget-child ]
  19     [ [ dim>> ] [ gadget-child pref-dim ] bi vmax ] bi >>dim drop ;
  20
  21 M: viewport focusable-child*
  22     gadget-child ;
  23
  24 : scroll-position ( scroller -- loc )
  25     model>> range-value v>integer ;
  26
  27 M: viewport model-changed
  28     nip
  29     [ relayout-1 ]
  30     [
  31         [ gadget-child ]
  32         [ scroll-position vneg ]
  33         [ constraint>> ]
  34         tri v* >>loc drop
  35     ] bi ;
  36
  37 : visible-dim ( gadget -- dim )
  38     dup parent>> viewport? [ parent>> ] when dim>> ;