content: {-# LANGUAGE BangPatterns     #-}
  {-# LANGUAGE ParallelListComp #-}
  {-# LANGUAGE PatternGuards    #-}
  
  module World where
  import Cell
  import System.Random
  import Control.Monad
  import Graphics.Gloss.Interface.Pure.Simulate
  import qualified Data.Vector    as Vec
  
  type Vec        = Vec.Vector
  
  -- Index ----------------------------------------------------------------------
  -- | An index into the vector holding all the cells.
  type Index      = Int
  
  -- | The x y coordinate of a cell.
  type Coord      = (Int, Int)
  
  indexOfCoord :: World -> Coord -> Index
  indexOfCoord world (x, y)
          = x + y * (worldWidth world)
  
  coordOfIndex :: World -> Index -> Coord
  coordOfIndex world i
          = ( i `mod` worldWidth world
            , i `div` worldWidth world)
  
  
  -- World ----------------------------------------------------------------------
  data World
          = World
          { worldCells            :: Vec Cell
          , worldWidth            :: Int
          , worldHeight           :: Int
  
          -- | Width and height of each cell.
          , worldCellSize         :: Int
  
          -- | Number of pixels to leave between each cell.
          , worldCellSpace        :: Int
  
          -- | Cells less than this age are drawn with the color ramp
          , worldCellOldAge       :: Int
  
          -- | Seconds to wait between each simulation step.
          , worldSimulationPeriod :: Float
  
          -- | Time that has elapsed since we drew the last step
          , worldElapsedTime      :: Float }
  
  
  -- | Make a new world of a particular size.
  randomWorld :: (Int, Int) -> IO World
  randomWorld (width, height)
   = do   bools   <- replicateM (width * height) randomIO
          return  $ World
                  { worldCells            = Vec.fromList $ map cellOfBool bools
                  , worldWidth            = width
                  , worldHeight           = height
                  , worldCellSize         = 5
                  , worldCellSpace        = 1
                  , worldCellOldAge       = 20
                  , worldSimulationPeriod = 0.1
                  , worldElapsedTime      = 0 }
  
  
  -- | Convert a bool to a live or dead cell.
  cellOfBool :: Bool -> Cell
  cellOfBool b
   = case b of
          True    -> CellAlive 0
          False   -> CellDead
  
  
  -- | Get the cell at a particular coordinate in the world.
  getCell :: World -> Coord -> Cell
  getCell world coord@(x, y)
          | x < 0 || x >= worldWidth  world       = CellDead
          | y < 0 || y >= worldHeight world       = CellDead
  
          | otherwise
          = worldCells world Vec.! indexOfCoord world coord
  
  
  -- | Get the neighbourhood of cells around this coordinate.
  getNeighbourhood :: World -> Coord -> [Cell]
  getNeighbourhood world (ix, iy)
   = let  indexes = [ (x, y)
                          | x <- [ix - 1 .. ix + 1]
                          , y <- [iy - 1 .. iy + 1]
                          , not (x == ix && y == iy) ]
     in   map (getCell world) indexes
  
  
  -- | Compute the next cell state depending on its neighbours.
  stepCell :: Cell -> [Cell] -> Cell
  stepCell cell neighbours
   = let  live    = length (filter isAlive neighbours)
     in   case cell of
           CellAlive age  -> if elem live [2, 3] then CellAlive (age + 1) else CellDead
           CellDead       -> if live == 3        then CellAlive 0         else CellDead
  
  
  -- | Compute the next state of the cell at this index in the world.
  stepIndex :: World -> Int -> Cell -> Cell
  stepIndex world index cell
   = let  coord   = coordOfIndex world index
          neigh   = getNeighbourhood world coord
     in   stepCell cell neigh
  
  
  -- | Compute the next world state.
  stepWorld :: World -> World
  stepWorld world
          = world { worldCells = Vec.imap (stepIndex world) (worldCells world) }
  
  
  -- | Simulation function for worlds.
  simulateWorld :: ViewPort -> Float -> World -> World
  simulateWorld _ time world
  
          -- If enough time has passed then it's time to step the world.
          | worldElapsedTime world >= (worldSimulationPeriod world)
          = let world'    = stepWorld world
            in  world' { worldElapsedTime = 0 }
  
          -- Wait some more.
          | otherwise
          = world { worldElapsedTime = worldElapsedTime world + time }
  
  
  