Paint.hs

{-|
Module      : Graphics.Mars.Paint
Description : For converting array data into images.
Copyright   : (c) Christopher Howard, 2016
License     : GPL-3
Maintainer  : ch.howard@zoho.com
-}
module Graphics.Mars.Paint
       ( Interpretation
       , minMax
       , lightnessInt
       , toImage
       ) where

import Prelude(
  (+), Bool(..), fmap, Float, Int, (<), (>),
  (-), (/), Ord, Num, RealFrac, round, (*))
import Data.ByteString (ByteString, pack, concat)
import Data.Colour.RGBSpace (channelRed, channelGreen, channelBlue)
import Data.Colour.RGBSpace.HSL (hsl)
import Data.Word (Word8)
import Graphics.Gloss( Picture,
                       bitmapOfByteString )
import Data.Foldable (Foldable, foldr)
import Data.Array.Unboxed (elems, bounds, UArray)

ratioToByte :: RealFrac a => a -> Word8
ratioToByte r = round (r * 255) :: Word8

-- |Determines the minimum and maximum values in a data structure
minMax :: (Num a, Ord a, Foldable t) => t a -> (a, a)
minMax mx = Data.Foldable.foldr f (0, 0) mx
  where f a (minim, maxim) = if a < minim
                             then (a, maxim)
                             else if a > maxim
                                  then (minim, a)
                                  else (minim, maxim)

-- |A type of function converting a floating point data value into a color's
-- ByteString
type Interpretation = Float -> ByteString

-- |Color interpretation of data as a variation of on the lightness of a single
-- hue
lightnessInt :: Float             -- ^ Hue in degrees, between 0 and 360
                -> (Float, Float) -- ^ the lowest and highest data values,
                                  -- needed for the lightness calculation
                -> Interpretation
lightnessInt hue (lpeak, hpeak) x =
  let lightness = (x - lpeak) / (hpeak - lpeak)
      rgb = hsl hue 1 lightness
      (red, green, blue) = (channelRed rgb, channelGreen rgb, channelBlue rgb)
  in pack [ratioToByte red, ratioToByte green, ratioToByte blue, 1]

-- |Converts an array of floating point values into a Gloss Picture, using a
-- color Interpretation
toImage :: UArray (Int, Int) Float -> Interpretation -> Picture
toImage mx int = let bStr = Data.ByteString.concat (fmap int (elems mx))
                     ((0, 0), (rbound, cbound)) = bounds mx
                 -- Note: Version 0.10.* of Gloss changes the arguments to
                 -- bitmapOfByteString from what is here
                 in bitmapOfByteString (cbound + 1) (rbound + 1) bStr False