DouKaku?

module Main
    where

import Data.Array

type Point = (Int, Int)
type Size = (Int, Int)
type TwoDArray = (Size, Array Int Char)

glider = ".........." ++
     "..X......." ++ 
     ".X........" ++ 
     ".XXX......" ++ 
     ".........." ++
     ".........." ++
     ".........." ++
     ".........." ++
     ".........." ++
     ".........."

makeArray :: Size -> [Char] -> TwoDArray
makeArray  sz@(cx, cy) str = (sz, listArray (0, cx * cy - 1) str)

ptToIdx :: Size -> Point -> Int
ptToIdx (cx, cy) (x, y) = (y * cx) + x

fetch :: TwoDArray -> Point -> Char
fetch (sz, rg) pt = rg!(ptToIdx sz pt)

surrounding = [(x, y) | x <- [-1..1], y <-[-1..1], x /= 0 || y /= 0]

addPt :: Point -> Size -> Point -> Point
addPt (x1, y1) (cx, cy) (x2, y2) = ((x1 + x2) `mod` cx, (y1 + y2) `mod` cy)

getSurroundingPts :: Point -> Size -> [Point]
getSurroundingPts pt sz = map (addPt pt sz) surrounding

countSurroundingLife :: TwoDArray -> Point -> Int
countSurroundingLife td@(sz, rg) pt  = 
    length $ filter (/='.') $ map (fetch td) $ getSurroundingPts pt sz

allPoints :: Size -> [Point]
allPoints (cx, cy) = [(x, y) | y <- [0..(cx - 1)], x <- [0..(cy - 1)]]

birthDeath :: Char -> Int -> Char
birthDeath ch c
    | c == 3 && ch == '.' = 'X'
    | ch == 'X' && (c == 2 || c == 3) = 'X'
    | otherwise = '.'

doGen :: TwoDArray -> Point -> Char
doGen rg pt = birthDeath (fetch rg pt) (countSurroundingLife rg pt)

nextGen :: TwoDArray -> TwoDArray
nextGen td@(sz, rg) = makeArray sz $ map (doGen td) (allPoints sz)

lifes :: TwoDArray -> [TwoDArray]
lifes td = [td] ++ (lifes (nextGen td))

dumpRow :: TwoDArray -> Int -> IO()
dumpRow ((cx, cy), rg) iy = putStrLn $ map (rg!) $ [(iy * cx)..((iy * cx) + cx - 1)]

dumpMap :: TwoDArray -> Int -> IO()
dumpMap td@(size@(cx, cy), rg) iGen = do
    putStrLn $ "Generation " ++ (show iGen)
    mapM (dumpRow td) [0..(cy-1)]
    putStrLn ""

doLife :: [(Int, TwoDArray)] -> IO()
doLife [] = return ()
doLife (x@(iGen, rg):xs) = do
    dumpMap rg iGen
    doLife xs

main :: IO()
main = do
    doLife $ zip [1..20] (lifes start)
    where
        start = makeArray sz glider
        sz = (10, 10)

import List
import System
import System.Posix.Unistd

main = do args <- getArgs
          let initState    = [[read [c] :: Int| c <- line]| line <- initStateStr]
              initStateStr = split ':' $ head args
                  where
                    split :: (Eq a) => a -> [a] -> [[a]]
                    split d xs
                        | null xs   = []
                        | otherwise = case break (== d) xs of
                                        (fxs,[])  -> [fxs]
                                        (fxs,sxs) -> fxs : split d (tail sxs)
          (putEachStrWithSleep 400000) . (map stateToStr) $ lifeGame initState

putEachStrWithSleep :: Int -> [String] -> IO ()
putEachStrWithSleep _ []        = putStr ""
putEachStrWithSleep usec (s:ss) = (putStrLn . replace0 . replace1) s >> 
                                  usleep usec >> 
                                  putEachStrWithSleep usec ss
    where
      replace0 = replaceStr '0' '.'
      replace1 = replaceStr '1' '@'

      replaceStr :: Char -> Char -> String -> String
      replaceStr _ _ ""      = []
      replaceStr c c' (s:ss) = (if (c == s) then c' else s) : replaceStr c c' ss

infixl 9 !!>

(!!>) :: [a] -> Int -> a
(!!>) xs n
    | null xs   = error "Main.(!!>): empty list\n."
    | otherwise = xs !! (n `mod` length xs)

type State = [[Int]]

stateToStr :: State -> String
stateToStr []     = ""
stateToStr (s:ss) = concatMap show s ++ "\n" ++ stateToStr ss

lifeGame :: State -> [State]
lifeGame state = state : (lifeGame . nextState) state

nextState :: State -> State
nextState state = [[nextCell state (x,y)| x <- [0..maxX]]| y <- [0..maxY]]
    where
      maxX = ((length . head) state) - 1
      maxY = (length state) - 1

nextCell :: State -> (Int,Int) -> Int
nextCell state (x,y)
    | numNeighborLives == 2 = targetCell
    | numNeighborLives == 3 = if (targetCell == 0) then 1 else targetCell
    | otherwise             = 0
    where
      targetCell :: Int
      targetCell = cell (x,y)

      numNeighborLives :: Int
      numNeighborLives = (length . filter (== 1)) neighborCells

      neighborCells :: [Int]
      neighborCells
          = [cell (x-1,y-1), cell (x,y-1), cell (x+1,y-1),
             cell (x-1,y)  ,               cell (x+1,y)  ,
             cell (x-1,y+1), cell (x,y+1), cell (x+1,y+1)]

      cell :: (Int,Int) -> Int
      cell (x,y) = state !!> y !!> x

module Main (main) where

import Data.Array
import Data.List (iterate)
import System.Random (randomRs, newStdGen)

newtype World = World (Array (Int, Int) Bool)
instance Show World where
    show (World cells) = concat $ map f $ assocs cells
        where showCell c = if c then "[*]" else "[ ]"
              (_, (lastx, _)) = bounds cells
              f ((_, x), c) | x == lastx = showCell c ++ "\n"
                            | otherwise  = showCell c

(!@) :: World -> (Int, Int) -> Bool
(World cells) !@ (x, y) = cells ! (wrap x, wrap y)
    where (_, (size, _)) = bounds cells
          wrap n | n < 0     = size
                 | n > size  = 0
                 | otherwise = n

next :: World -> World
next w@(World cells) = rebuild $ map step $ assocs cells
    where rebuild = World . array (bounds cells)
          around (px, py) = length $ filter id [w !@ (x, y) | x <- [px - 1 .. px + 1],
                                                              y <- [py - 1 .. py + 1],
                                                              x /= px || y /= py]
          step (p, True)  = let a = around p in (p, a == 2 || a == 3)
          step (p, False) = (p, around p == 3)

mkWorld :: Int -> IO World
mkWorld size = do g1 <- newStdGen
                  g2 <- newStdGen
                  return $ w g1 g2
    where ix       = ((0, 0), (size - 1, size - 1))
          init     = [((x, y), False) | x <- [0 .. size - 1], y <- [0 .. size - 1]]
          w g1 g2  = World $ array ix init // ps g1 g2
          ps g1 g2 = take (size * size `div` 3) $
                     flip zip (repeat True) $
                     zipWith (,) (randomRs (0, size - 1) g1) (randomRs (0, size - 1) g2)

generations :: World -> [World]
generations = iterate next

main :: IO ()
main = mkWorld 10 >>= mapM_ print . take 50 . generations