]> gitweb.factorcode.org Git - factor.git/blob - basis/ui/gadgets/viewports/viewports.factor
Merge branch 'master' into experimental (untested!)
[factor.git] / basis / ui / gadgets / viewports / viewports.factor
1 ! Copyright (C) 2005, 2008 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 IN: ui.gadgets.viewports
4 USING: accessors arrays ui.gadgets ui.gadgets.borders
5 kernel math namespaces sequences models math.vectors math.geometry.rect ;
6
7 : viewport-gap { 3 3 } ; inline
8
9 TUPLE: viewport < gadget ;
10
11 : find-viewport ( gadget -- viewport )
12     [ viewport? ] find-parent ;
13
14 : viewport-dim ( viewport -- dim )
15     gadget-child pref-dim viewport-gap 2 v*n v+ ;
16
17 : <viewport> ( content model -- viewport )
18     viewport new-gadget
19         swap >>model
20         t >>clipped?
21         swap add-gadget ;
22
23 M: viewport layout*
24     [
25         [ rect-dim viewport-gap 2 v*n v- ]
26         [ gadget-child pref-dim ]
27         bi vmax
28     ] [ gadget-child ] bi (>>dim) ;
29
30 M: viewport focusable-child*
31     gadget-child ;
32
33 M: viewport pref-dim* viewport-dim ;
34
35 : scroller-value ( scroller -- loc )
36     model>> range-value [ >fixnum ] map ;
37
38 M: viewport model-changed
39     nip
40     dup relayout-1
41     dup scroller-value
42     vneg viewport-gap v+
43     swap gadget-child (>>loc) ;
44
45 : visible-dim ( gadget -- dim )
46     dup parent>> viewport?
47       [ parent>> rect-dim viewport-gap 2 v*n v- ]
48       [ rect-dim ]
49     if ;