Array.hs

{-# OPTIONS_HADDOCK hide #-}

{-|
Module      : Graphics.Mars.Array
Description : Array utility functions
Copyright   : (c) Christopher Howard, 2016
License     : GPL-3
Maintainer  : ch.howard@zoho.com
-}

module Graphics.Mars.Array where

import Prelude(
  (+), (-), (*), Num, Bool, (==), return, Maybe(..), map, sequence_)
import Data.Array.IArray
import Data.Array.IO

safeReadArray :: (Ix i, MArray a e m) => a i e -> i -> m (Maybe e)
safeReadArray a i = do r <- getBounds a
                       if inRange r i
                         then do e <- readArray a i
                                 return (Just e)
                         else return Nothing

boundedWriteArray :: (Ix i, MArray a e m) => a i e -> i -> e -> m ()
boundedWriteArray a i e = do r <- getBounds a
                             if inRange r i
                               then writeArray a i e
                               else return ()

boundedWriteArrayL
  :: (Ix i, MArray a e m) => a i e -> [(i, e)] -> m ()
boundedWriteArrayL a l = sequence_ (map (\(i, e) -> boundedWriteArray a i e) l)

boundedTransform
  :: (Ix i, MArray a e m) => a i e -> i -> (e -> e) -> m ()
boundedTransform a i f = do x' <- safeReadArray a i
                            case x' of
                              Nothing -> return ()
                              Just x -> boundedWriteArray a i (f x)

boundedTransformL
  :: (Ix i, MArray a e m) =>
     a i e -> (e -> t -> e) -> [(i, t)] -> m ()
boundedTransformL a f l =
  sequence_ (map (\(i, e) -> boundedTransform a i (\e' -> f e' e)) l)

rightEdge :: (Ix i, Ix j, IArray a e) => a (i, j) e -> (i, j) -> Bool
rightEdge a (_, c) = let (_, (_, j2)) = bounds a in c == j2

bottomEdge :: (Ix i, Ix j, IArray a e) => a (i, j) e -> (i, j) -> Bool
bottomEdge a (r, _) = let (_, (j1, _)) = bounds a in r == j1

linearIndex :: Num a => ((a, a), (t, a)) -> (a, a) -> a
linearIndex ((i1, i2), (_, j2)) (r, c) = c - i2 + (r - i1) * (j2 - i2 + 1)

width :: (Num j, Ix i, Ix j, IArray a e) => a (i, j) e -> j
width a = let ((_, i2), (_, j2)) = bounds a
          in j2 - i2