1 ! Copyright (C) 2009 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors arrays combinators fry kernel math
4 math.functions math.order math.ranges math.vectors namespaces
5 opengl sequences ui.gadgets ui.gadgets.scrollers
6 ui.gadgets.viewports ui.render ui.text ui.theme ;
7 IN: ui.gadgets.line-support
9 ! Some code shared by table and editor gadgets
10 TUPLE: line-gadget < gadget
14 line-leading line-height
17 : new-line-gadget ( class -- gadget )
18 new selection-color >>selection-color ;
20 GENERIC: line-leading* ( gadget -- n )
22 M: line-gadget line-leading*
23 font>> font-metrics leading>> ;
25 GENERIC: line-leading ( gadget -- n )
27 M: line-gadget line-leading
30 [ line-leading* ] [ ] [ layout-state>> ] tri
31 [ drop ] [ dupd line-leading<< ] if
34 GENERIC: line-height* ( gadget -- n )
36 M: line-gadget line-height*
37 font>> font-metrics height>> ceiling >integer ;
39 GENERIC: line-height ( gadget -- n )
41 M: line-gadget line-height
44 [ line-height* ] [ ] [ layout-state>> ] tri
45 [ drop ] [ dupd line-height<< ] if
48 : y>line ( y gadget -- n ) line-height /i ;
50 : line>y ( n gadget -- y ) line-height * >integer ;
52 : validate-line ( m gadget -- n )
53 control-value [ drop f ] [ length 1 - min 0 max ] if-empty ;
55 : valid-line? ( n gadget -- ? )
56 control-value length 1 - 0 swap between? ;
58 : visible-line ( gadget quot -- n )
60 [ clip get @ origin get [ second ] bi@ - ] dip
62 ] keep validate-line ; inline
64 : first-visible-line ( gadget -- n )
65 [ loc>> ] visible-line ;
67 : last-visible-line ( gadget -- n )
68 [ [ loc>> ] [ dim>> ] bi v+ ] visible-line 1 + ;
70 : each-slice-index ( from to seq quot -- )
71 [ [ <slice> ] [ drop [a,b) ] 3bi ] dip 2each ; inline
73 GENERIC: draw-line ( line index gadget -- )
75 : draw-lines ( gadget -- )
77 [ first-visible-line ]
83 0 over _ * >integer 2array
84 [ _ draw-line ] with-translation
89 : clamp ( dim unit min max -- dim' )
90 [ -1/0. or 1 max * ] [ 1/0. or 1 max * ] bi-curry* bi
93 : em ( font -- x ) "m" text-width ;
97 : line-gadget-width ( pref-dim gadget -- w )
98 [ first ] [ [ font>> em ] [ min-cols>> ] [ max-cols>> ] tri ] bi* clamp ;
100 : line-gadget-height ( pref-dim gadget -- h )
101 [ second ] [ [ line-height ] [ min-rows>> ] [ max-rows>> ] tri ] bi* clamp ;
103 : line-gadget-dim ( pref-dim gadget -- dim )
104 [ line-gadget-width ] [ line-gadget-height ] 2bi 2array ;
106 : pref-viewport-dim* ( gadget -- dim )
107 [ pref-dim ] [ line-gadget-dim ] bi ;
109 M: line-gadget pref-viewport-dim
110 dup pref-viewport-dim>>
112 [ pref-viewport-dim* ] [ ] [ layout-state>> ] tri
113 [ drop ] [ dupd pref-viewport-dim<< ] if
116 M: line-gadget pref-dim* { 0 0 } swap line-gadget-dim ;
118 : visible-lines ( gadget -- n )
119 [ visible-dim second ] [ line-height ] bi /i ;