From b8fea3ab6654357340c3f6fcfdee27b9ee5519ce Mon Sep 17 00:00:00 2001
From: Tom Smeding <tom@tomsmeding.com>
Date: Sun, 16 Oct 2022 16:29:34 +0200
Subject: More colorschemes

---
 mandelhs.cabal   |  1 +
 render/Render.hs | 49 +++++++++++++++++++++++++++++++++++--------------
 2 files changed, 36 insertions(+), 14 deletions(-)

diff --git a/mandelhs.cabal b/mandelhs.cabal
index 8e92db9..e149c59 100644
--- a/mandelhs.cabal
+++ b/mandelhs.cabal
@@ -52,6 +52,7 @@ executable mandelhs-render
     bytestring,
     -- accelerate-llvm-native already depends on cereal
     cereal,
+    containers,
     JuicyPixels ^>= 3.3.8,
     vector
   hs-source-dirs:
diff --git a/render/Render.hs b/render/Render.hs
index 425da1c..095df8d 100644
--- a/render/Render.hs
+++ b/render/Render.hs
@@ -9,6 +9,9 @@ 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 Data.List (intercalate)
+import qualified Data.Map.Strict as Map
+import Data.Map.Strict (Map)
 import qualified Data.Serialize as Ser
 import Data.Word
 import qualified Data.Vector.Storable as VS
@@ -20,31 +23,46 @@ import MandelHSlib
 
 type Colorscheme = Double -> (Word8, Word8, Word8)
 
-colorscheme :: Colorscheme
-colorscheme fraction =
+colorscheme_yellow :: Colorscheme
+colorscheme_yellow 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) =
+colorscheme_purple :: Colorscheme
+colorscheme_purple fraction =
+  let x = max 0 fraction ** 0.4
+  in (tow8 $ 0.05 + 0.2 * curve x 0.0 0.4 + 0.65 * curve x 0.3 0.8 - 0.6 * curve x 0.8 1.0
+     ,0
+     ,tow8 $ 0.1 + 0.7 * curve x 0.0 0.4 - 0.4 * curve x 0.7 1.0 - 0.2 * curve x 0.9 1.0)
+
+tow8 :: Double -> Word8
+tow8 x = round (max 0 (min 255 (x * 255)))
+
+curve :: Double -> Double -> Double -> Double
+curve x start end
+  | x <= start = 0
+  | x >= end = 1
+  | otherwise = sin (pi/(end-start) * (x - start) - pi/2) / 2 + 0.5
+
+colorschemes :: Map String Colorscheme
+colorschemes = Map.fromList
+  [("yellow", colorscheme_yellow)
+  ,("purple", colorscheme_purple)]
+
+renderFractal :: Colorscheme -> Fractal -> Pix.Image Pix.PixelRGB8
+renderFractal colors (Fractal (w, h) _ arr) =
   Pix.Image w h $ VS.fromList
     [val
     | fraction <- VS.toList arr
-    , let (r, g, b) = colorscheme fraction
+    , let (r, g, b) = colors fraction
     , val <- [r, g, b]]
 
 usage :: String
 usage =
-  "Usage: mandelhs-render <infile.data> <outfile.png>\n"
+  "Usage: mandelhs-render <infile.data> <outfile.png> <colorscheme>\n"
 
 main :: IO ()
 main = do
@@ -53,13 +71,16 @@ main = do
 
   args <- getArgs
   case args of
-    [infile, outfile] -> do
+    [infile, outfile, csname] -> do
+      colors <- case Map.lookup csname colorschemes of
+                  Nothing -> die $ "Available colorschemes: " ++ intercalate ", " (Map.keys colorschemes)
+                  Just f -> return f
       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
+          renderFractal colors fractal
 
     _ -> putStr usage >> exitFailure
-- 
cgit v1.2.3-70-g09d2