\section{Coordinate System Neutral Data}
Coordinate system neutral (\texttt{CSN}) data can transparently be imported into or exported from any affine coordinate system. All \texttt{AffineTransformable} entities
can be represented in coordinate system neutral form.
\begin{code}
module RSAGL.CoordinateSystems
(AffineTransformation,
affine_identity,
CoordinateSystem,
Affine(..),
affineOf,
CoordinateSystemClass(..),
NestedCoordinateSystemTransformer,
root_coordinate_system,
migrate,
transformation,
inverseTransformation,
CSN,
importCSN,
exportCSN,
remoteCSN,
importM,
exportM,
remoteM,
importA,
importFromA,
exportA,
exportToA,
exportCoordinateSystem,
remoteA,
transformM,
transformA,
Distance,
measure,
distance,
distanceSquared)
where
import Control.Arrow
import Control.Monad.State
import Control.Arrow.Operations
import RSAGL.Matrix
import RSAGL.Affine
import RSAGL.Vector
\end{code}
\subsection{Coordinate Systems}
A \texttt{CoordinateSystem} is the context by which coordinate system neutral data can be imported or exported.
\texttt{migrate} is the function that exports data from one coordinate system into another.
All \texttt{CoordinateSystems} are affine transformations of the \texttt{root\_coordinate\_system}.
\begin{code}
data CoordinateSystem = CoordinateSystem Matrix deriving (Show)
instance AffineTransformable CoordinateSystem where
transform m (CoordinateSystem cs) = CoordinateSystem $ matrixMultiply m cs
migrate :: (AffineTransformable a) => CoordinateSystem -> CoordinateSystem -> a -> a
migrate (CoordinateSystem from) (CoordinateSystem to) = inverseTransform to . transform from
class CoordinateSystemClass csc where
getCoordinateSystem :: csc -> CoordinateSystem
storeCoordinateSystem :: CoordinateSystem -> csc -> csc
instance CoordinateSystemClass CoordinateSystem where
getCoordinateSystem = id
storeCoordinateSystem cs = const cs
instance (CoordinateSystemClass csc) => CoordinateSystemClass (a,csc) where
getCoordinateSystem = getCoordinateSystem . snd
storeCoordinateSystem cs = second (storeCoordinateSystem cs)
root_coordinate_system :: CoordinateSystem
root_coordinate_system = CoordinateSystem $ identityMatrix 4
\end{code}
\subsection{Abstract Affine Transformations}
\begin{code}
newtype Affine = Affine { affine_transformation :: forall a. AffineTransformable a => a -> a }
type AffineTransformation = Affine -> Affine
instance AffineTransformable Affine where
transform m (Affine f) = Affine $ transform m . f
affine_identity :: AffineTransformation
affine_identity = id
affineOf :: AffineTransformation -> Affine
affineOf = ($ (Affine id))
affineTransformationToMatrix :: AffineTransformation -> Matrix
affineTransformationToMatrix f = affine_transformation (affineOf f) $ identityMatrix 4
transformation :: (AffineTransformable a) => AffineTransformation -> a -> a
transformation = transform . affineTransformationToMatrix
inverseTransformation :: (AffineTransformable a) => AffineTransformation -> a -> a
inverseTransformation = inverseTransform . affineTransformationToMatrix
postmultiplyTransformation :: AffineTransformation -> CoordinateSystem -> CoordinateSystem
postmultiplyTransformation f (CoordinateSystem cs) = CoordinateSystem $ cs `matrixMultiply` affineTransformationToMatrix f
\end{code}
\subsection{Coordinate System Neutral Data}
\texttt{exportCSN} exports any \texttt{AffineTransformable} data structure. \texttt{importCSN} imports data into the local coordinate system.
\texttt{remoteCSN} operates as a functor to perform nonaffine transformations over coordinate system neutral data. Since any such function
is potentially nonaffine, it must take place within the context of a \texttt{CoordinateSystem}.
Versions of each of these functions are defined for state monads and state arrows, where the state type implements \texttt{CoordinateSystemClass}.
\begin{code}
data CSN a = CSN a deriving (Show)
exportCSN :: (AffineTransformable a) => CoordinateSystem -> a -> CSN a
exportCSN (CoordinateSystem m) a = CSN $ transform m a
importCSN :: (AffineTransformable a) => CoordinateSystem -> CSN a -> a
importCSN (CoordinateSystem m) (CSN a) = inverseTransform m a
remoteCSN :: (AffineTransformable a,AffineTransformable b) => CoordinateSystem -> (a -> b) -> CSN a -> CSN b
remoteCSN context f = exportCSN context . f . importCSN context
exportM :: (Monad m,MonadState s m,CoordinateSystemClass s,AffineTransformable a) => a -> m (CSN a)
exportM a = liftM (flip exportCSN a) $ gets getCoordinateSystem
importM :: (Monad m,MonadState s m,CoordinateSystemClass s,AffineTransformable a) => CSN a -> m a
importM a = liftM (flip importCSN a) $ gets getCoordinateSystem
remoteM :: (Monad m,MonadState s m,CoordinateSystemClass s,AffineTransformable a,AffineTransformable b) => CoordinateSystem -> (a -> b) -> a -> m b
remoteM context f a =
do b <- liftM (remoteCSN context f) $ exportM a
importM b
exportA :: (Arrow arr,ArrowState s arr,CoordinateSystemClass s,AffineTransformable a) => arr a (CSN a)
exportA = proc a ->
do cs <- arr getCoordinateSystem <<< fetch -< ()
returnA -< exportCSN cs a
exportToA :: (Arrow arr,ArrowState s arr,CoordinateSystemClass s,AffineTransformable a) => CoordinateSystem -> arr a a
exportToA cs = exportA >>> arr (importCSN cs)
exportCoordinateSystem :: (Arrow arr,ArrowState s arr,CoordinateSystemClass s) => arr AffineTransformation CoordinateSystem
exportCoordinateSystem = exportToA root_coordinate_system <<< arr (flip transformation root_coordinate_system)
importA :: (Arrow arr,ArrowState s arr,CoordinateSystemClass s,AffineTransformable a) => arr (CSN a) a
importA = proc a ->
do cs <- arr getCoordinateSystem <<< fetch -< ()
returnA -< importCSN cs a
importFromA :: (Arrow arr,ArrowState s arr,CoordinateSystemClass s,AffineTransformable a) => CoordinateSystem -> arr a a
importFromA cs = arr (exportCSN cs) >>> importA
remoteA :: (Arrow arr,ArrowState s arr,CoordinateSystemClass s,AffineTransformable a,AffineTransformable b) => arr (CoordinateSystem, (a -> b), a) b
remoteA = proc (context,f,a) ->
do csn <- exportA -< a
importA -< remoteCSN context f csn
\end{code}
\subsection{Affine Transformation in State Monads and State Arrows}
\begin{code}
class NestedCoordinateSystemTransformer a where
transformCoordinateSystem :: a -> CoordinateSystem -> CoordinateSystem
instance NestedCoordinateSystemTransformer Affine where
transformCoordinateSystem (Affine f) = postmultiplyTransformation f
instance NestedCoordinateSystemTransformer CoordinateSystem where
transformCoordinateSystem cs = const cs
transformM :: (Monad m,MonadState s m,CoordinateSystemClass s,
NestedCoordinateSystemTransformer cst) => cst -> m a -> m a
transformM ncst action =
do s <- liftM getCoordinateSystem get
modify (storeCoordinateSystem (transformCoordinateSystem ncst s))
a <- action
modify (storeCoordinateSystem s)
return a
transformA :: (Arrow arr,ArrowState s arr,CoordinateSystemClass s,
NestedCoordinateSystemTransformer cst) => arr a b -> arr (cst,a) b
transformA action = proc (ncst,a) ->
do s <- fetch -< ()
store -< storeCoordinateSystem (transformCoordinateSystem ncst $ getCoordinateSystem s) s
b <- action -< a
s' <- fetch -< ()
store -< storeCoordinateSystem (getCoordinateSystem s) s'
returnA -< b
\end{code}
\subsection{Coordinate System Neutral Distance}
Since we can't make scalar values \texttt{AffineTransformable}, but it is useful to measure distances in a space that is subject to affine transformations,
we define distance in terms of the elements being measured.
\begin{code}
data Distance = forall p. (AffineTransformable p,Xyz p) => Distance p p
measure :: (AffineTransformable p,Xyz p) => p -> p -> Distance
measure = Distance
distance :: Distance -> Double
distance (Distance p1 p2) = distanceBetween p1 p2
distanceSquared :: Distance -> Double
distanceSquared (Distance p1 p2) = distanceBetweenSquared p1 p2
instance AffineTransformable Distance where
transform m (Distance p1 p2) = Distance (transform m p1) (transform m p2)
scale v (Distance p1 p2) = Distance (scale v p1) (scale v p2)
rotate a v (Distance p1 p2) = Distance (rotate a v p1) (rotate a v p2)
translate v (Distance p1 p2) = Distance (translate v p1) (translate v p2)
\end{code}