{-

  PFLIFE: the Game of Life in point-free style

  This was written by Tony Finch <dot@dotat.at>.
  You may do anything with it, at your own risk.

  $dotat: life/pflife.hs,v 1.6 2008/03/05 21:08:17 fanf2 Exp $

-}

-- list utilities

uncurry3 f (a,b,c) = f a b c
zip3' = uncurry3 zip3

by3 (a:b:c:ds) = (a,b,c) : by3 (b:c:ds)
by3     _      = []

bracket a xs = [a] ++ xs ++ [a]

mapNth n f xs = as ++ f b : cs
  where
    (as,b:cs) = splitAt n xs

-- game of life

data Cell = Dead | Alive

fromCell Dead = 0
fromCell Alive = 1

rule ((a,b,c),(d,e,f),(g,h,i)) =
    if count == 2 then e else
    if count == 3 then Alive else Dead
  where
    count = sum $ map fromCell [a,b,c,d,f,g,h,i]

deadcell = Dead
deadline = repeat deadcell
deadspace = repeat deadline

restrict (x,y) = map (take x) . take y

grow = (bracket deadline) . map (bracket deadcell)

by3by3 = map zip3' . by3 . map by3

generate = map (map rule) . by3by3 . grow

-- init

setcell (x,y) = mapNth y $ mapNth x $ const Alive

pattern = foldr setcell deadspace

glider = pattern [(2,1),(3,2),(3,3),(2,3),(1,3)]
r_pento = pattern [(71,71),(71,72),(72,72),(71,73),(70,73)]

-- display

instance Show Cell where
  show Dead = "  "
  show Alive = "[]"

display = unlines . map (concatMap show)

-- main

loop m n u = if m < n then return () else do
    putStr "\027[1;1H"
    putStr $ display u
    putStrLn $ show n
    loop m (n+1) (generate u)

main = do
    putStr "\027[2J"
    loop 1122 0 $ restrict (120,120) r_pento

{- eof -}