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
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)
type Interpretation = Float -> ByteString
lightnessInt :: Float
-> (Float, Float)
-> 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]
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
in bitmapOfByteString (cbound + 1) (rbound + 1) bStr False