pure-noise-0.2.1.1: test/FractalSpec.hs

{-# LANGUAGE OverloadedStrings #-}

module FractalSpec (test_golden_fractal) where

import Golden.Util
import Numeric.Noise
import Test.Tasty (TestTree, testGroup)

test_golden_fractal :: TestTree
test_golden_fractal =
  testGroup
    "Fractal Golden Tests"
    [ testGroup "2D Grid Tests" fractal2DGridTests
    , testGroup "2D Sparse Tests" fractal2DSparseTests
    , testGroup "3D Grid Tests" fractal3DGridTests
    , testGroup "3D Sparse Tests" fractal3DSparseTests
    ]

-- Fractal types to test
data FractalType = FBM | Billow | Ridged | PingPong
  deriving (Show, Eq, Enum, Bounded)

-- Apply the fractal type to a 2D noise function
applyFractal2D :: FractalType -> Noise2 Double -> Noise2 Double
applyFractal2D FBM = fractal2 defaultFractalConfig
applyFractal2D Billow = billow2 defaultFractalConfig
applyFractal2D Ridged = ridged2 defaultFractalConfig
applyFractal2D PingPong = pingPong2 defaultFractalConfig defaultPingPongStrength

-- Apply the fractal type to a 3D noise function
applyFractal3D :: FractalType -> Noise3 Double -> Noise3 Double
applyFractal3D FBM = fractal3 defaultFractalConfig
applyFractal3D Billow = billow3 defaultFractalConfig
applyFractal3D Ridged = ridged3 defaultFractalConfig
applyFractal3D PingPong = pingPong3 defaultFractalConfig defaultPingPongStrength

fractal2DGridTests :: [TestTree]
fractal2DGridTests =
  [ goldenImageTest2D "fractal" variant (applyFractal2D fractalType perlin2) seed
  | fractalType <- [minBound .. maxBound]
  , seed <- cellularSeeds
  , let variant = show fractalType ++ "-perlin-2d-seed" ++ show seed
  ]

fractal2DSparseTests :: [TestTree]
fractal2DSparseTests =
  [ goldenSparseTest2D "fractal" variant (applyFractal2D fractalType perlin2) seed
  | fractalType <- [minBound .. maxBound]
  , seed <- cellularSeeds
  , let variant = show fractalType ++ "-perlin-2d-seed" ++ show seed
  ]

fractal3DGridTests :: [TestTree]
fractal3DGridTests =
  [ goldenImageTest3D "fractal" variant (applyFractal3D fractalType perlin3) seed zOffset
  | fractalType <- [minBound .. maxBound]
  , seed <- cellularSeeds
  , (idx, zOffset) <- zip [0 :: Int ..] sliceOffsets3D
  , let variant = show fractalType ++ "-perlin-3d-seed_" ++ show seed ++ "-slice_" ++ show idx
  ]

fractal3DSparseTests :: [TestTree]
fractal3DSparseTests =
  [ goldenSparseTest3D "fractal" variant (applyFractal3D fractalType perlin3) seed
  | fractalType <- [minBound .. maxBound]
  , seed <- cellularSeeds
  , let variant = show fractalType ++ "-perlin-3d-seed" ++ show seed
  ]