{-|
Module      : Graphics.OscPacking.Interpret
Description : Interpreting circles as colorful pictures
Copyright   : (c) Christopher Howard, 2016
License     : GPL-3
Maintainer  : ch.howard@zoho.com
-}

module Graphics.OscPacking.Interpret where

import Prelude ((*), floor, mod, fromInteger, (+), snd, fst, map, (.), Float, pi, (**))
import Graphics.OscPacking.Geometry
import Graphics.Gloss.Data.Picture (Picture(Translate, Pictures, Color))
import qualified Graphics.Gloss.Data.Picture as P (Picture(Circle))
import Graphics.Gloss.Data.Color (white, makeColor)
import Data.Colour.RGBSpace (channelBlue, channelRed, channelGreen)
import Data.Colour.RGBSpace.HSL (hsl)
import Graphics.Gloss.Data.Color (Color)

type Interpretation = [Circle] -> Picture

-- |All circles are white
monoWhite :: Interpretation
monoWhite = (Pictures . map mF)
  where mF (Circle { radius = r, position = p }) =
          Translate (fst p) (snd p) (Color white (P.Circle r))

-- |Takes a hue value (/H/SL) and returns a Gloss 'Color'
hue :: Float -> Graphics.Gloss.Data.Color.Color
hue degrees =
  let rgb = hsl degrees 1 0.7
      (red, green, blue) = (channelRed rgb, channelGreen rgb, channelBlue rgb)
  in makeColor red green blue 1.0
     
-- |Provides a multi-colored interpretation which tends to scale
-- smoothly across the hues as the radius grows
colorful :: Float -> Interpretation
colorful offset = (Pictures . map mF)
  where mF (Circle { radius = r, position = p }) =
          Translate (fst p) (snd p)
            (Color (Graphics.OscPacking.Interpret.hue
                      (fromInteger (mod (floor ((r + offset)**2)) 360)))
             (P.Circle r))

-- |Provides a multi-colored interpretation which gives a seemingly
-- random show of the hues
cycling :: Float -> Float -> Interpretation
cycling speed offset = (Pictures . map mF)
  where mF (Circle { radius = r, position = p }) =
          Translate (fst p) (snd p)
            (Color (Graphics.OscPacking.Interpret.hue
                      (offset + (fromInteger (mod (floor ((2*pi*r) * speed)) 360))))
             (P.Circle r))