module Graphics.Autom.Paint (toPictureColored, toPicture, toDynImage, toPNG) where
import Prelude (Int, div, Bool(..), fmap, map, (*), (+), fromIntegral, not, Float, round, RealFrac)
import Data.ByteString (pack)
import Graphics.Gloss.Data.Picture (Picture, bitmapOfByteString)
import Data.Monoid (mconcat)
import Codec.Picture (Image(..), Pixel8, DynamicImage(..), savePngImage)
import Data.Word (Word8)
import qualified Data.Vector.Unboxed as VU (length, toList, Vector)
import qualified Data.Vector.Storable as VS (fromList)
import Graphics.Gloss.Data.Color (Color, makeColor, rgbaOfColor)
import Data.Colour.RGBSpace.HSL (hsl)
import Data.Colour.RGBSpace (channelRed, channelGreen, channelBlue)
import GHC.IO (FilePath)
import GHC.Types (IO)
hue :: Float -> Color
hue degrees =
let rgb = hsl degrees 1 0.7
(red, green, blue) = (channelRed rgb, channelGreen rgb, channelBlue rgb)
in makeColor red green blue 1.0
ratioToByte :: RealFrac a => a -> Word8
ratioToByte r = round (r * 255) :: Word8
toPictureColored :: VU.Vector (Bool, Int)
-> Int
-> Float
-> Float
-> Picture
toPictureColored v w sHue rate = bitmapOfByteString w (VU.length v `div` w) d False
where d = mconcat (map f (VU.toList v))
f (b, i) = if not b then pack [0, 0, 0, 0]
else (\(r', g', b', _) -> pack [ ratioToByte r'
, ratioToByte g'
, ratioToByte b'
, ratioToByte 1.0 ])
(rgbaOfColor (hue (sHue + (fromIntegral i) * rate)))
toPicture :: VU.Vector Bool
-> Int
-> Picture
toPicture v w = bitmapOfByteString w (VU.length v `div` w) d False
where d = mconcat (map f (VU.toList v))
f b = if b then pack [255, 255, 255, 255]
else pack [0, 0, 0, 0]
toDynImage :: VU.Vector Bool
-> Int
-> DynamicImage
toDynImage v w = ImageY8 (Image { imageWidth = w
, imageHeight = VU.length v `div` w
, imageData = d })
where d = VS.fromList (fmap f (VU.toList v))
f b = if b then (255 :: Pixel8) else (0 :: Pixel8)
toPNG :: GHC.IO.FilePath -> DynamicImage -> GHC.Types.IO ()
toPNG = savePngImage