steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

colors.hsv: adding rgba>hsva.

db4
John Benediktsson 2012-10-21 13:16:26 -07:00
parent 4ac24fb585
commit 0d4f08d7fd
1 changed files with 21 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
basis/colors/hsv/hsv.factor
View File

@ -1,12 +1,17 @@
! Copyright (C) 2008 Eduardo Cavazos.
! See http://factorcode.org/license.txt for BSD license.
USING: colors kernel combinators math math.functions accessors ;
USING: accessors arrays colors combinators kernel locals math
math.functions sequences sorting ;
IN: colors.hsv
! h [0,360)
! s [0,1]
! v [0,1]
TUPLE: hsva < color { hue read-only } { saturation read-only } { value read-only } { alpha read-only } ;
TUPLE: hsva < color
{ hue read-only }
{ saturation read-only }
{ value read-only }
{ alpha read-only } ;
C: <hsva> hsva
@ -36,3 +41,17 @@ M: hsva >rgba ( hsva -- rgba )
{ 5 [ [ value>> ] [ p ] [ q ] tri ] }
} case
] [ alpha>> ] bi <rgba> ;
:: rgba>hsva ( rgba -- hsva )
rgba >rgba-components :> ( r g b a )
r g b 3array natural-sort first3 :> ( z y x )
x z = x zero? or [ 0 0 x a <hsva> ] [
{
{ [ r x = g z = and ] [ 5 x b - x z - / + ] }
{ [ r x = g z > and ] [ 1 x g - x z - / - ] }
{ [ g x = b z = and ] [ 1 x r - x z - / + ] }
{ [ g x = b z > and ] [ 3 x b - x z - / - ] }
{ [ b x = r z = and ] [ 3 x g - x z - / + ] }
{ [ b x = r z > and ] [ 5 x r - x z - / - ] }
} cond 6 / 360 * x z - x / x a <hsva>
] if ;