basis/colors/hsv/hsv.factor

   1 ! Copyright (C) 2007 Eduardo Cavazos
   2 ! See http://factorcode.org/license.txt for BSD license.
   3
   4 USING: kernel combinators arrays sequences math math.functions ;
   5
   6 IN: colors.hsv
   7
   8 <PRIVATE
   9
  10 : H ( hsv -- H ) first ;
  11
  12 : S ( hsv -- S ) second ;
  13
  14 : V ( hsv -- V ) third ;
  15
  16 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  17
  18 : Hi ( hsv -- Hi ) H 60 / floor 6 mod ;
  19
  20 : f ( hsv -- f ) [ H 60 / ] [ Hi ] bi - ;
  21
  22 : p ( hsv -- p ) [ S 1 swap - ] [ V ] bi * ;
  23
  24 : q ( hsv -- q ) [ [ f ] [ S ] bi * 1 swap - ] [ V ] bi * ;
  25
  26 : t ( hsv -- t ) [ [ f 1 swap - ] [ S ] bi * 1 swap - ] [ V ] bi * ;
  27
  28 PRIVATE>
  29
  30 ! h [0,360)
  31 ! s [0,1]
  32 ! v [0,1]
  33
  34 : hsv>rgb ( hsv -- rgb )
  35 dup Hi
  36 { { 0 [ [ V ] [ t ] [ p ] tri ] }
  37   { 1 [ [ q ] [ V ] [ p ] tri ] }
  38   { 2 [ [ p ] [ V ] [ t ] tri ] }
  39   { 3 [ [ p ] [ q ] [ V ] tri ] }
  40   { 4 [ [ t ] [ p ] [ V ] tri ] }
  41   { 5 [ [ V ] [ p ] [ q ] tri ] } } case 3array ;