basis/colors/hsv/hsv.factor

   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 ;
   4 IN: colors.hsv
   5
   6 ! h [0,360)
   7 ! s [0,1]
   8 ! v [0,1]
   9 TUPLE: hsva < color { hue read-only } { saturation read-only } { value read-only } { alpha read-only } ;
  10
  11 C: <hsva> hsva
  12
  13 <PRIVATE
  14
  15 : Hi ( hsv -- Hi ) hue>> 60 / floor 6 mod ; inline
  16
  17 : f ( hsv -- f ) [ hue>> 60 / ] [ Hi ] bi - ; inline
  18
  19 : p ( hsv -- p ) [ saturation>> 1 swap - ] [ value>> ] bi * ; inline
  20
  21 : q ( hsv -- q ) [ [ f ] [ saturation>> ] bi * 1 swap - ] [ value>> ] bi * ; inline
  22
  23 : t ( hsv -- t ) [ [ f 1 swap - ] [ saturation>> ] bi * 1 swap - ] [ value>> ] bi * ; inline
  24
  25 PRIVATE>
  26
  27 M: hsva >rgba ( hsva -- rgba )
  28     [
  29         dup Hi
  30         {
  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 ] }
  37         } case
  38     ] [ alpha>> ] bi <rgba> ;