diff options
| -rw-r--r-- | compute/Compute.hs | 31 | ||||
| -rw-r--r-- | lib/MandelHSlib.hs | 4 | ||||
| -rw-r--r-- | render/Render.hs | 16 |
3 files changed, 12 insertions, 39 deletions
diff --git a/compute/Compute.hs b/compute/Compute.hs index fde31cf..ee515c7 100644 --- a/compute/Compute.hs +++ b/compute/Compute.hs @@ -3,10 +3,9 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE PatternSynonyms #-} -{-# LANGUAGE TypeApplications #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE ViewPatterns #-} -module Main where +module Main (main) where import qualified Data.Array.Accelerate as A -- import qualified Data.Array.Accelerate.Interpreter as Interpreter @@ -14,7 +13,6 @@ import qualified Data.Array.Accelerate.LLVM.Native as CPU import qualified Data.ByteString.Lazy as BSL import Data.Function ((&)) import qualified Data.Serialize as Ser -import Data.Word import qualified Data.Vector.Storable as VS import Text.Read (readMaybe) import System.Environment (getArgs) @@ -65,12 +63,6 @@ mandelbrot size@(w, h) maxiter (A.the -> cpos) (A.the -> cw) = A.generate (A.I2 (A.constant h) (A.constant w)) $ \idx -> mandeliter (pixel size cpos cw idx) maxiter -mandelSet :: (A.Num a, Num a, A.Ord a, Fractional a, A.Floating a, A.ToFloating Int a, A.Elt a) - => (Int, Int) -> Int -> A.Acc (A.Scalar (a, a)) -> A.Acc (A.Scalar a) - -> A.Acc (A.Matrix Bool) -mandelSet size maxiter cpos cw = - A.map (A.== A.constant maxiter) (mandelbrot size maxiter cpos cw) - image :: (A.Num a, Num a, A.Ord a, Fractional a, A.RealFrac a, A.Floating a, A.ToFloating Int a, A.Elt a) => (Int, Int) -> Int -> A.Acc (A.Scalar (a, a)) -> A.Acc (A.Scalar a) -> A.Acc (A.Matrix a) @@ -98,24 +90,7 @@ image size@(w, h) maxiter acpos@(A.the -> cpos) acw@(A.the -> cw) = in A.zipWith (/) (A.map A.toFloating counts) (A.map A.toFloating mbrot) -colorscheme :: (Ord a, Floating a, RealFrac a) => a -> (Word8, Word8, Word8) -colorscheme fraction - -- | fraction == 1.0 = (0, 0, 0) - | otherwise = - 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 - -computeFractal :: (Ord a, Floating a, RealFrac a, A.Elt a, A.RealFrac a, A.Floating a, A.ToFloating Int a, VS.Storable a) - => (Int, Int) -> Int -> Fractal a +computeFractal :: (Int, Int) -> Int -> Fractal computeFractal (w, h) maxiter = -- let arr = CPU.runN (\cpos cw -> -- A.map (\n -> A.toFloating n / A.toFloating (A.constant maxiter)) @@ -142,7 +117,7 @@ main = do case (readMaybe wids, readMaybe heis, readMaybe maxiters) of (Just w, Just h, Just maxiter) -> BSL.writeFile outfile $ - Ser.runPutLazy (Ser.put (computeFractal @Double (w, h) maxiter)) + Ser.runPutLazy (Ser.put (computeFractal (w, h) maxiter)) _ -> putStr usage >> exitFailure _ -> putStr usage >> exitFailure diff --git a/lib/MandelHSlib.hs b/lib/MandelHSlib.hs index d9409f7..44d59dd 100644 --- a/lib/MandelHSlib.hs +++ b/lib/MandelHSlib.hs @@ -4,9 +4,9 @@ import qualified Data.Serialize as Ser import qualified Data.Vector.Storable as VS -data Fractal a = Fractal (Int, Int) Int (VS.Vector a) +data Fractal = Fractal (Int, Int) Int (VS.Vector Double) -instance (VS.Storable a, Ser.Serialize a) => Ser.Serialize (Fractal a) where +instance Ser.Serialize Fractal where put (Fractal size maxiter v) = do Ser.put size Ser.put maxiter diff --git a/render/Render.hs b/render/Render.hs index 9126032..425da1c 100644 --- a/render/Render.hs +++ b/render/Render.hs @@ -4,7 +4,7 @@ {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE ViewPatterns #-} -module Main where +module Main (main) where import qualified Codec.Picture.Png as PNG import qualified Codec.Picture.Types as Pix @@ -18,7 +18,9 @@ import System.Exit (die, exitFailure) import MandelHSlib -colorscheme :: (Ord a, Floating a, RealFrac a) => a -> (Word8, Word8, Word8) +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) @@ -32,7 +34,7 @@ colorscheme fraction = | 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 -> Pix.Image Pix.PixelRGB8 renderFractal (Fractal (w, h) _ arr) = Pix.Image w h $ VS.fromList [val @@ -53,15 +55,11 @@ main = do case args of [infile, outfile] -> do datafile <- BSL.readFile infile - Fractal (w, h) _ arr <- case Ser.runGetLazy Ser.get datafile of + fractal <- 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]] + renderFractal fractal _ -> putStr usage >> exitFailure |