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

import GHC.Conc (numCapabilities)
import Control.Concurrent (forkIO, Chan, newChan, getChanContents, writeChan)
import Control.Monad (forM_)
import Data.Function (on)
import Data.List (nub, nubBy, unfoldr)
import Data.Ratio (denominator, (%))
import System.Environment (getArgs)
import System.Random (newStdGen, RandomGen, random, randomR, split)

import Fractal.GRUFF

import Fractal.RUFF.Mandelbrot.Address
  ( AngledInternalAddress(..), angledToList, angledFromList
  , prettyAngledInternalAddress
  )
import Fractal.RUFF.Mandelbrot.Atom (MuAtom(..), findAtom_)
import Fractal.RUFF.Types.Complex (Complex((:+)))

import Number (R)

main :: IO ()
main = do
  n <- (read . head) `fmap` getArgs
  gs <- unfoldr (Just . split) `fmap` newStdGen
  ch <- newChan
  forM_ ([0..] `zip` take numCapabilities gs) $ forkIO . worker ch
  let unique = nubBy ((==) `on` snd)
      f ((i, _), a) = (i, toFileName (prettyAngledInternalAddress a))
  defaultMain . take n . map f . unique =<< getChanContents ch

toFileName :: String -> String
toFileName = (++ ".ppm") . map toFileChar

toFileChar :: Char -> Char
toFileChar '/' = '-'
toFileChar ' ' = '_'
toFileChar  c  =  c

type Message = ((Image, FilePath), AngledInternalAddress)

worker :: RandomGen g => Chan Message -> (Int, g) -> IO ()
worker ch (w, g) =
  mapM_ (uncurry $ work ch w) . zip [0..] . nub . randomAddresses $ g

work :: Chan Message -> Int -> Int -> AngledInternalAddress -> IO ()
work ch w n a = case scene n a of
  Nothing -> return ()
  Just (i, f) -> writeChan ch ((i, show w ++ "_" ++ f), a)

scene :: Int -> AngledInternalAddress -> Maybe (Image, FilePath)
scene n a = do
  a' <- (angledFromList . angledToList) a
  m <- findAtom_ a'
  let cx :+ cy = muNucleus m :: Complex R
      f = filename n
      i = Image
            { imageLocation = Location
                { center = toRational cx :+ toRational cy
                , radius = muSize m * 32
                }
            , imageViewport = Viewport
                { aspect = 1
                , orient = muOrient m - pi / 2
                }
            , imageWindow   = Window
                { width = 512
                , height = 512
                , supersamples = 8
                }
            , imageColours  = Colours
                { colourInterior = Colour 1 0 0
                , colourBoundary = Colour 0 0 0
                , colourExterior = Colour 1 1 1
                }
            , imageLabels   = []
            , imageLines    = []
            }
  return (i, f)

filename :: Int -> FilePath
filename n = (reverse . take 4 . (++ "0000") . reverse . show) n ++ ".ppm"

randomAddresses :: RandomGen g => g -> [AngledInternalAddress]
randomAddresses g = let (g', a) = randomAddress g in  a : randomAddresses g'

randomAddress :: RandomGen g => g -> (g, AngledInternalAddress)
randomAddress g = randomAddress' g 16 2 1

randomAddress' ::
  RandomGen g => g -> Int -> Integer -> Integer -> (g, AngledInternalAddress)
randomAddress' g0 size _den per | size == 0 || per > 100 = (g0, Unangled per)
randomAddress' g0 size  den per
  | coin < (0.125 :: Double) && den' > 2 =
      if per' > 200
        then (g6, Unangled per)
        else Angled per angle `fmap` randomAddress' g6 (size - 1) den' per'
  | otherwise = Angled per (1/2) `fmap` randomAddress' g6 (size - 1) den per2
  where
    (coin, g1) = random g0
    (rand, g2) = random g1
    (numr, g3) = randomR (1, denr - 1) g2
    (poff, g4) = randomR (1, den - 1)  g3
    (per', g5) = randomR (perMin, perMax) g4
    (per'', g6) = randomR (perMin', perMax') g5
    per2 = if den > 2 then per + poff else per''
    denr = floor (31 * rand * rand + 2 :: Double)
    angle = numr % denr
    den' = denominator angle
    perMin = per * (den' - 1) - 1
    perMax = (per + 1) * den' - 1
    perMin' = per + 1
    perMax' = per * 2