module FunctionalImage where

-- import Codec.Utils (Octet)
import Data.Word

type Point = (Double, Double)
type Image a = Point -> a
type Region = Image Bool
type Frac = Double
type Colour = (Frac, Frac, Frac, Frac)  -- BGRA

invisible,white,red,green,blue,cyan,magenta,yellow,black :: Colour
invisible = (0,0,0,0)
white     = (1,1,1,1)
red       = (0,0,1,1)
green     = (0,1,0,1)
blue      = (1,0,0,1)
cyan      = (1,1,0,1)
magenta   = (1,0,1,1)
yellow    = (0,1,1,1)
black     = (0,0,0,1)

rgb r g b = (b, g, r, 1)

rgba r g b a = (b, g, r, a)

rgb2hsb :: Colour -> (Double,Double,Double)
rgb2hsb (b,g,r,a) =  if r>=g 
                       then if g>=b then aux r b (g-b) 0         -- r g b
                             else if b>=r then aux b g (r-g) 240 -- b r g
                             else aux r g (g-b) 0                 -- r b g                            
                       else if r>=b then aux g b (b-r) 120       -- g r b
                             else if b>=g then aux b r (r-g) 240 -- b g r
                             else aux g r (b-r) 120               -- g b r
  where                           
  aux max min sub angle = let h0 = ((60 * sub / (max-min)) + angle) / 360 
                              h  = if h0 < 0 then h0 + 1 else h0
                              s = (max - min) / max
                              v = max
                            in (h,s,v)

hsb :: Double -> Double -> Double -> Colour
hsb h s v = if s == 0 then (0, 0, 0, 1) else ret
  where h360 :: Double
        h360 = h * 360
        i0, hi :: Int
        f0, hf :: Double
        (i0, f0)   = properFraction h360
        (hi, hf)   = if f0>=0 then (i0 `mod` 360, f0)
                              else ((i0-1) `mod` 360, f0+1)
        hue, saturation, value :: Double
        hue   = fromIntegral hi + hf
        saturation = min s 1
        value      = min v 1
        h1 :: Int
        h1 = hi `div` 60
        f, p, q, t :: Double
        f  = hue / 60 - fromIntegral h1
        p  = value * (1-saturation)
        q  = value * (1-f*saturation)
        t  = value * (1-(1-f)*saturation)
        ret = case h1 of
                  0 -> (p, t, v, 1)
                  1 -> (p, v, q, 1)
                  2 -> (t, v, p, 1)
                  3 -> (v, q, p, 1)
                  4 -> (v, p, t, 1)
                  5 -> (q, p, v, 1)

hsl :: Double -> Double -> Double -> Colour
hsl h s l = if l==0 then hsb h 0 0
              else if l<=0.5 then let diff = s * l
                                      x    = l + diff
                                      n    = l - diff
                                    in hsb h (1-n/x) x
              else let diff = s * (1-l)
                       x    = 1 + diff
                       n    = 1 - diff
                     in hsb h (1-n/x) x

type ImageC = Image Colour
type ImageM = Image Frac

colorList2OctetList :: [Colour] -> [Word8]
colorList2OctetList im = concatMap bgra2octet im
    where
      bgra2octet :: Colour -> [Word8]
      bgra2octet (b,g,r,a) =
        [ round (255*a), round (255*r), round (255*g), round (255*b)]