basis/ui/render/render.factor

   1 ! Copyright (C) 2005, 2009 Slava Pestov.
   2 ! See https://factorcode.org/license.txt for BSD license.
   3 USING: accessors colors combinators kernel math.rectangles
   4 math.vectors namespaces opengl opengl.capabilities opengl.gl
   5 opengl.textures sequences sets 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 ( gadget -- )
  21     [
  22         dim>>
  23         [ { 0 1 } v* viewport-translation namespaces:set ]
  24         [ [ { 0 0 } ] dip gl-viewport ]
  25         [ [ 0 ] dip first2 0 1 -1 glOrtho ] tri
  26     ]
  27     [ clip namespaces:set ] bi
  28     do-clip ;
  29
  30 SLOT: background-color
  31
  32 : gl-init ( -- )
  33     check-extensions "1.0" require-gl-version
  34     GL_SMOOTH glShadeModel
  35     GL_BLEND glEnable
  36     GL_VERTEX_ARRAY glEnableClientState
  37     GL_PACK_ALIGNMENT 1 glPixelStorei
  38     GL_UNPACK_ALIGNMENT 1 glPixelStorei ;
  39
  40 : gl-draw-init ( world -- )
  41     GL_SCISSOR_TEST glEnable
  42     GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA glBlendFunc
  43     init-matrices
  44     [ init-clip ] [ background-color>> gl-clear ] bi ;
  45
  46 GENERIC: draw-gadget* ( gadget -- )
  47
  48 M: gadget draw-gadget* drop ;
  49
  50 SYMBOL: origin
  51
  52 { 0 0 } origin set-global
  53
  54 : visible-children ( gadget -- seq )
  55     [ clip get origin get vneg offset-rect ] dip children-on ;
  56
  57 : translate ( rect/point -- ) loc>> origin [ v+ ] change ;
  58
  59 GENERIC: draw-children ( gadget -- )
  60
  61 ! For gadget selection
  62 SYMBOL: selected-gadgets
  63
  64 SYMBOL: selection-background
  65
  66 GENERIC: selected-children ( gadget -- assoc/f selection-background )
  67
  68 M: gadget selected-children drop f f ;
  69
  70 ! For text rendering
  71 SYMBOL: background
  72
  73 SYMBOL: foreground
  74
  75 GENERIC: gadget-background ( gadget -- color )
  76
  77 M: gadget gadget-background dup interior>> pen-background ;
  78
  79 GENERIC: gadget-foreground ( gadget -- color )
  80
  81 M: gadget gadget-foreground dup interior>> pen-foreground ;
  82
  83 <PRIVATE
  84
  85 : draw-selection-background ( gadget -- )
  86     selection-background get background namespaces:set
  87     selection-background get gl-color
  88     [ { 0 0 } ] dip dim>> gl-fill-rect ;
  89
  90 : draw-standard-background ( object -- )
  91     dup interior>> [ draw-interior ] [ drop ] if* ;
  92
  93 : draw-background ( gadget -- )
  94     origin get [
  95         [
  96             dup selected-gadgets get in?
  97             [ draw-selection-background ]
  98             [ draw-standard-background ] if
  99         ] [ draw-gadget* ] bi
 100     ] with-translation ;
 101
 102 : draw-border ( object -- )
 103     dup boundary>> [
 104         origin get [ draw-boundary ] with-translation
 105     ] [ drop ] if* ;
 106
 107 PRIVATE>
 108
 109 : (draw-gadget) ( gadget -- )
 110     dup loc>> origin get v+ origin [
 111         [ draw-background ] [ draw-children ] [ draw-border ] tri
 112     ] with-variable ;
 113
 114 : >absolute ( rect -- rect )
 115     origin get offset-rect ;
 116
 117 : change-clip ( gadget -- )
 118     >absolute clip [ rect-intersect ] change ;
 119
 120 : with-clipping ( gadget quot -- )
 121     clip get [ over change-clip do-clip call ] dip
 122     clip namespaces:set do-clip ; inline
 123
 124 : draw-gadget ( gadget -- )
 125     {
 126         { [ dup visible?>> not ] [ drop ] }
 127         { [ dup clipped?>> not ] [ (draw-gadget) ] }
 128         [ [ (draw-gadget) ] with-clipping ]
 129     } cond ;
 130
 131 M: gadget draw-children
 132     dup children>> [
 133         {
 134             [ visible-children ]
 135             [ selected-children ]
 136             [ gadget-background ]
 137             [ gadget-foreground ]
 138         } cleave [
 139
 140             {
 141                 [ [ selected-gadgets namespaces:set ] when* ]
 142                 [ [ selection-background namespaces:set ] when* ]
 143                 [ [ background namespaces:set ] when* ]
 144                 [ [ foreground namespaces:set ] when* ]
 145             } spread
 146             [ draw-gadget ] each
 147         ] with-scope
 148     ] [ drop ] if ;