{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns        #-}
--
-- Example for generating a hot-to-cold colour ramp
-- <http://paulbourke.net/texture_colour/colourspace/>
--
--
--               (max+2*min)/4                         (3*max+min)/4
-- min                              (max+min)/2                              max
-- +------------------+------------------+------------------+------------------+
-- |                                                                           |
-- |                                                                           |
-- +------------------+------------------+------------------+------------------+
-- blue             cyan               green              yellow             red
--

module Main where

import Data.Array.Accelerate                              as A
import Data.Array.Accelerate.IO                           as A  -- package: accelerate-io
import Data.Array.Accelerate.Interpreter                  as A

import Data.Array.Accelerate.Data.Colour.RGB              as RGB

import Prelude                                            as P

zoom, width, height :: Int
zoom   = 10
width  = 100 * zoom
height = 10  * zoom


-- The "standard" hot-to-cold colour map. Given a scalar v in the range
-- [vmin..vmax], each colour component ranges from 0 (no contribution) to
-- 1 (fully saturated).
--
ramp :: Exp Float     -- minimum value
     -> Exp Float     -- maximum value
     -> Exp Float     -- point in the range
     -> Exp Colour
ramp vmin vmax (A.min vmax . A.max vmin -> v)
  = v A.<* vmin + 0.25 * dv ? ( lift (RGB 0 (4 * (v - vmin) / dv) 1)
  , v A.<* vmin + 0.50 * dv ? ( lift (RGB 0 1 (1 + 4 * (vmin + 0.25 * dv - v) / dv ))
  , v A.<* vmin + 0.75 * dv ? ( lift (RGB (4 * (v - vmin - 0.5 * dv) / dv) 1 0)
  , {- otherwise -}             lift (RGB 1 (1 + 4 * (vmin + 0.75 * dv - v) / dv) 0) )))
  where
    dv = vmax - vmin

picker :: Acc (Array DIM2 Colour)
picker = A.generate (constant (Z :. height :. width)) palette
  where
    palette :: Exp DIM2 -> Exp Colour
    palette (unlift -> Z :. (_::Exp Int) :. x) =
      ramp 0 (P.fromIntegral width) (A.fromIntegral x)

main :: IO ()
main
  = writeImageToBMP "hot.bmp"
  $ run $ A.map packRGB picker