From b8fea3ab6654357340c3f6fcfdee27b9ee5519ce Mon Sep 17 00:00:00 2001 From: Tom Smeding Date: Sun, 16 Oct 2022 16:29:34 +0200 Subject: More colorschemes --- render/Render.hs | 49 +++++++++++++++++++++++++++++++++++-------------- 1 file changed, 35 insertions(+), 14 deletions(-) (limited to 'render') 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 \n" + "Usage: mandelhs-render \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