{-| 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