packages feed

gruff-examples-0.3: src/gruff-patterns.hs

import Control.Monad (replicateM)
import Data.Maybe (mapMaybe)
import Data.Ratio (numerator, denominator, (%))
import System.Environment (getArgs)

import Fractal.GRUFF

import Fractal.RUFF.Mandelbrot.Address (parseAngledInternalAddress)
import Fractal.RUFF.Mandelbrot.Atom (MuAtom(..), findAtom_)
import Fractal.RUFF.Types.Complex (Complex((:+)))

import Number (R)

main :: IO ()
main = do
  [num, den, depth] <- map read `fmap` getArgs
  defaultMain (animation (num % den) (fromIntegral depth))

animation :: Rational -> Int -> [(Image, FilePath)]
animation r d = mapMaybe scene (score r d)

scene :: String -> Maybe (Image, FilePath)
scene s = do
  m <- findAtom_ =<< parseAngledInternalAddress s
  let cx :+ cy = muNucleus m :: Complex R
      f = filename s
      i = Image
            { imageLocation = Location
                { center = toRational cx :+ toRational cy
                , radius = muSize m * 16
                }
            , imageViewport = Viewport
                { aspect = 1
                , orient = muOrient m - pi / 2
                }
            , imageWindow   = Window
                { width = 256
                , height = 256
                , supersamples = 16
                }
            , imageColours  = Colours
                { colourInterior = Colour 1 0 0
                , colourBoundary = Colour 0 0 0
                , colourExterior = Colour 1 1 1
                }
            , imageLabels   = []
            , imageLines    = []
            }
  return (i, f)

filename :: String -> FilePath
filename s = map filechar s ++ ".ppm"
  where
    filechar ' ' = '_'
    filechar '/' = '-'
    filechar  c  =  c

score :: Rational -> Int -> [String]
score r n =
  [ "1 " ++ nr ++ "/" ++ dr ++ " " ++ accum deltas
  | deltas <- replicateM n [1 .. denominator r - 1]
  ]
  where
    nr = show (numerator r)
    dr = show (denominator r)
    accum = unwords . map show . scanl (+) (denominator r)