life (empty) → 0.1

raw patch · 5 files changed

+174/−0 lines, 5 filesdep +GLUTdep +OpenGLdep +arraysetup-changed

Dependencies added: GLUT, OpenGL, array, base, random

Files

• LICENSE +29/−0
• Life.hs +99/−0
• README +13/−0
• Setup.lhs +3/−0
• life.cabal +30/−0

@@ -0,0 +1,29 @@+Copyright (c) 2009, Chuck Adams+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above copyright+      notice, this list of conditions and the following disclaimer in the+      documentation and/or other materials provided with the distribution.++    * Neither the name of the software nor the names of its contributors+      may be used to endorse or promote products derived from this software+      without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT+HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,99 @@+import Data.IORef+import Data.Array+import Graphics.UI.GLUT+import System.Random+import Control.Monad++-- TODO read these from the commandline+cellsX      = 120+cellsY      = 120+scaleFactor = 6                    ++-- |Conway's life is classically described with these rules:+--   * If a cell has less than 2 neighbors, it dies of loneliness+--   * If a cell has four or more neighbors, it dies of overcrowding+--   * If a cell has 2 or 3 neighbors, it continues to live+--   * If an empty cell has three neighbors, a new cell is born+--+-- Functionally it's easier to describe with just three rules:+--   * An existing cell with two neighbors is live+--   * Any cell/space with exactly three neighbors is live +--   * All other cells/spaces are dead+rule :: Bool -> Int -> Bool+rule True 2 = True+rule _    3 = True +rule _    _ = False    ++type World = Array (Int, Int) Bool++mkWorld :: Int -> Int -> [Bool] -> World+mkWorld sx sy = listArray ((1,1),(sx,sy))++generation :: World -> World+generation w = mkWorld cellsX cellsY $ map (uncurry rule . neighborhood w) $ indices w++neighborhood :: World -> (Int, Int) -> (Bool, Int)+neighborhood world (x,y) = (world ! (x,y), length . filter id $ neighbors)+  where +    neighbors = map (world !*) [(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)]+    (!*) :: World -> (Int, Int) -> Bool+    w !* (x,y) = w ! (wrap cellsX x, wrap cellsY y)+        where wrap bound val | val <  1    = wrap bound $ val + bound - 1+                             | val > bound = wrap bound $ val - bound + 1+                             | otherwise   = val++main :: IO ()+main = do+  rng <- newStdGen+  let world = (mkWorld cellsX cellsY . map toEnum . randomRs (0,1)) rng+  worldRef <- newIORef $ world++  getArgsAndInitialize+  initialDisplayMode $= [ DoubleBuffered ]++  let screenX = fromIntegral $ cellsX * scaleFactor+      screenY = fromIntegral $ cellsY * scaleFactor++  initialWindowSize $= Size screenX screenY+  createWindow "Conway's Life"++  idleCallback $= Just (updateWorld worldRef)++  clearColor $= Color4 0 0 0 0+  ortho 0.0 (fromIntegral screenX) 0.0 (fromIntegral screenY) (-1.0) 1.0+  mainLoop++updateWorld :: IORef World -> IO ()+updateWorld wr = do +  atomicModifyIORef wr $ \w -> (generation w, ())+  drawWorld wr++v2 :: GLfloat -> GLfloat -> Vertex2 GLfloat+v2 x y = Vertex2 x y :: Vertex2 GLfloat++drawWorld :: IORef World -> IO ()+drawWorld wr = do +  world <- readIORef wr+  clear [ColorBuffer]+  sequence [drawCell world x y | x <- [1..cellsX], y <- [1..cellsY]]+  swapBuffers+  flush++drawCell :: World -> Int -> Int -> IO ()+drawCell world x y = do+  let sf = fromIntegral scaleFactor+      sx = (fromIntegral x) * sf :: GLfloat+      sy = (fromIntegral y) * sf :: GLfloat++  currentColor $= (cellColor $ world ! (x,y))+  renderPrimitive Polygon $ do+                       vertex $ v2 sx sy +                       vertex $ v2 sx (sy + sf)+                       vertex $ v2 (sx + sf) (sy + sf)+                       vertex $ v2 (sx + sf) sy+      where +        cellColor True  = Color4 1 1 1 1+        cellColor False = Color4 0 0 0 1+    

@@ -0,0 +1,13 @@+To run with cabal-install (recommended): +   $ cabal install+   $ life++If you don't have cabal-install:+   $ runhaskell ./Setup.lhs configure+   $ runhaskell ./Setup.lhs build+   $ dist/build/life/life++By hand:+   $ ghc --make -O2 Life.hs+   $ ./life+

@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain

@@ -0,0 +1,30 @@+name:          life+version:       0.1+category:      Game+synopsis:      Conway's Life cellular automaton+homepage:      http://github.com/sproingie/haskell-cells/++description: Conway's life as an OpenGL example. Special thanks to+ 	     Will Donnelly for his pure-functional Brians Brain code+ 	     that got this started (cabal unpack brians-brain).++stability:     example+author:        Chuck Adams+maintainer:    Chuck Adams <cja987@gmail.com>+copyright:     (c) 2009 Chuck Adams+license:       BSD3+license-file:  LICENSE++build-type:    Simple+cabal-version: >= 1.6++data-files: README++executable "life"+  main-is:       Life.hs+  build-depends: base >= 4 && < 5, OpenGL, GLUT, random, array++source-repository head+  type: git+  location: git://github.com/sproingie/haskell-cells.git+