World.hs

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ParallelListComp #-}
{-# LANGUAGE PatternGuards #-}

module World where

import Brillo.Interface.Pure.Simulate
import Cell
import Control.Monad
import Data.Vector qualified as Vec
import System.Random


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
  , worldCellSize :: Int
  -- ^ Width and height of each cell.
  , worldCellSpace :: Int
  -- ^ Number of pixels to leave between each cell.
  , worldCellOldAge :: Int
  -- ^ Cells less than this age are drawn with the color ramp
  , worldSimulationPeriod :: Float
  -- ^ Seconds to wait between each simulation step.
  , worldElapsedTime :: Float
  -- ^ Time that has elapsed since we drew the last step
  }


-- | 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}