diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/Life.hs b/Life.hs new file mode 100644 --- /dev/null +++ b/Life.hs @@ -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 + diff --git a/README b/README new file mode 100644 --- /dev/null +++ b/README @@ -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 + diff --git a/Setup.lhs b/Setup.lhs new file mode 100644 --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,3 @@ +#!/usr/bin/env runhaskell +> import Distribution.Simple +> main = defaultMain diff --git a/life.cabal b/life.cabal new file mode 100644 --- /dev/null +++ b/life.cabal @@ -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 +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 +