basis/ui/pens/gradient/gradient.factor

   1 ! Copyright (C) 2009 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: kernel accessors math math.vectors locals sequences
   4 specialized-arrays colors arrays combinators
   5 opengl opengl.gl ui.pens ui.pens.caching ;
   6 SPECIALIZED-ARRAY: float
   7 IN: ui.pens.gradient
   8
   9 ! Gradient pen
  10 TUPLE: gradient < caching-pen colors last-vertices last-colors ;
  11
  12 : <gradient> ( colors -- gradient ) gradient new swap >>colors ;
  13
  14 <PRIVATE
  15
  16 :: gradient-vertices ( direction dim colors -- seq )
  17     direction dim v* dim over v- swap
  18     colors length dup 1 - v/n [ v*n ] with map
  19     swap [ over v+ 2array ] curry map
  20     concat concat >float-array ;
  21
  22 : gradient-colors ( colors -- seq )
  23     [ >rgba-components 4array dup 2array ] map concat concat
  24     >float-array ;
  25
  26 M: gradient recompute-pen ( gadget gradient -- )
  27     [ nip ] [ [ [ orientation>> ] [ dim>> ] bi ] [ colors>> ] bi* ] 2bi
  28     [ gradient-vertices >>last-vertices ]
  29     [ gradient-colors >>last-colors ]
  30     bi drop ;
  31
  32 : draw-gradient ( colors -- )
  33     GL_COLOR_ARRAY [
  34         [ GL_QUAD_STRIP 0 ] dip length 2 * glDrawArrays
  35     ] do-enabled-client-state ;
  36
  37 PRIVATE>
  38
  39 M: gradient draw-interior
  40     {
  41         [ compute-pen ]
  42         [ last-vertices>> gl-vertex-pointer ]
  43         [ last-colors>> gl-color-pointer ]
  44         [ colors>> draw-gradient ]
  45     } cleave ;
  46
  47 M: gradient pen-background 2drop transparent ;