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