{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns #-}
module Main (main) where

import qualified Codec.Picture.Png as PNG
import qualified Codec.Picture.Types as Pix
import qualified Data.ByteString.Lazy as BSL
import qualified Data.Serialize as Ser
import Data.Word
import qualified Data.Vector.Storable as VS
import System.Environment (getArgs)
import System.Exit (die, exitFailure)

import MandelHSlib


type Colorscheme = Double -> (Word8, Word8, Word8)

colorscheme :: Colorscheme
colorscheme fraction =
  let x = max 0 fraction ** 0.3
      bg = 0.2 * (1 - curve x (-0.1) 0.2)
  in (tow8 $ bg + curve x 0 0.4 - 0.8 * curve x 0.6 1.0
     ,tow8 $ bg + 0.8 * curve x 0.3 0.7
     ,tow8 $ bg + curve x 0.6 1.0)
  where
    tow8 x = round (max 0 (min 255 (x * 255)))
    curve x start end
      | x <= start = 0
      | x >= end = 1
      | otherwise = sin (pi/(end-start) * (x - start) - pi/2) / 2 + 0.5

renderFractal :: Fractal -> Pix.Image Pix.PixelRGB8
renderFractal (Fractal (w, h) _ arr) =
  Pix.Image w h $ VS.fromList
    [val
    | fraction <- VS.toList arr
    , let (r, g, b) = colorscheme fraction
    , val <- [r, g, b]]

usage :: String
usage =
  "Usage: mandelhs-render <infile.data> <outfile.png>\n"

main :: IO ()
main = do
  -- let (w, h) = (4 * 2000, 4 * 1500)
  --     maxiter = 1024

  args <- getArgs
  case args of
    [infile, outfile] -> do
      datafile <- BSL.readFile infile
      fractal <- case Ser.runGetLazy Ser.get datafile of
        Left err -> die err
        Right res -> return res
      BSL.writeFile outfile $
        PNG.encodePng $
          renderFractal fractal

    _ -> putStr usage >> exitFailure