Pastebin launched a little side project called HostCabi.net, check it out ;-)Don't like ads? PRO users don't see any ads ;-)
Guest

Conways

By: a guest on Nov 21st, 2011  |  syntax: Haskell  |  size: 6.63 KB  |  hits: 171  |  expires: Never
download  |  raw  |  embed  |  report abuse  |  print
Text below is selected. Please press Ctrl+C to copy to your clipboard. (⌘+C on Mac)
  1. > import System.Posix.Unistd
  2. > import System.Environment
  3. > import Data.Char
  4. > import Maybe
  5.  
  6. Game of life example from section 9.7 of Programming in Haskell,
  7. Graham Hutton, Cambridge University Press, 2007.
  8.  
  9. Note: the control characters used in this example may not work
  10. on some Haskell systems, such as WinHugs.
  11.  
  12.  
  13. Derived primitives
  14. ------------------
  15.  
  16. > cls                           :: IO ()
  17. > cls                           =  putStr "\ESC[2J"
  18. >
  19. > type Pos                      = (Int,Int)
  20. >
  21. > goto                          :: Pos -> IO ()
  22. > goto (x,y)                    =  putStr ("\ESC[" ++ show y ++ ";" ++ show x ++ "H")
  23. >
  24. > writeat                       :: Pos -> String -> IO ()
  25. > writeat p xs                  =  do goto p
  26. >                                     putStr xs
  27. >
  28. > seqn                          :: [IO a] -> IO ()
  29. > seqn []                       =  return ()
  30. > seqn (a:as)                   =  do a
  31. >                                     seqn as
  32.  
  33. Game of life
  34. ------------
  35.  
  36. > width                         :: Int
  37. > width                         =  400
  38. >
  39. > height                        :: Int
  40. > height                        =  90
  41. >
  42. > type Board                    =  [Pos]
  43. >
  44. > glider                        :: Board
  45. > glider                        =  [(4,2),(2,3),(4,3),(3,4),(4,4)]
  46.  
  47. >
  48. > showcells                     :: Board -> IO ()
  49. > showcells b                   =  seqn [writeat p "O" | p <- b]
  50. >
  51. > isAlive                       :: Board -> Pos -> Bool
  52. > isAlive b p                   =  elem p b
  53. >
  54. > isEmpty                       :: Board -> Pos -> Bool
  55. > isEmpty b p                   =  not (isAlive b p)
  56. >
  57. > neighbs                       :: Pos -> [Pos]
  58. > neighbs (x,y)                 =  map wrap [(x-1,y-1), (x,y-1),
  59. >                                            (x+1,y-1), (x-1,y),
  60. >                                            (x+1,y)  , (x-1,y+1),
  61. >                                            (x,y+1)  , (x+1,y+1)]
  62. >
  63. > wrap                          :: Pos -> Pos
  64. > wrap (x,y)                    =  (((x-1) `mod` width) + 1, ((y-1) `mod` height + 1))
  65. >
  66. > liveneighbs                   :: Board -> Pos -> Int
  67. > liveneighbs b                 =  length . filter (isAlive b) . neighbs
  68. >
  69. > survivors                     :: Board -> [Pos]
  70. > survivors b                   =  [p | p <- b, elem (liveneighbs b p) [2,3]]
  71. >
  72. > births b                      =  [p | p <- rmdups (concat (map neighbs b)),
  73. >                                       isEmpty b p,
  74. >                                       liveneighbs b p == 3]
  75. >
  76. > rmdups                        :: Eq a => [a] -> [a]
  77. > rmdups []                     =  []
  78. > rmdups (x:xs)                 =  x : rmdups (filter (/= x) xs)
  79. >
  80. > nextgen                       :: Board -> Board
  81. > nextgen b                     =  survivors b ++ births b
  82.  
  83. >
  84. > life                          :: Board -> IO ()
  85. > life b                        =  do cls
  86. >                                     showcells b
  87. >                                     wait 200
  88. >                                     life (nextgen b)
  89. >
  90. > wait                          :: Int -> IO ()
  91. > wait n                        = usleep n >> return ()
  92.  
  93. --
  94. -- This main reads the command line for a list of
  95. -- files to be loaded up.
  96. -- Try running it as "life gosperglidergun_106.lif", for example.
  97. -- it assumes a laaaarge terminal window (400x100). Change the width and height constants
  98. -- above to change that.
  99.  
  100. > main = do
  101. >            args <- getArgs
  102. >            boards <- sequence (map parseFile args)
  103. >            case (sequence boards) of
  104. >                 Just bs -> life $ center $ (concat bs)
  105. >                 Nothing     -> print "Parse error"
  106.  
  107. -- For testing this simple interactive main kicks things off with a specific file
  108.  
  109. > imain = do
  110. >           board <- parseFile "gosperglidergun_106.lif"
  111. >           life $ center $  fromJust board
  112.  
  113.  
  114. Life file parser (Life 1.06 format, see http://www.conwaylife.com/wiki/Life_1.06 for details)
  115. ---------------------
  116.  
  117. > parseLines :: [ String ] -> Maybe Board
  118. > parseLines []                            = Nothing
  119. > parseLines ( x : xs ) | confirmVersion x = parseCells (noblanks xs)
  120. >                       | otherwise        = Nothing
  121. >                         where noblanks = filter (/= [])
  122.  
  123. > confirmVersion x = x == "#Life 1.06"
  124.  
  125. > parseCells :: [ String ] -> Maybe Board
  126. > parseCells cs = sequence (map parseCell cs)
  127.  
  128. > parseCell :: String -> Maybe Pos
  129. > parseCell str | valid p1 && valid p2 && null rest = Just (x, y)
  130. >               | otherwise                         = Nothing
  131. >                 where valid = not . null
  132. >                       p1 = reads str
  133. >                       [ (x, str1) ] = p1
  134. >                       p2 = reads str1                        
  135. >                       [ (y, str2) ] = p2
  136. >                       rest = filter isSpace str2
  137. >
  138.  
  139. -- test patterns: Glider, Gosper Glider Gun
  140.  
  141. > testPattern1 = lines "#Life 1.06\n0 -1\n1 0\n-1 1\n0 1\n1 1"
  142. > 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"
  143.  
  144. -- Pattern files from the life wiki come with MS line endings
  145.  
  146. > dos2unix :: String -> String
  147. > dos2unix = filter (/= '\r')
  148.  
  149. > parseFile :: String -> IO (Maybe Board)
  150. > parseFile filename = do
  151. >                        s <- readFile filename
  152. >                        return ( parseLines $ lines $ dos2unix s)
  153.  
  154. > loadFile :: String -> IO Board
  155. > loadFile s = do
  156. >                mf <- parseFile s
  157. >                case mf of
  158. >                        Just b -> return  b
  159. >                        Nothing -> do
  160. >                                    print "Parse error"
  161. >                                    return []
  162.  
  163. Centering
  164. Pattern files from the life wiki can have negative coordinates which doesn't work well with our model
  165. the centerBoard function will transform a board so that it is centered on our world
  166. ---------
  167.  
  168.  
  169. > bounds :: Board -> (Pos, Pos)
  170. > bounds b = ( (minx, miny), (maxx, maxy) )
  171. >            where (minx, maxx) = (minimum xs, maximum xs)
  172. >                  (miny, maxy) = (minimum ys, maximum ys)
  173. >                  (xs, ys) = unzip b
  174.  
  175.  
  176. > translate :: (Int,Int) -> Board -> Board
  177. > translate  (dx,dy) b = map trans b
  178. >                        where trans (x,y) = (x+dx, y+dy)
  179.  
  180. > center :: Board -> Board
  181. > center b = translate ( ( (width - maxx - minx) `div` 2) - minx, ( (height - maxy - miny) `div` 2) - miny) b
  182. >          where ( (minx,  miny), (maxx, maxy) ) = bounds b
  183.  
  184.