Cell.hs

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