{-# OPTIONS_HADDOCK hide #-}

{-|
Module      : Graphics.Mars.Stamp
Description : Creating and adding application-relevant arrays.
Copyright   : (c) Christopher Howard, 2016
License     : GPL-3
Maintainer  : ch.howard@zoho.com
-}
module Graphics.Mars.Stamp
       ( circleStamp
       , stamp
       , stampL
       )
       where

import Data.Array.IArray
import Data.Array.IO
import Graphics.Mars.Array

type Point = (Float, Float)
type Metric = Point -> Point -> Float

euclidean :: Metric
euclidean (x1, y1) (x2, y2) = sqrt ((x2 - x1)**2 + (y2 - y1)**2)

semiCircle :: Float -> Float -> Float
semiCircle radius x = sqrt (radius**2 - x**2)

circleStamp
  :: (Integral t, Num e, Ix t, IArray a e) => Float -> a (t, t) e
circleStamp radius = listArray ((start, start),
                                (end, end)) l
  where width = ceiling radius * 2
        start = 0 - width
        end = width
        l = [ if fromIntegral (abs r) <= (semiCircle radius) (fromIntegral c)
              then 1 else 0
            | r <- [start..end], c <- [start..end] ]

stamp
  :: (Num t, Num t1, Num t2, Ix t1, Ix t2, MArray a t m,
      IArray a1 t) =>
     a (t1, t2) t -> a1 (t1, t2) t -> (t1, t2) -> m ()
stamp a sa (srow, scol) =
  boundedTransformL a (+) [ ((r + srow, c + scol), e) | ((r, c), e) <- assocs sa ]

stampL
  :: (Num t, Num t1, Num t2, Ix t1, Ix t2, MArray a t m,
      IArray a1 t) =>
     a (t1, t2) t -> a1 (t1, t2) t -> [(t1, t2)] -> m ()
stampL a sa l = do sequence_ (map (\p -> stamp a sa p) l)