Wednesday, 13 January 2010

Brian's Brain in Haskell and JavaScript

Last time I implemented the front-end for Brian's brain, which was simply a little canvas tag which stores the state of the grid.

This time it's the calculation side of things. First off we define some data types.

  data Cell = Off 
| On
| Dying
deriving (Eq,Show)

type GameGrid = Array (Int,Int) Cell

type Neighbours = [Cell]

data Game = Game GameGrid Int deriving Show

The grid is a two-dimensional array consisting of a cell. type is just used to give friendly names to types so I don't forget what they are!

Once we've defined these types we need a way of marshalling the data back and forth between Haskell and JavaScript. I couldn't find a better way to do this, so I've done it daftly. For cellToChar I'm sure there must be a way of encoding this information so that I don't have to explictly write out each case? I realise I could define Cell as type data Cell = State Char, but that still doesn't feel write as it's only for three specific instances of Char. Anyway!

  cellToChar :: Cell -> Char
cellToChar Off = '0'
cellToChar On = '1'
cellToChar Dying = '2'

charToCell :: Char -> Cell
charToCell '0' = Off
charToCell '1' = On
charToCell '2' = Dying
charToCell _ = error "Undefined character received"

This now means we can write the main server code as shown below.

  createGame :: Int -> [Cell] -> Game
createGame x c = Game (listArray ((0,0),(x-1,x-1)) c) x

gridToString :: Game -> String
gridToString (Game g _) = map cellToChar (elems g)

processMessage :: String -> String
processMessage s = map cellToChar newGrid where
[cellSizeStr,original] = lines s
cells = map charToCell original
cellSize = read cellSizeStr :: Int
newGrid = step (createGame cellSize cells)

listenLoop :: Handle -> IO ()
listenLoop h = do
msg <- readFrame h
sendFrame h (processMessage msg)
listenLoop h

main :: IO ()
main = serverListen 9876 listenLoop

The rules for Brian's Brain are simple and are easily expressed in Haskell.

  rules :: Cell -> Neighbours -> Cell
rules On _ = Dying
rules Off cells | length (filter (/= Off) cells) == 2 = On
| otherwise = Off
rules Dying _ = Off

List comprehensions make the code very concise.. I've avoided special cases at the edges of the grid for neighbours by assuming it wraps around.

  neighbours :: Game -> (Int,Int) -> Neighbours
neighbours (Game c s) (x,y) = [c ! ((x+dx) `mod` s, (y+dy) `mod` s)
| dx <- [-1,0,1], dy <- [-1,0,1], dx /= dy]

step :: Game -> [Cell]
step g@(Game c s) = [ rules (c ! p) (neighbours g p) | p <- coords] where
coords = [(x,y) | x <- [0..(s-1)], y <- [0..(s-1)]]

Using the Canvas2Image script I was able to create an animation in all of 5 minutes that shows how this looks (create the images, script to save them all, shove them in APNG Edit).

Unfortunately it looks like APNG isn't very well supported so I had to create a video instead. Using ffmpeg you can create a video like this (assuming your files are named 001.jpg, 002.jpg and so on).

ffmpeg -r 3 -b 1800 -i %03d.jpg output.mp4

3 is the framerate and 1800 is the biterate. See here for more information.


And so ends the fun experiment of writing a UI in HTML for a backend in Haskell!