Board.hs

-- |
-- Module: Graphics.Chalkboard.Array
-- Copyright: (c) 2009 Andy Gill
-- License: BSD3
--
-- Maintainer: Andy Gill <andygill@ku.edu>
-- Stability: unstable
-- Portability: ghc
--
-- Boards are the principal type for our images. The are conceptually functions from
-- 2D coordinates to values, typically a color. 
--
-- Common Boards include
--
-- * @Board Bool@           -- A masking @Board@, or region.
--
-- * @Board RGB@	    -- @Color Board@
--
-- * @Board (Alpha RGB)@    -- A @Color Board@ with alpha (transparency) values.
--
-- * @Board (Maybe a)@      -- A @Board@ with binary transparency.
--
-- * @Board (Maybe Color)@  -- A @Color Board@ with binary transparency.
--
-- * @Board Point@          -- A @Board@ (or field) of @Point@ values.
--

module Graphics.Chalkboard.Board 
	( -- * The Board datatype
	  Board
	  -- * looking up a point on the @Board@.
	, lookup
	  -- * Creating @Board@s.
	, coord
	, maskFor
	, circularMaskFor
	  -- * Translations on a @Board@.
	, scale
	, scaleXY
	, move
	, rotate
	 -- 
	, crop
	, Applicative(..)
	) where


import Prelude hiding (lookup)

import Graphics.Chalkboard.Utils
import Graphics.Chalkboard.Types

import Control.Applicative

-- | '''Board''' is our primary data type, an infinite flat surface (or R2 field) of values.
-- Conceptually, @Board a = Point -> a@.
data Board a = Board ((R,R) -> a)
-- TODO: consider have a ConstantBoard

lookup :: Board a -> (R,R) -> a
lookup (Board f) = f

-- Board functionals

instance Scale (Board a) where
  scale n (Board f) = Board $ \ (x,y) -> f (x / n,y / n)

-- | move a Board by specified vector.
move :: (R,R) -> Board a -> Board a
move (xd,yd) (Board f) = Board $ \ (x,y) -> f (x - xd,y - yd)

-- | A non-overloaded version of 'scale' which takes a independent x and y coordinate.
scaleXY :: (R,R) -> Board a -> Board a
scaleXY (xn,yn) (Board f) = Board $ \ (x,y) -> f (x / xn,y / yn)

-- | rotate the Board.
rotate :: Radian -> Board a -> Board a
rotate theta (Board f) = Board $ \ (x,y) -> f (cos theta * x - sin theta * y,
				    	       sin theta * x + cos theta * y)

-- | 'crop' crops a Board, based on a masking Board.
crop :: Board Bool -> Board a -> Board (Maybe a)
crop mask brd = liftA2 withMask brd mask

-- board Generators

-- | 'coord' field or 'Board', where each point is its own coordinate in R2.
coord :: Board Point
coord = Board id

-- | build a rectangle mask or region.
maskFor :: (Point,Point) -> Board Bool
maskFor (p1,p2) = fmap (insideRegion (p1,p2)) coord

-- | build a circular mask or region, with a circle of radius @R@, and center @Point@. 
circularMaskFor :: Point -> R -> Board Bool
circularMaskFor p r = fmap (insideCircle p r) coord

instance Functor Board where
  fmap f (Board fn) = Board (f . fn)

instance Applicative Board where
  pure a = Board $ \ _ -> a
  (Board f) <*> (Board a) = Board (\ (x,y) -> f (x,y) $ a (x,y))

instance (Over c) => Over (Board c) where
  over = liftA2 over