Conways

> import System.Posix.Unistd
> import System.Environment
> import Data.Char
> import Maybe

Game of life example from section 9.7 of Programming in Haskell,
Graham Hutton, Cambridge University Press, 2007.

Note: the control characters used in this example may not work
on some Haskell systems, such as WinHugs.


Derived primitives
------------------

> cls                           :: IO ()
> cls                           =  putStr "\ESC[2J"
>
> type Pos                      = (Int,Int)
>
> goto                          :: Pos -> IO ()
> goto (x,y)                    =  putStr ("\ESC[" ++ show y ++ ";" ++ show x ++ "H")
>
> writeat                       :: Pos -> String -> IO ()
> writeat p xs                  =  do goto p
>                                     putStr xs
>
> seqn                          :: [IO a] -> IO ()
> seqn []                       =  return ()
> seqn (a:as)                   =  do a
>                                     seqn as

Game of life
------------

> width                         :: Int
> width                         =  400
>
> height                        :: Int
> height                        =  90
>
> type Board                    =  [Pos]
>
> glider                        :: Board
> glider                        =  [(4,2),(2,3),(4,3),(3,4),(4,4)]

>
> showcells                     :: Board -> IO ()
> showcells b                   =  seqn [writeat p "O" | p <- b]
>
> isAlive                       :: Board -> Pos -> Bool
> isAlive b p                   =  elem p b
>
> isEmpty                       :: Board -> Pos -> Bool
> isEmpty b p                   =  not (isAlive b p)
>
> neighbs                       :: Pos -> [Pos]
> neighbs (x,y)                 =  map wrap [(x-1,y-1), (x,y-1),
>                                            (x+1,y-1), (x-1,y),
>                                            (x+1,y)  , (x-1,y+1),
>                                            (x,y+1)  , (x+1,y+1)]
>
> wrap                          :: Pos -> Pos
> wrap (x,y)                    =  (((x-1) `mod` width) + 1, ((y-1) `mod` height + 1))
>
> liveneighbs                   :: Board -> Pos -> Int
> liveneighbs b                 =  length . filter (isAlive b) . neighbs
>
> survivors                     :: Board -> [Pos]
> survivors b                   =  [p | p <- b, elem (liveneighbs b p) [2,3]]
>
> births b                      =  [p | p <- rmdups (concat (map neighbs b)),
>                                       isEmpty b p,
>                                       liveneighbs b p == 3]
>
> rmdups                        :: Eq a => [a] -> [a]
> rmdups []                     =  []
> rmdups (x:xs)                 =  x : rmdups (filter (/= x) xs)
>
> nextgen                       :: Board -> Board
> nextgen b                     =  survivors b ++ births b

>
> life                          :: Board -> IO ()
> life b                        =  do cls
>                                     showcells b
>                                     wait 200
>                                     life (nextgen b)
>
> wait                          :: Int -> IO ()
> wait n                        = usleep n >> return ()

--
-- This main reads the command line for a list of
-- files to be loaded up.
-- Try running it as "life gosperglidergun_106.lif", for example.
-- it assumes a laaaarge terminal window (400x100). Change the width and height constants
-- above to change that.

> main = do
>            args <- getArgs
>            boards <- sequence (map parseFile args)
>            case (sequence boards) of
>                 Just bs -> life $ center $ (concat bs)
>                 Nothing     -> print "Parse error"

-- For testing this simple interactive main kicks things off with a specific file

> imain = do
>           board <- parseFile "gosperglidergun_106.lif"
>           life $ center $  fromJust board


Life file parser (Life 1.06 format, see http://www.conwaylife.com/wiki/Life_1.06 for details)
---------------------

> parseLines :: [ String ] -> Maybe Board
> parseLines []                            = Nothing
> parseLines ( x : xs ) | confirmVersion x = parseCells (noblanks xs)
>                       | otherwise        = Nothing
>                         where noblanks = filter (/= [])

> confirmVersion x = x == "#Life 1.06"

> parseCells :: [ String ] -> Maybe Board
> parseCells cs = sequence (map parseCell cs)

> parseCell :: String -> Maybe Pos
> parseCell str | valid p1 && valid p2 && null rest = Just (x, y)
>               | otherwise                         = Nothing
>                 where valid = not . null
>                       p1 = reads str
>                       [ (x, str1) ] = p1
>                       p2 = reads str1
>                       [ (y, str2) ] = p2
>                       rest = filter isSpace str2
>

-- test patterns: Glider, Gosper Glider Gun

> testPattern1 = lines "#Life 1.06\n0 -1\n1 0\n-1 1\n0 1\n1 1"
> testPattern2 = lines "#Life 1.06\n6 -4\n4 -3\n6 -3\n-6 -2\n-5 -2\n2 -2\n3 -2\n16 -2\n17 -2\n-7 -1\n-3 -1\n2 -1\n3 -1\n16 -1\n17 -1\n-18 0\n-17 0\n-8 0\n-2 0\n2 0\n3 0\n-18 1\n-17 1\n-8 1\n-4 1\n-2 1\n-1 1\n4 1\n6 1\n-8 2\n-2 2\n6 2\n-7 3\n-3 3\n-6 4\n-5 4"

-- Pattern files from the life wiki come with MS line endings

> dos2unix :: String -> String
> dos2unix = filter (/= '\r')

> parseFile :: String -> IO (Maybe Board)
> parseFile filename = do
>                        s <- readFile filename
>                        return ( parseLines $ lines $ dos2unix s)

> loadFile :: String -> IO Board
> loadFile s = do
>                mf <- parseFile s
>                case mf of
>                        Just b -> return  b
>                        Nothing -> do
>                                    print "Parse error"
>                                    return []

Centering
Pattern files from the life wiki can have negative coordinates which doesn't work well with our model
the centerBoard function will transform a board so that it is centered on our world
---------


> bounds :: Board -> (Pos, Pos)
> bounds b = ( (minx, miny), (maxx, maxy) )
>            where (minx, maxx) = (minimum xs, maximum xs)
>                  (miny, maxy) = (minimum ys, maximum ys)
>                  (xs, ys) = unzip b


> translate :: (Int,Int) -> Board -> Board
> translate  (dx,dy) b = map trans b
>                        where trans (x,y) = (x+dx, y+dy)

> center :: Board -> Board
> center b = translate ( ( (width - maxx - minx) `div` 2) - minx, ( (height - maxy - miny) `div` 2) - miny) b
>          where ( (minx,  miny), (maxx, maxy) ) = bounds b