\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}

{-# LANGUAGE Arrows, ExistentialQuantification, Rank2Types #-}

module RSAGL.Scene.CoordinateSystems
    (AffineTransformation,
     affine_identity,
     CoordinateSystem,
     Affine(..),
     affineOf,
     CoordinateSystemClass(..),
     NestedCoordinateSystemTransformer,
     root_coordinate_system,
     migrateToFrom,
     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.Math.Matrix
import RSAGL.Math.Affine
import RSAGL.Math.Vector
import RSAGL.Math.Types
\end{code}

\subsection{Coordinate Systems}

A \texttt{CoordinateSystem} is the context by which coordinate system neutral data can be imported or exported.

\texttt{migrateToFrom} 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

{-# RULES
"RSAGL:migrateToFrom/fromRoot"     forall x. migrateToFrom x root_coordinate_system = importFromRoot x
"RSAGL:migrateToFrom/toRoot"       forall x. migrateToFrom root_coordinate_system x = exportToRoot x
  #-}
migrateToFrom :: (AffineTransformable a) => CoordinateSystem -> CoordinateSystem -> a -> a
migrateToFrom (CoordinateSystem to) (CoordinateSystem from) = transform (to `matrixMultiply` (matrixInverse from))

importFromRoot :: (AffineTransformable a) => CoordinateSystem -> a -> a
importFromRoot (CoordinateSystem to) = transform to

exportToRoot :: (AffineTransformable a) => CoordinateSystem -> a -> a
exportToRoot (CoordinateSystem from) = inverseTransform 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 identity_matrix
\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) identity_matrix

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 non-affine transformations over coordinate system neutral data.  Since any such function
is potentially non-affine, 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 -> RSdouble
distance (Distance p1 p2) = distanceBetween p1 p2

distanceSquared :: Distance -> RSdouble
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}