]> gitweb.factorcode.org Git - factor.git/blob - basis/colors/yuv/yuv.factor
colors: moving some color definitions from extra/ to basis/.
[factor.git] / basis / colors / yuv / yuv.factor
1 ! Copyright (C) 2013 John Benediktsson
2 ! See http://factorcode.org/license.txt for BSD license
3
4 USING: accessors colors combinators kernel locals math
5 math.order ;
6
7 IN: colors.yuv
8
9 TUPLE: yuva < color
10 { y read-only }
11 { u read-only }
12 { v read-only }
13 { alpha read-only } ;
14
15 C: <yuva> yuva
16
17 <PRIVATE
18
19 CONSTANT: Wr 0.299
20 CONSTANT: Wb 0.114
21 CONSTANT: Wg 0.587
22 CONSTANT: Umax 0.436
23 CONSTANT: Vmax 0.615
24
25 PRIVATE>
26
27 M: yuva >rgba
28     { [ y>> ] [ u>> ] [ v>> ] [ alpha>> ] } cleave
29     [| y u v |
30         y 1 Wr - Vmax / v * +
31
32         y
33         Wb 1 Wb - * Umax Wg * / neg u *
34         Wr 1 Wr - * Vmax Wg * / neg v * + +
35
36         y 1 Wb - Umax / u * +
37
38         [ 0.0 1.0 clamp ] tri@
39     ] dip <rgba> ; inline
40
41 GENERIC: >yuva ( color -- yuva )
42
43 M: object >yuva >rgba >yuva ;
44
45 M: yuva >yuva ; inline
46
47 M:: rgba >yuva ( rgba -- yuva )
48     rgba >rgba-components :> ( r g b a )
49     Wr r * Wg g * Wb b * + + :> y
50     Umax 1 Wb - / b y - * :> u
51     Vmax 1 Wr - / r y - * :> v
52     y u v a <yuva> ;