summaryrefslogtreecommitdiff
path: root/render
diff options
context:
space:
mode:
Diffstat (limited to 'render')
-rw-r--r--render/Render.hs67
1 files changed, 67 insertions, 0 deletions
diff --git a/render/Render.hs b/render/Render.hs
new file mode 100644
index 0000000..9126032
--- /dev/null
+++ b/render/Render.hs
@@ -0,0 +1,67 @@
+{-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE ViewPatterns #-}
+module 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
+
+
+colorscheme :: (Ord a, Floating a, RealFrac a) => a -> (Word8, Word8, Word8)
+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 :: (Ord a, Floating a, RealFrac a, VS.Storable a) => Fractal a -> 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 (w, h) _ arr <- case Ser.runGetLazy Ser.get datafile of
+ Left err -> die err
+ Right res -> return res
+ BSL.writeFile outfile $
+ PNG.encodePng $
+ Pix.Image @Pix.PixelRGB8 w h $ VS.fromList
+ [val
+ | fraction <- VS.toList arr
+ , let (r, g, b) = colorscheme @Double fraction
+ , val <- [r, g, b]]
+
+ _ -> putStr usage >> exitFailure