1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
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
|
