module Graphics.Mars.Paint
( Interpretation
, minMax
, lightnessInt
, toImage
) where
import Data.ByteString
import Data.Colour.RGBSpace
import Data.Colour.RGBSpace.HSL hiding (hue, lightness)
import Data.Word
import Graphics.Gloss( Picture,
bitmapOfByteString )
import Data.Array.IArray
import Data.Foldable
import Data.Array.Unboxed
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