]> gitweb.factorcode.org Git - factor.git/blob - basis/ui/pens/gradient/gradient.factor
Delete empty unit tests files, remove 1- and 1+, reorder IN: lines in a lot of places...
[factor.git] / 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.float colors arrays combinators
5 opengl opengl.gl ui.pens ui.pens.caching ;
6 IN: ui.pens.gradient
7
8 ! Gradient pen
9 TUPLE: gradient < caching-pen colors last-vertices last-colors ;
10
11 : <gradient> ( colors -- gradient ) gradient new swap >>colors ;
12
13 <PRIVATE
14
15 :: gradient-vertices ( direction dim colors -- seq )
16     direction dim v* dim over v- swap
17     colors length dup 1 - v/n [ v*n ] with map
18     swap [ over v+ 2array ] curry map
19     concat concat >float-array ;
20
21 : gradient-colors ( colors -- seq )
22     [ >rgba-components 4array dup 2array ] map concat concat
23     >float-array ;
24
25 M: gradient recompute-pen ( gadget gradient -- )
26     [ nip ] [ [ [ orientation>> ] [ dim>> ] bi ] [ colors>> ] bi* ] 2bi
27     [ gradient-vertices >>last-vertices ]
28     [ gradient-colors >>last-colors ]
29     bi drop ;
30
31 : draw-gradient ( colors -- )
32     GL_COLOR_ARRAY [
33         [ GL_QUAD_STRIP 0 ] dip length 2 * glDrawArrays
34     ] do-enabled-client-state ;
35
36 PRIVATE>
37
38 M: gradient draw-interior
39     {
40         [ compute-pen ]
41         [ last-vertices>> gl-vertex-pointer ]
42         [ last-colors>> gl-color-pointer ]
43         [ colors>> draw-gradient ]
44     } cleave ;
45
46 M: gradient pen-background 2drop transparent ;