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