\section{Curves}
A curve is a onedimensional figure in an arbitrary space. The Curve typeclass allows an arbitrary curve to be sampled so that
it can be rendered iteratively in OpenGL. The Differentiable typeclass allows a Curve to be transformed into its derivative.
\begin{code}
module RSAGL.Curve
(Curve,
zipCurve,
iterateCurve,
transposeCurve,
curve,
Surface,
surface,
wrapSurface,
unwrapSurface,
pretransformCurve,
pretransformCurve2,
transposeSurface,
zipSurface,
iterateSurface,
halfIterateSurface,
pretransformSurface,
flipTransposeSurface,
uv_identity,
surfaceDerivative,
curveDerivative,
surfaceNormals3D)
where
import Control.Arrow hiding (pure)
import RSAGL.Vector
import RSAGL.Auxiliary
import RSAGL.Affine
import Data.List
import Control.Parallel.Strategies
import Control.Applicative
import RSAGL.AbstractVector
\end{code}
\subsection{The Curve}
A \texttt{Curve} is either a simple parametric curve, or a derivative of a parametric curve. To approximate the derivative of a curve, we require a subtraction function that yields the derivative's type and a scalar multiplication function that operates on the base type.
We also allow two curves to be zipped together.
We can take the derivative of a curve an arbitrary number of times, but this will run up against the precision of the underlying data types, including Double.
\begin{code}
type CurveF a = (Double,Double) -> a
type SurfaceF a = CurveF (CurveF a)
newtype Curve a = Curve { fromCurve :: CurveF a }
instance Functor Curve where
fmap g (Curve f) = Curve $ g . f
instance Applicative Curve where
pure a = Curve $ const a
f <*> a = zipCurve ($) f a
instance (AffineTransformable a) => AffineTransformable (Curve a) where
scale v = fmap (scale v)
translate v = fmap (translate v)
rotate vector angle = fmap (rotate vector angle)
transform m = fmap (transform m)
instance NFData (Curve a) where
rnf (Curve f) = seq f ()
sampleCurve :: Curve a -> Double -> Double -> a
sampleCurve (Curve f) = curry f
iterateCurve :: Integer -> Curve x -> [x]
iterateCurve n c = map f $ zeroToOne n
where f = sampleCurve c (0.25/fromInteger n)
zipCurve :: (x -> y -> z) -> Curve x -> Curve y -> Curve z
zipCurve f (Curve x) (Curve y) = Curve $ \hu -> f (x hu) (y hu)
mapCurve :: (CurveF a -> CurveF a) -> Curve a -> Curve a
mapCurve f = Curve . f . fromCurve
mapCurve2 :: (SurfaceF a -> SurfaceF a) -> Curve (Curve a) -> Curve (Curve a)
mapCurve2 f = Curve . (Curve .) . f . (fromCurve .) . fromCurve
pretransformCurve :: (Double -> Double) -> Curve a -> Curve a
pretransformCurve g = mapCurve (\f (h,u) -> f (h,g u))
pretransformCurve2 :: (Double -> Double) -> (Double -> Double) -> Curve (Curve a) -> Curve (Curve a)
pretransformCurve2 fx fy = mapCurve2 $ (\f x y -> f (second fx x) (second fy y))
transposeCurve :: Curve (Curve a) -> Curve (Curve a)
transposeCurve = mapCurve2 flip
curve :: (Double -> a) -> Curve a
curve = Curve . uncurry . const
\end{code}
\subsection{Surfaces}
\begin{code}
newtype Surface a = Surface (Curve (Curve a)) deriving (NFData,AffineTransformable)
surface :: (Double -> Double -> a) -> Surface a
surface f = Surface $ curve (\x -> curve $ flip f x)
wrapSurface :: Curve (Curve a) -> Surface a
wrapSurface = Surface
unwrapSurface :: Surface a -> Curve (Curve a)
unwrapSurface (Surface s) = s
transposeSurface :: Surface a -> Surface a
transposeSurface (Surface s) = Surface $ transposeCurve s
iterateSurface :: (Integer,Integer) -> Surface a -> [[a]]
iterateSurface (u,v) (Surface s) = map (iterateCurve u) $ iterateCurve v s
halfIterateSurface :: Integer -> Surface a -> [Curve a]
halfIterateSurface u = iterateCurve u . unwrapSurface
instance Functor Surface where
fmap f (Surface x) = Surface $ fmap (fmap f) x
instance Applicative Surface where
pure a = surface (const $ const a)
f <*> a = zipSurface ($) f a
zipSurface :: (x -> y -> z) -> Surface x -> Surface y -> Surface z
zipSurface f (Surface x) (Surface y) = Surface $ zipCurve (zipCurve f) x y
pretransformSurface :: (Double -> Double) -> (Double -> Double) -> Surface a -> Surface a
pretransformSurface fx fy = Surface . pretransformCurve2 fx fy . unwrapSurface
flipTransposeSurface :: Surface a -> Surface a
flipTransposeSurface = pretransformSurface id (1) . transposeSurface
uv_identity :: Surface (Double,Double)
uv_identity = surface (curry id)
\end{code}
\subsection{Taking the Derivative of a Curve}
\begin{code}
curveDerivative :: (AbstractSubtract p v,AbstractScale v) => Curve p -> Curve v
curveDerivative (Curve f) = Curve $ \(h,u) -> scalarMultiply (recip $ 2 * h) $ f (h/2,u+h) `sub` f (h/2,uh)
surfaceDerivative :: (AbstractSubtract p v,AbstractScale v) => Surface p -> Surface (v,v)
surfaceDerivative s = zipSurface (,) (curvewiseDerivative s) (transposeSurface $ curvewiseDerivative $ transposeSurface s)
where curvewiseDerivative (Surface t) = Surface $ fmap curveDerivative t
surfaceNormals3D :: Surface Point3D -> Surface SurfaceVertex3D
surfaceNormals3D s = SurfaceVertex3D <$> s <*> fmap (vectorNormalize . uncurry crossProduct) (surfaceDerivative s)
\end{code}