basis/ui/pens/gradient/gradient.factor

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