basis/ui/render/render.factor

   1 ! Copyright (C) 2005, 2009 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: math.rectangles math.vectors namespaces kernel accessors
   4 assocs combinators sequences opengl opengl.gl colors
   5 colors.constants ui.gadgets ui.pens ;
   6 IN: ui.render
   7
   8 SYMBOL: clip
   9
  10 SYMBOL: viewport-translation
  11
  12 : flip-rect ( rect -- loc dim )
  13     rect-bounds [
  14         [ { 1 -1 } v* ] dip { 0 -1 } v* v+
  15         viewport-translation get v+
  16     ] keep ;
  17
  18 : do-clip ( -- ) clip get flip-rect gl-set-clip ;
  19
  20 : init-clip ( clip-rect -- )
  21     [
  22         dim>>
  23         [ { 0 1 } v* viewport-translation set ]
  24         [ [ { 0 0 } ] dip gl-viewport ]
  25         [ [ 0 ] dip first2 0 1 -1 glOrtho ] tri
  26     ]
  27     [ clip set ] bi
  28     do-clip ;
  29
  30 : init-gl ( clip-rect -- )
  31     GL_SMOOTH glShadeModel
  32     GL_SCISSOR_TEST glEnable
  33     GL_BLEND glEnable
  34     GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA glBlendFunc
  35     GL_VERTEX_ARRAY glEnableClientState
  36     init-matrices
  37     init-clip
  38     ! white gl-clear is broken w.r.t window resizing
  39     ! Linux/PPC Radeon 9200
  40     COLOR: white gl-color
  41     { 0 0 } clip get dim>> gl-fill-rect ;
  42
  43 GENERIC: draw-gadget* ( gadget -- )
  44
  45 M: gadget draw-gadget* drop ;
  46
  47 SYMBOL: origin
  48
  49 { 0 0 } origin set-global
  50
  51 : visible-children ( gadget -- seq )
  52     [ clip get origin get vneg offset-rect ] dip children-on ;
  53
  54 : translate ( rect/point -- ) loc>> origin [ v+ ] change ;
  55
  56 GENERIC: draw-children ( gadget -- )
  57
  58 ! For gadget selection
  59 SYMBOL: selected-gadgets
  60
  61 SYMBOL: selection-background
  62
  63 GENERIC: selected-children ( gadget -- assoc/f selection-background )
  64
  65 M: gadget selected-children drop f f ;
  66
  67 ! For text rendering
  68 SYMBOL: background
  69
  70 SYMBOL: foreground
  71
  72 GENERIC: gadget-background ( gadget -- color )
  73
  74 M: gadget gadget-background dup interior>> pen-background ;
  75
  76 GENERIC: gadget-foreground ( gadget -- color )
  77
  78 M: gadget gadget-foreground dup interior>> pen-foreground ;
  79
  80 <PRIVATE
  81
  82 : draw-selection-background ( gadget -- )
  83     selection-background get background set
  84     selection-background get gl-color
  85     [ { 0 0 } ] dip dim>> gl-fill-rect ;
  86
  87 : draw-standard-background ( object -- )
  88     dup interior>> dup [ draw-interior ] [ 2drop ] if ;
  89
  90 : draw-background ( gadget -- )
  91     origin get [
  92         [
  93             dup selected-gadgets get key?
  94             [ draw-selection-background ]
  95             [ draw-standard-background ] if
  96         ] [ draw-gadget* ] bi
  97     ] with-translation ;
  98
  99 : draw-border ( object -- )
 100     dup boundary>> dup [
 101         origin get [ draw-boundary ] with-translation
 102     ] [ 2drop ] if ;
 103
 104 PRIVATE>
 105
 106 : (draw-gadget) ( gadget -- )
 107     dup loc>> origin get v+ origin [
 108         [ draw-background ] [ draw-children ] [ draw-border ] tri
 109     ] with-variable ;
 110
 111 : >absolute ( rect -- rect )
 112     origin get offset-rect ;
 113
 114 : change-clip ( gadget -- )
 115     >absolute clip [ rect-intersect ] change ;
 116
 117 : with-clipping ( gadget quot -- )
 118     clip get [ over change-clip do-clip call ] dip clip set do-clip ; inline
 119
 120 : draw-gadget ( gadget -- )
 121     {
 122         { [ dup visible?>> not ] [ drop ] }
 123         { [ dup clipped?>> not ] [ (draw-gadget) ] }
 124         [ [ (draw-gadget) ] with-clipping ]
 125     } cond ;
 126
 127 M: gadget draw-children
 128     dup children>> [
 129         {
 130             [ visible-children ]
 131             [ selected-children ]
 132             [ gadget-background ]
 133             [ gadget-foreground ]
 134         } cleave [
 135
 136             {
 137                 [ [ selected-gadgets set ] when* ]
 138                 [ [ selection-background set ] when* ]
 139                 [ [ background set ] when* ]
 140                 [ [ foreground set ] when* ]
 141             } spread
 142             [ draw-gadget ] each
 143         ] with-scope
 144     ] [ drop ] if ;
 145
 146 CONSTANT: selection-color T{ rgba f 0.8 0.8 1.0 1.0 }
 147
 148 CONSTANT: panel-background-color
 149     T{ rgba f
 150         0.7843137254901961
 151         0.7686274509803922
 152         0.7176470588235294
 153         1.0
 154     }
 155
 156 CONSTANT: focus-border-color COLOR: dark-gray