import Control.Monad (when) import Data.List (group, unfoldr) import Graphics.UI.SDL as SDL import System.Environment (getArgs) import System.Random.Mersenne.Pure64 (pureMT, randomInt) (xres, yres, unit) = (400, 400, 2) main = withInit [InitVideo] $ do [n] <- getArgs w <- setVideoMode xres yres 32 [NoFrame] enableEvent SDLMouseMotion False setCaption "Elementary CA" "Elementary CA" run w $ zip (concat $ cells (read n) seed) xys run w (b:bs) = do drawCell w b e <- pollEvent case e of KeyUp (Keysym SDLK_ESCAPE _ _) -> return () _ -> run w bs drawCell w (b, (x,y)) = do f =<< createRGBSurface [SWSurface] unit unit 32 0 0 0 0 when (x `mod` 157 == 0) $ SDL.flip w where rect = Just $ Rect x y unit unit rgb = maybe 0 id $ lookup b rgbs rgbs = [(0, 0xffffff), (1, 0x225577), (2,0)] f c = do fillRect c Nothing $ Pixel rgb blitSurface c Nothing w rect xys = concat . zipWith zip xs $ map repeat [0, unit..] where xs = offset $ iterate f [-299, -298.. 300] offset = map . map $ (+ (xres `div` 2)) . (* unit) f (n:ns) = enumFromTo (n-1) $ last ns + 1 ------------------------------------------------------- seed = take 600 $ map (`mod` 3) ns where ns = unfoldr (Just . randomInt) $ pureMT 71 cells n = iterate next where next = map (f . sum) . chunk . pad f = maybe 0 id . (`lookup` rule) rule = zip [6,5..0] $ tern n pad s = [0,0] ++ s ++ [0,0] chunk [_,_] = [] chunk ns = take 3 ns : chunk (tail ns) tern n = map (length . f) pows where pows = map ((:[]) . (3^)) [6,5..0] f m | m `elem` group (bits n) = m f m | (m ++ m) `elem` group (bits n) = m ++ m | otherwise = [] bits 0 = [] bits n = let x = f n in x : bits (n-x) where f n = last $ takeWhile (<= n) $ map (3^) [0..]

## Monday, March 30, 2015

### primitive totalistic automata

This code renders any of the 2187 possible 3-colored, 1-dimensional totalistic CAs; its input is an integer representing the CA rule in base 3.

Subscribe to:
Posts (Atom)