1 ! Copyright (C) 2008 Eduardo Cavazos.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: colors kernel combinators math math.functions accessors ;
9 TUPLE: hsva < color { hue read-only } { saturation read-only } { value read-only } { alpha read-only } ;
15 : Hi ( hsv -- Hi ) hue>> 60 / floor 6 mod ; inline
17 : f ( hsv -- f ) [ hue>> 60 / ] [ Hi ] bi - ; inline
19 : p ( hsv -- p ) [ saturation>> 1 swap - ] [ value>> ] bi * ; inline
21 : q ( hsv -- q ) [ [ f ] [ saturation>> ] bi * 1 swap - ] [ value>> ] bi * ; inline
23 : t ( hsv -- t ) [ [ f 1 swap - ] [ saturation>> ] bi * 1 swap - ] [ value>> ] bi * ; inline
27 M: hsva >rgba ( hsva -- rgba )
31 { 0 [ [ value>> ] [ t ] [ p ] tri ] }
32 { 1 [ [ q ] [ value>> ] [ p ] tri ] }
33 { 2 [ [ p ] [ value>> ] [ t ] tri ] }
34 { 3 [ [ p ] [ q ] [ value>> ] tri ] }
35 { 4 [ [ t ] [ p ] [ value>> ] tri ] }
36 { 5 [ [ value>> ] [ p ] [ q ] tri ] }
38 ] [ alpha>> ] bi <rgba> ;