From 0d4f08d7fdf65466f0e8932a5939608853af370f Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Sun, 21 Oct 2012 13:16:26 -0700 Subject: [PATCH] colors.hsv: adding rgba>hsva. --- basis/colors/hsv/hsv.factor | 23 +++++++++++++++++++++-- 1 file changed, 21 insertions(+), 2 deletions(-) diff --git a/basis/colors/hsv/hsv.factor b/basis/colors/hsv/hsv.factor index e4451fcb1c..d604c9d914 100644 --- a/basis/colors/hsv/hsv.factor +++ b/basis/colors/hsv/hsv.factor @@ -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 @@ -36,3 +41,17 @@ M: hsva >rgba ( hsva -- rgba ) { 5 [ [ value>> ] [ p ] [ q ] tri ] } } case ] [ alpha>> ] bi ; + +:: 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 ] [ + { + { [ 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 + ] if ;