basis/ui/gadgets/line-support/line-support.factor

   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
   7
   8 ! Some code shared by table and editor gadgets
   9 TUPLE: line-gadget < gadget
  10 font selection-color
  11 min-rows max-rows
  12 min-cols max-cols ;
  13
  14 : new-line-gadget ( class -- gadget )
  15     new
  16         selection-color >>selection-color ;
  17
  18 GENERIC: line-leading ( gadget -- n )
  19
  20 M: line-gadget line-leading font>> font-metrics leading>> ;
  21
  22 GENERIC: line-height ( gadget -- n )
  23
  24 M: line-gadget line-height font>> font-metrics height>> ceiling ;
  25
  26 : y>line ( y gadget -- n ) line-height /i ;
  27
  28 : line>y ( n gadget -- y ) line-height * >integer ;
  29
  30 : validate-line ( m gadget -- n )
  31     control-value [ drop f ] [ length 1 - min 0 max ] if-empty ;
  32
  33 : valid-line? ( n gadget -- ? )
  34     control-value length 1 - 0 swap between? ;
  35
  36 : visible-line ( gadget quot -- n )
  37     '[
  38         [ clip get @ origin get [ second ] bi@ - ] dip
  39         y>line
  40     ] keep validate-line ; inline
  41
  42 : first-visible-line ( gadget -- n )
  43     [ loc>> ] visible-line ;
  44
  45 : last-visible-line ( gadget -- n )
  46     [ [ loc>> ] [ dim>> ] bi v+ ] visible-line 1 + ;
  47
  48 : each-slice-index ( from to seq quot -- )
  49     [ [ <slice> ] [ drop [a,b) ] 3bi ] dip 2each ; inline
  50
  51 GENERIC: draw-line ( line index gadget -- )
  52
  53 : draw-lines ( gadget -- )
  54     {
  55         [ first-visible-line ]
  56         [ last-visible-line ]
  57         [ control-value ]
  58         [ line-height ]
  59         [ ]
  60     } cleave '[
  61         0 over _ * >integer 2array
  62         [ _ draw-line ] with-translation
  63     ] each-slice-index ;
  64
  65 <PRIVATE
  66
  67 : clamp ( dim unit min max -- dim' )
  68     [ -1/0. or * ] [ 1/.0 or * ] bi-curry* bi
  69     [ max ] [ min ] bi* ;
  70
  71 : em ( font -- x ) "m" text-width ;
  72
  73 PRIVATE>
  74
  75 : line-gadget-width ( pref-dim gadget -- w )
  76     [ first ] [ [ font>> em ] [ min-cols>> ] [ max-cols>> ] tri ] bi* clamp ;
  77
  78 : line-gadget-height ( pref-dim gadget -- h )
  79     [ second ] [ [ line-height ] [ min-rows>> ] [ max-rows>> ] tri ] bi* clamp ;
  80
  81 M: line-gadget pref-viewport-dim
  82     [ pref-dim ] keep
  83     [ line-gadget-width ]
  84     [ line-gadget-height ]
  85     2bi 2array ;
  86
  87 : visible-lines ( gadget -- n )
  88     [ visible-dim second ] [ line-height ] bi /i ;