content: 
  module Cell where
  import Graphics.Gloss
  
  -- | A cell in the world.
  data Cell
          = -- | A living cell with its age
            CellAlive Int
  
            -- | A dead / blank cell.
          | CellDead
          deriving (Show, Eq)
  
  
  -- | Sort the living from the dead.
  isAlive :: Cell -> Bool
  isAlive cell
   = case cell of
          CellAlive _     -> True
          CellDead        -> False
  
  
  -- | The basic shape of a cell.
  cellShape :: Int -> Int -> Int -> Picture
  cellShape cellSize posXi posYi
   = let  cs      = fromIntegral cellSize
          posX    = fromIntegral posXi
          posY    = fromIntegral posYi
          x1      = posX
          x2      = posX + cs
          y1      = posY
          y2      = posY + cs
     in   Polygon [(x1, y1), (x1, y2), (x2, y2), (x2, y1)]
  
  
  -- | Convert a cell to a picture, based on a primitive shape.
  --      We pass the shape in to avoid recomputing it for each cell.
  pictureOfCell :: Int -> Int -> Int -> Int -> Cell -> Picture
  pictureOfCell oldAge cellSize posX posY cell
   = case cell of
          CellAlive age   -> Color (ageColor oldAge age)  (cellShape cellSize posX posY)
          CellDead        -> Color (greyN 0.8)            (cellShape cellSize posX posY)
  
  ageColor :: Int -> Int -> Color
  ageColor oldAge age
   = let (r, g, b) = rampColorHotToCold 0 (fromIntegral oldAge) (fromIntegral age)
     in  makeColor r g b 1.0
  
  
  
  -- Color Ramps  -----------------------------------------------------------------------------------
  -- | Standard Hot -> Cold hypsometric color ramp.
  --      Sequence is red, yellow, green, cyan, blue.
  rampColorHotToCold
          :: (Ord a, Floating a)
          => a
          -> a
          -> a
          -> (a, a, a)
  
  rampColorHotToCold vmin vmax vNotNorm
   = let
          v       | vNotNorm < vmin       = vmin
                  | vNotNorm > vmax       = vmax
                  | otherwise             = vNotNorm
  
          dv      = vmax - vmin
  
          result  | v < vmin + 0.25 * dv
                  = ( 0
                    , 4 * (v - vmin) / dv
                    , 1.0)
  
                  | v < vmin + 0.5 * dv
                  = ( 0
                    , 1.0
                    , 1 + 4 * (vmin + 0.25 * dv - v) / dv)
  
                  | v < vmin + 0.75 * dv
                  = ( 4 * (v - vmin - 0.5 * dv) / dv
                    , 1.0
                    , 0.0)
  
                  | otherwise
                  = ( 1.0
                    , 1 + 4 * (vmin + 0.75 * dv - v) / dv
                    , 0)
  
    in    result
  
  
  