1 ! Copyright (C) 2009 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors arrays combinators fry kernel math math.functions math.order
4 math.ranges math.vectors namespaces opengl sequences ui.gadgets
5 ui.render ui.text ui.gadgets.scrollers ui.gadgets.viewports ;
6 IN: ui.gadgets.line-support
8 ! Some code shared by table and editor gadgets
9 TUPLE: line-gadget < gadget
14 : new-line-gadget ( class -- gadget )
16 selection-color >>selection-color ;
18 GENERIC: line-leading ( gadget -- n )
20 M: line-gadget line-leading font>> font-metrics leading>> ;
22 GENERIC: line-height ( gadget -- n )
24 M: line-gadget line-height font>> font-metrics height>> ceiling ;
26 : y>line ( y gadget -- n ) line-height /i ;
28 : line>y ( n gadget -- y ) line-height * >integer ;
30 : validate-line ( m gadget -- n )
31 control-value [ drop f ] [ length 1- min 0 max ] if-empty ;
33 : visible-line ( gadget quot -- n )
35 [ clip get @ origin get [ second ] bi@ - ] dip
37 ] keep validate-line ; inline
39 : first-visible-line ( gadget -- n )
40 [ loc>> ] visible-line ;
42 : last-visible-line ( gadget -- n )
43 [ [ loc>> ] [ dim>> ] bi v+ ] visible-line 1+ ;
45 : each-slice-index ( from to seq quot -- )
46 [ [ <slice> ] [ drop [a,b) ] 3bi ] dip 2each ; inline
48 GENERIC: draw-line ( line index gadget -- )
50 : draw-lines ( gadget -- )
52 [ first-visible-line ]
58 0 over _ * >integer 2array
59 [ _ draw-line ] with-translation
64 : clamp ( dim unit min max -- dim' )
65 [ -1/0. or * ] [ 1/.0 or * ] bi-curry* bi
68 : em ( font -- x ) "m" text-width ;
72 : line-gadget-width ( pref-dim gadget -- w )
73 [ first ] [ [ font>> em ] [ min-cols>> ] [ max-cols>> ] tri ] bi* clamp ;
75 : line-gadget-height ( pref-dim gadget -- h )
76 [ second ] [ [ line-height ] [ min-rows>> ] [ max-rows>> ] tri ] bi* clamp ;
78 M: line-gadget pref-viewport-dim
81 [ line-gadget-height ]
84 : visible-lines ( gadget -- n )
85 [ visible-dim second ] [ line-height ] bi /i ;