From f578ee4a3d2e3357294a5fe83713b5c04ac6096f Mon Sep 17 00:00:00 2001
From: Tom Smeding <tom@tomsmeding.com>
Date: Sun, 16 Oct 2022 16:29:18 +0200
Subject: Consistent pixel type

---
 compute/Compute.hs | 31 +++----------------------------
 lib/MandelHSlib.hs |  4 ++--
 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
-- 
cgit v1.2.3-70-g09d2