rsagl 0.4.0.3 → 0.6.0.0
raw patch · 70 files changed
+1813/−3952 lines, 70 filesdep +OpenGLRawdep +Vec-OpenGLRawdep +rsagl-frpdep −GLUTdep ~OpenGLPVP ok
version bump matches the API change (PVP)
Dependencies added: OpenGLRaw, Vec-OpenGLRaw, rsagl-frp, rsagl-math
Dependencies removed: GLUT
Dependency ranges changed: OpenGL
API changes (from Hackage documentation)
- RSAGL.Animation.AnimationExtras: accelerationModel :: (CoordinateSystemClass s, StateOf m ~ s) => Frequency -> PV -> FRP e m j ForceFunction -> FRP e m (PVA, j) p -> FRP e m j p
- RSAGL.Animation.InverseKinematics: instance (CoordinateSystemClass s, StateOf m ~ s) => AffineTransformable (Leg e m)
- RSAGL.Auxiliary.RecombinantState: class RecombinantState s where type family SubState s :: *
- RSAGL.Auxiliary.RecombinantState: clone :: RecombinantState s => s -> SubState s
- RSAGL.Auxiliary.RecombinantState: instance RecombinantState ()
- RSAGL.Auxiliary.RecombinantState: recombine :: RecombinantState s => s -> SubState s -> s
- RSAGL.FRP.Accumulation: Discrete :: EdgeDetectionMode
- RSAGL.FRP.Accumulation: Fuzzy :: EdgeDetectionMode
- RSAGL.FRP.Accumulation: HashedDiscrete :: EdgeDetectionMode
- RSAGL.FRP.Accumulation: accumulateNumerical :: Frequency -> (i -> o -> Time -> Time -> Integer -> o) -> o -> FRP e m i o
- RSAGL.FRP.Accumulation: changed :: (x -> x -> Bool) -> FRP e m x Bool
- RSAGL.FRP.Accumulation: clingy :: EdgeDetectionMode -> (j -> j -> Bool) -> (j -> p) -> FRP e m j p
- RSAGL.FRP.Accumulation: data EdgeDetectionMode
- RSAGL.FRP.Accumulation: delay :: x -> FRP e m x x
- RSAGL.FRP.Accumulation: derivative :: (AbstractVector v, AbstractSubtract p v) => FRP e m p (Rate v)
- RSAGL.FRP.Accumulation: edge :: EdgeDetectionMode -> (x -> x -> Bool) -> FRP e m x Bool
- RSAGL.FRP.Accumulation: initial :: FRP e m x x
- RSAGL.FRP.Accumulation: integral :: (AbstractVector v, AbstractAdd p v) => p -> FRP e m (Rate v) p
- RSAGL.FRP.Accumulation: integralRK4 :: AbstractVector v => Frequency -> (p -> v -> p) -> p -> FRP e m (Time -> p -> Rate v) p
- RSAGL.FRP.Accumulation: integralRK4' :: AbstractVector v => Frequency -> (p -> v -> p) -> (p, Rate v) -> FRP e m (Time -> p -> Rate v -> Acceleration v) (p, Rate v)
- RSAGL.FRP.Accumulation: sticky :: (x -> Bool) -> x -> FRP e m x x
- RSAGL.FRP.Accumulation: summation :: AbstractAdd p v => p -> FRP e m v p
- RSAGL.FRP.Accumulation: threadTime :: FRP e m () Time
- RSAGL.FRP.FRP: absoluteTime :: FRP e m () Time
- RSAGL.FRP.FRP: accumulate :: p -> (j -> p -> p) -> FRP e m j p
- RSAGL.FRP.FRP: allowAnonymous :: ThreadIdentityRule t -> ThreadIdentityRule (Maybe t)
- RSAGL.FRP.FRP: data FRP e m j p
- RSAGL.FRP.FRP: deltaTime :: FRP e m () Time
- RSAGL.FRP.FRP: forbidDuplicates :: Eq t => ThreadIdentityRule t
- RSAGL.FRP.FRP: frp1Context :: FRPModel m => FRP e (FRP1Context j p m) j p -> FRP e m j p
- RSAGL.FRP.FRP: frpContext :: (RecombinantState s, s ~ StateOf m, FRPModel m, Eq t) => ThreadIdentityRule t -> [(t, FRP e (FRPContext t j p m) j p)] -> FRP e m j [(t, p)]
- RSAGL.FRP.FRP: frpTest :: (forall e. [FRP e (FRPX () () i o) i o]) -> [i] -> IO [[o]]
- RSAGL.FRP.FRP: instance Applicative (FRP e m j)
- RSAGL.FRP.FRP: instance Arrow (FRP e m)
- RSAGL.FRP.FRP: instance Category (FRP e m)
- RSAGL.FRP.FRP: instance Functor (FRP e m j)
- RSAGL.FRP.FRP: instance StateOf m ~ s => ArrowState s (FRP e m)
- RSAGL.FRP.FRP: ioAction :: (j -> IO p) -> FRP e m j p
- RSAGL.FRP.FRP: killThreadIf :: ThreadingOf m ~ Enabled => FRP e m Bool ()
- RSAGL.FRP.FRP: newFRP1Program :: (forall e. FRP e (FRP1 s i o) i o) -> IO (FRPProgram s i o)
- RSAGL.FRP.FRP: newFRPProgram :: (RecombinantState s, Eq t) => ThreadIdentityRule t -> (forall e. [(t, FRP e (FRPX t s i o) i o)]) -> IO (FRPProgram s i [(t, o)])
- RSAGL.FRP.FRP: nullaryThreadIdentity :: ThreadIdentityRule a
- RSAGL.FRP.FRP: spawnThreads :: ThreadingOf m ~ Enabled => FRP e m [(ThreadIDOf m, FRP e m (SwitchInputOf m) (SwitchOutputOf m))] ()
- RSAGL.FRP.FRP: switchContinue :: FRP e m (Maybe (FRP e m (SwitchInputOf m) (SwitchOutputOf m)), SwitchInputOf m) (SwitchInputOf m)
- RSAGL.FRP.FRP: switchTerminate :: FRP e m (Maybe (FRP e m (SwitchInputOf m) (SwitchOutputOf m)), SwitchOutputOf m) (SwitchOutputOf m)
- RSAGL.FRP.FRP: threadIdentity :: FRP e m () (ThreadIDOf m)
- RSAGL.FRP.FRP: type FRPProgram s i o = FRPInit s () i o
- RSAGL.FRP.FRP: type ThreadIdentityRule t = (t -> Bool) -> t -> Bool
- RSAGL.FRP.FRP: updateFRPProgram :: Maybe Time -> (i, s) -> FRPProgram s i o -> IO (o, s)
- RSAGL.FRP.FRP: whenJust :: FRPModel m => (forall x y. FRP e (FRP1Context x y m) j p) -> FRP e m (Maybe j) (Maybe p)
- RSAGL.FRP.FRP: withThreadIdentity :: (ThreadIDOf m -> FRP e m j p) -> FRP e m j p
- RSAGL.FRP.FRPModel: class RSAGL_FRP_FRPMODEL a => Capability a
- RSAGL.FRP.FRPModel: class (RSAGL_FRP_FRPMODEL frp, Eq (ThreadIDOf frp)) => FRPModel frp where type family ThreadingOf frp :: * type family ThreadIDOf frp :: * type family StateOf frp :: * type family SwitchInputOf frp :: * type family SwitchOutputOf frp :: * type family Unwrap frp :: *
- RSAGL.FRP.FRPModel: data Disabled
- RSAGL.FRP.FRPModel: data Enabled
- RSAGL.FRP.FRPModel: data Switch k t s i o m
- RSAGL.FRP.FRPModel: instance (RSAGL_FRP_FRPMODEL m, Capability k) => RSAGL_FRP_FRPMODEL (Switch k t s i o m)
- RSAGL.FRP.FRPModel: instance (RSAGL_FRP_FRPMODEL m, Eq t, Capability k) => FRPModel (Switch k t s i o m)
- RSAGL.FRP.FRPModel: instance Capability Disabled
- RSAGL.FRP.FRPModel: instance Capability Enabled
- RSAGL.FRP.FRPModel: instance FRPModel ()
- RSAGL.FRP.FRPModel: instance RSAGL_FRP_FRPMODEL ()
- RSAGL.FRP.FRPModel: instance RSAGL_FRP_FRPMODEL Disabled
- RSAGL.FRP.FRPModel: instance RSAGL_FRP_FRPMODEL Enabled
- RSAGL.FRP.FRPModel: type FRP1 s i o = Switch Disabled () s i o ()
- RSAGL.FRP.FRPModel: type FRP1Context i o m = Switch Disabled (ThreadIDOf m) (StateOf m) i o m
- RSAGL.FRP.FRPModel: type FRPContext t i o m = Switch Enabled t (SubState (StateOf m)) i o m
- RSAGL.FRP.FRPModel: type FRPX t s i o = FRPContext t i o (FRP1 s i [(t, o)])
- RSAGL.FRP.FRPModel: type SimpleSwitch k t s i o m = Switch k t s i o m
- RSAGL.FRP.FactoryArrow: FactoryArrow :: m (Kleisli n i o) -> FactoryArrow m n i o
- RSAGL.FRP.FactoryArrow: instance (Monad m, Monad n) => Arrow (FactoryArrow m n)
- RSAGL.FRP.FactoryArrow: instance (Monad m, Monad n) => ArrowChoice (FactoryArrow m n)
- RSAGL.FRP.FactoryArrow: instance (Monad m, Monad n) => Category (FactoryArrow m n)
- RSAGL.FRP.FactoryArrow: instance (Monad m, MonadFix n) => ArrowLoop (FactoryArrow m n)
- RSAGL.FRP.FactoryArrow: instance (Monad m, MonadPlus n) => ArrowPlus (FactoryArrow m n)
- RSAGL.FRP.FactoryArrow: instance (Monad m, MonadPlus n) => ArrowZero (FactoryArrow m n)
- RSAGL.FRP.FactoryArrow: instance Monad m => ArrowApply (FactoryArrow m m)
- RSAGL.FRP.FactoryArrow: newtype FactoryArrow m n i o
- RSAGL.FRP.FactoryArrow: runFactory :: FactoryArrow m n i o -> m (Kleisli n i o)
- RSAGL.FRP.Time: cyclical :: Time -> Time -> Time
- RSAGL.FRP.Time: cyclical' :: Time -> Time -> RSdouble
- RSAGL.FRP.Time: data Rate a
- RSAGL.FRP.Time: data Time
- RSAGL.FRP.Time: day :: Time
- RSAGL.FRP.Time: fps120 :: Frequency
- RSAGL.FRP.Time: fps30 :: Frequency
- RSAGL.FRP.Time: fps60 :: Frequency
- RSAGL.FRP.Time: fromSeconds :: RSdouble -> Time
- RSAGL.FRP.Time: getTime :: IO Time
- RSAGL.FRP.Time: instance AbstractAdd Time Time
- RSAGL.FRP.Time: instance AbstractAdd a a => AbstractAdd (Rate a) (Rate a)
- RSAGL.FRP.Time: instance AbstractScale Time
- RSAGL.FRP.Time: instance AbstractScale a => AbstractScale (Rate a)
- RSAGL.FRP.Time: instance AbstractSubtract Time Time
- RSAGL.FRP.Time: instance AbstractSubtract a a => AbstractSubtract (Rate a) (Rate a)
- RSAGL.FRP.Time: instance AbstractVector Time
- RSAGL.FRP.Time: instance AbstractVector a => AbstractVector (Rate a)
- RSAGL.FRP.Time: instance AbstractZero Time
- RSAGL.FRP.Time: instance AbstractZero a => AbstractZero (Rate a)
- RSAGL.FRP.Time: instance AffineTransformable a => AffineTransformable (Rate a)
- RSAGL.FRP.Time: instance Eq Time
- RSAGL.FRP.Time: instance Eq a => Eq (Rate a)
- RSAGL.FRP.Time: instance Ord Time
- RSAGL.FRP.Time: instance Ord a => Ord (Rate a)
- RSAGL.FRP.Time: instance Show Time
- RSAGL.FRP.Time: instance Show a => Show (Rate a)
- RSAGL.FRP.Time: interval :: Frequency -> Time
- RSAGL.FRP.Time: minute :: Time
- RSAGL.FRP.Time: month :: Time
- RSAGL.FRP.Time: over :: AbstractVector a => Rate a -> Time -> a
- RSAGL.FRP.Time: per :: AbstractVector a => a -> Time -> Rate a
- RSAGL.FRP.Time: perSecond :: a -> Rate a
- RSAGL.FRP.Time: rate :: AbstractVector a => (a, Time) -> (a, Time) -> Rate a
- RSAGL.FRP.Time: time :: RSdouble -> Rate RSdouble -> Time
- RSAGL.FRP.Time: toSeconds :: Time -> RSdouble
- RSAGL.FRP.Time: type Acceleration a = Rate (Rate a)
- RSAGL.FRP.Time: type Frequency = Rate RSdouble
- RSAGL.FRP.Time: withTime :: (AbstractVector a, AbstractVector b) => Time -> (a -> b) -> Rate a -> Rate b
- RSAGL.FRP.Time: year :: Time
- RSAGL.Math.AbstractVector: abstractAverage :: (AbstractAdd p v, AbstractSubtract p v, AbstractVector v, AbstractZero p) => [p] -> p
- RSAGL.Math.AbstractVector: abstractDistance :: (AbstractMagnitude v, AbstractSubtract p v) => p -> p -> RSdouble
- RSAGL.Math.AbstractVector: abstractScaleTo :: (AbstractScale v, AbstractMagnitude v) => RSdouble -> v -> v
- RSAGL.Math.AbstractVector: abstractSum :: (AbstractAdd p v, AbstractZero p) => [v] -> p
- RSAGL.Math.AbstractVector: add :: AbstractAdd p v => p -> v -> p
- RSAGL.Math.AbstractVector: class AbstractAdd p v | p -> v
- RSAGL.Math.AbstractVector: class AbstractMagnitude v
- RSAGL.Math.AbstractVector: class AbstractScale v
- RSAGL.Math.AbstractVector: class AbstractSubtract p v | p -> v
- RSAGL.Math.AbstractVector: class (AbstractZero v, AbstractAdd v v, AbstractSubtract v v, AbstractScale v) => AbstractVector v
- RSAGL.Math.AbstractVector: class AbstractZero a
- RSAGL.Math.AbstractVector: instance (AbstractAdd a a', AbstractAdd b b') => AbstractAdd (a, b) (a', b')
- RSAGL.Math.AbstractVector: instance (AbstractMagnitude a, AbstractMagnitude b) => AbstractMagnitude (a, b)
- RSAGL.Math.AbstractVector: instance (AbstractScale a, AbstractScale b) => AbstractScale (a, b)
- RSAGL.Math.AbstractVector: instance (AbstractSubtract a a', AbstractSubtract b b') => AbstractSubtract (a, b) (a', b')
- RSAGL.Math.AbstractVector: instance (AbstractVector a, AbstractVector b) => AbstractVector (a, b)
- RSAGL.Math.AbstractVector: instance (AbstractZero a, AbstractZero b) => AbstractZero (a, b)
- RSAGL.Math.AbstractVector: instance (Applicative f, AbstractAdd p v) => AbstractAdd (ApplicativeWrapper f p) (ApplicativeWrapper f v)
- RSAGL.Math.AbstractVector: instance (Applicative f, AbstractScale v) => AbstractScale (ApplicativeWrapper f v)
- RSAGL.Math.AbstractVector: instance (Applicative f, AbstractSubtract p v) => AbstractSubtract (ApplicativeWrapper f p) (ApplicativeWrapper f v)
- RSAGL.Math.AbstractVector: instance (Applicative f, AbstractVector v) => AbstractVector (ApplicativeWrapper f v)
- RSAGL.Math.AbstractVector: instance (Applicative f, AbstractZero p) => AbstractZero (ApplicativeWrapper f p)
- RSAGL.Math.AbstractVector: instance AbstractAdd Double Double
- RSAGL.Math.AbstractVector: instance AbstractAdd Float Float
- RSAGL.Math.AbstractVector: instance AbstractAdd Integer Integer
- RSAGL.Math.AbstractVector: instance AbstractAdd RSdouble RSdouble
- RSAGL.Math.AbstractVector: instance AbstractAdd RSfloat RSfloat
- RSAGL.Math.AbstractVector: instance AbstractMagnitude Double
- RSAGL.Math.AbstractVector: instance AbstractMagnitude Float
- RSAGL.Math.AbstractVector: instance AbstractMagnitude Integer
- RSAGL.Math.AbstractVector: instance AbstractMagnitude RSdouble
- RSAGL.Math.AbstractVector: instance AbstractMagnitude RSfloat
- RSAGL.Math.AbstractVector: instance AbstractScale Double
- RSAGL.Math.AbstractVector: instance AbstractScale Float
- RSAGL.Math.AbstractVector: instance AbstractScale RSdouble
- RSAGL.Math.AbstractVector: instance AbstractScale RSfloat
- RSAGL.Math.AbstractVector: instance AbstractScale a => AbstractScale [a]
- RSAGL.Math.AbstractVector: instance AbstractSubtract Double Double
- RSAGL.Math.AbstractVector: instance AbstractSubtract Float Float
- RSAGL.Math.AbstractVector: instance AbstractSubtract Integer Integer
- RSAGL.Math.AbstractVector: instance AbstractSubtract RSdouble RSdouble
- RSAGL.Math.AbstractVector: instance AbstractSubtract RSfloat RSfloat
- RSAGL.Math.AbstractVector: instance AbstractVector Double
- RSAGL.Math.AbstractVector: instance AbstractVector Float
- RSAGL.Math.AbstractVector: instance AbstractVector RSdouble
- RSAGL.Math.AbstractVector: instance AbstractVector RSfloat
- RSAGL.Math.AbstractVector: instance AbstractZero Double
- RSAGL.Math.AbstractVector: instance AbstractZero Float
- RSAGL.Math.AbstractVector: instance AbstractZero Integer
- RSAGL.Math.AbstractVector: instance AbstractZero RSdouble
- RSAGL.Math.AbstractVector: instance AbstractZero RSfloat
- RSAGL.Math.AbstractVector: instance HasResolution a => AbstractAdd (Fixed a) (Fixed a)
- RSAGL.Math.AbstractVector: instance HasResolution a => AbstractMagnitude (Fixed a)
- RSAGL.Math.AbstractVector: instance HasResolution a => AbstractScale (Fixed a)
- RSAGL.Math.AbstractVector: instance HasResolution a => AbstractSubtract (Fixed a) (Fixed a)
- RSAGL.Math.AbstractVector: instance HasResolution a => AbstractVector (Fixed a)
- RSAGL.Math.AbstractVector: instance HasResolution a => AbstractZero (Fixed a)
- RSAGL.Math.AbstractVector: magnitude :: AbstractMagnitude v => v -> RSdouble
- RSAGL.Math.AbstractVector: scalarMultiply :: AbstractScale v => RSdouble -> v -> v
- RSAGL.Math.AbstractVector: sub :: AbstractSubtract p v => p -> p -> v
- RSAGL.Math.AbstractVector: zero :: AbstractZero a => a
- RSAGL.Math.Affine: class AffineTransformable a where scale vector = transform $ scaleMatrix vector translate vector = transform $ translationMatrix vector rotate vector angle = transform $ rotationMatrix vector angle rotateX = rotate (Vector3D 1 0 0) rotateY = rotate (Vector3D 0 1 0) rotateZ = rotate (Vector3D 0 0 1)
- RSAGL.Math.Affine: instance (AffineTransformable a, AffineTransformable b) => AffineTransformable (a, b)
- RSAGL.Math.Affine: instance (AffineTransformable a, AffineTransformable b, AffineTransformable c) => AffineTransformable (a, b, c)
- RSAGL.Math.Affine: instance AffineTransformable (IO a)
- RSAGL.Math.Affine: instance AffineTransformable Matrix
- RSAGL.Math.Affine: instance AffineTransformable Point3D
- RSAGL.Math.Affine: instance AffineTransformable SurfaceVertex3D
- RSAGL.Math.Affine: instance AffineTransformable Vector3D
- RSAGL.Math.Affine: instance AffineTransformable a => AffineTransformable (Maybe a)
- RSAGL.Math.Affine: instance AffineTransformable a => AffineTransformable [a]
- RSAGL.Math.Affine: inverseTransform :: AffineTransformable a => Matrix -> a -> a
- RSAGL.Math.Affine: rotate :: AffineTransformable a => Vector3D -> Angle -> a -> a
- RSAGL.Math.Affine: rotateToFrom :: AffineTransformable a => Vector3D -> Vector3D -> a -> a
- RSAGL.Math.Affine: rotateX :: AffineTransformable a => Angle -> a -> a
- RSAGL.Math.Affine: rotateY :: AffineTransformable a => Angle -> a -> a
- RSAGL.Math.Affine: rotateZ :: AffineTransformable a => Angle -> a -> a
- RSAGL.Math.Affine: scale :: AffineTransformable a => Vector3D -> a -> a
- RSAGL.Math.Affine: scale' :: AffineTransformable a => RSdouble -> a -> a
- RSAGL.Math.Affine: scaleAlong :: AffineTransformable a => Vector3D -> RSdouble -> a -> a
- RSAGL.Math.Affine: transform :: AffineTransformable a => Matrix -> a -> a
- RSAGL.Math.Affine: transformAbout :: AffineTransformable a => Point3D -> (a -> a) -> a -> a
- RSAGL.Math.Affine: translate :: AffineTransformable a => Vector3D -> a -> a
- RSAGL.Math.Affine: translateToFrom :: AffineTransformable a => Point3D -> Point3D -> a -> a
- RSAGL.Math.Affine: withTransformation :: AffineTransformable a => Matrix -> (a -> a) -> a -> a
- RSAGL.Math.Angle: BoundAngle :: Angle -> BoundAngle
- RSAGL.Math.Angle: absoluteAngle :: Angle -> Angle
- RSAGL.Math.Angle: angleAdd :: Angle -> Angle -> Angle
- RSAGL.Math.Angle: angleNegate :: Angle -> Angle
- RSAGL.Math.Angle: angleSubtract :: Angle -> Angle -> Angle
- RSAGL.Math.Angle: angularIncrements :: Integer -> [Angle]
- RSAGL.Math.Angle: arcCosine :: RSdouble -> Angle
- RSAGL.Math.Angle: arcSine :: RSdouble -> Angle
- RSAGL.Math.Angle: arcTangent :: RSdouble -> Angle
- RSAGL.Math.Angle: cartesianToPolar :: (RSdouble, RSdouble) -> (Angle, RSdouble)
- RSAGL.Math.Angle: cosine :: Angle -> RSdouble
- RSAGL.Math.Angle: data Angle
- RSAGL.Math.Angle: fromArcMinutes :: RSdouble -> Angle
- RSAGL.Math.Angle: fromArcSeconds :: RSdouble -> Angle
- RSAGL.Math.Angle: fromDegrees :: RSdouble -> Angle
- RSAGL.Math.Angle: fromRadians :: RSdouble -> Angle
- RSAGL.Math.Angle: fromRotations :: RSdouble -> Angle
- RSAGL.Math.Angle: fromTimeOfDayHMS :: RSdouble -> RSdouble -> RSdouble -> Angle
- RSAGL.Math.Angle: instance AbstractAdd Angle Angle
- RSAGL.Math.Angle: instance AbstractAdd BoundAngle Angle
- RSAGL.Math.Angle: instance AbstractMagnitude Angle
- RSAGL.Math.Angle: instance AbstractScale Angle
- RSAGL.Math.Angle: instance AbstractSubtract Angle Angle
- RSAGL.Math.Angle: instance AbstractSubtract BoundAngle Angle
- RSAGL.Math.Angle: instance AbstractVector Angle
- RSAGL.Math.Angle: instance AbstractZero Angle
- RSAGL.Math.Angle: instance AbstractZero BoundAngle
- RSAGL.Math.Angle: instance Eq Angle
- RSAGL.Math.Angle: instance Ord Angle
- RSAGL.Math.Angle: instance Show Angle
- RSAGL.Math.Angle: instance Show BoundAngle
- RSAGL.Math.Angle: newtype BoundAngle
- RSAGL.Math.Angle: polarToCartesian :: (Angle, RSdouble) -> (RSdouble, RSdouble)
- RSAGL.Math.Angle: scaleAngle :: RSdouble -> Angle -> Angle
- RSAGL.Math.Angle: sine :: Angle -> RSdouble
- RSAGL.Math.Angle: supplementaryAngle :: Angle -> Angle
- RSAGL.Math.Angle: tangent :: Angle -> RSdouble
- RSAGL.Math.Angle: toDegrees :: Angle -> RSdouble
- RSAGL.Math.Angle: toDegrees_ :: Angle -> RSdouble
- RSAGL.Math.Angle: toRadians :: Angle -> RSdouble
- RSAGL.Math.Angle: toRadians_ :: Angle -> RSdouble
- RSAGL.Math.Angle: toRotations :: Angle -> RSdouble
- RSAGL.Math.Angle: toRotations_ :: Angle -> RSdouble
- RSAGL.Math.Angle: unboundAngle :: BoundAngle -> Angle
- RSAGL.Math.Angle: zero_angle :: Angle
- RSAGL.Math.Curve: adaptiveMagnitudeSamples :: AbstractMagnitude a => Integer -> SamplingAlgorithm a
- RSAGL.Math.Curve: clampCurve :: (RSdouble, RSdouble) -> Curve a -> Curve a
- RSAGL.Math.Curve: controlCurve :: (RSdouble, RSdouble) -> (RSdouble, RSdouble) -> Curve a -> Curve a
- RSAGL.Math.Curve: curve :: (RSdouble -> a) -> Curve a
- RSAGL.Math.Curve: curveDerivative :: (AbstractSubtract p v, AbstractScale v) => Curve p -> Curve v
- RSAGL.Math.Curve: data Curve a
- RSAGL.Math.Curve: data IntervalSample a
- RSAGL.Math.Curve: data Surface a
- RSAGL.Math.Curve: flipTransposeSurface :: Surface a -> Surface a
- RSAGL.Math.Curve: halfIterateSurface :: Integer -> Surface a -> [Curve a]
- RSAGL.Math.Curve: instance AffineTransformable a => AffineTransformable (Curve a)
- RSAGL.Math.Curve: instance AffineTransformable a => AffineTransformable (Surface a)
- RSAGL.Math.Curve: instance Applicative Curve
- RSAGL.Math.Curve: instance Applicative Surface
- RSAGL.Math.Curve: instance Functor Curve
- RSAGL.Math.Curve: instance Functor Surface
- RSAGL.Math.Curve: instance NFData (Curve a)
- RSAGL.Math.Curve: instance NFData (Surface a)
- RSAGL.Math.Curve: integrateCurve :: (AbstractAdd p v, AbstractScale v, AbstractZero p) => SamplingAlgorithm v -> Curve v -> p -> p
- RSAGL.Math.Curve: intervalRange :: IntervalSample a -> (RSdouble, RSdouble)
- RSAGL.Math.Curve: intervalSample :: Curve a -> RSdouble -> RSdouble -> IntervalSample a
- RSAGL.Math.Curve: intervalSingleIntegral :: AbstractScale a => IntervalSample a -> a
- RSAGL.Math.Curve: intervalSize :: IntervalSample a -> RSdouble
- RSAGL.Math.Curve: iterateCurve :: Integer -> Curve x -> [x]
- RSAGL.Math.Curve: iterateSurface :: (Integer, Integer) -> Surface a -> [[a]]
- RSAGL.Math.Curve: linearSamples :: Integer -> SamplingAlgorithm a
- RSAGL.Math.Curve: loopCurve :: (RSdouble, RSdouble) -> Curve a -> Curve a
- RSAGL.Math.Curve: newellCurve :: Curve Point3D -> Maybe Vector3D
- RSAGL.Math.Curve: orientationLoops :: Surface p -> Surface (Curve p)
- RSAGL.Math.Curve: scaleCurve :: RSdouble -> Curve a -> Curve a
- RSAGL.Math.Curve: scaleSurface :: (RSdouble, RSdouble) -> Surface a -> Surface a
- RSAGL.Math.Curve: surface :: (RSdouble -> RSdouble -> a) -> Surface a
- RSAGL.Math.Curve: surfaceDerivative :: (AbstractSubtract p v, AbstractScale v) => Surface p -> Surface (v, v)
- RSAGL.Math.Curve: surfaceNormals3D :: Surface Point3D -> Surface SurfaceVertex3D
- RSAGL.Math.Curve: transformCurve2 :: (forall u. Curve u -> Curve u) -> (forall v. Curve v -> Curve v) -> Curve (Curve a) -> Curve (Curve a)
- RSAGL.Math.Curve: transformSurface :: (Curve (Curve a) -> Curve (Curve a)) -> Surface a -> Surface a
- RSAGL.Math.Curve: transformSurface2 :: (forall u. Curve u -> Curve u) -> (forall v. Curve v -> Curve v) -> Surface a -> Surface a
- RSAGL.Math.Curve: translateCurve :: RSdouble -> Curve a -> Curve a
- RSAGL.Math.Curve: translateSurface :: (RSdouble, RSdouble) -> Surface a -> Surface a
- RSAGL.Math.Curve: transposeCurve :: Curve (Curve a) -> Curve (Curve a)
- RSAGL.Math.Curve: transposeSurface :: Surface a -> Surface a
- RSAGL.Math.Curve: type SamplingAlgorithm a = Curve a -> [IntervalSample a]
- RSAGL.Math.Curve: unwrapSurface :: Surface a -> Curve (Curve a)
- RSAGL.Math.Curve: uv_identity :: Surface (RSdouble, RSdouble)
- RSAGL.Math.Curve: wrapSurface :: Curve (Curve a) -> Surface a
- RSAGL.Math.Curve: zipCurve :: (x -> y -> z) -> Curve x -> Curve y -> Curve z
- RSAGL.Math.Curve: zipSurface :: (x -> y -> z) -> Surface x -> Surface y -> Surface z
- RSAGL.Math.CurveExtras: circleXY :: Curve Point3D
- RSAGL.Math.CurveExtras: circularCoordinates :: ((RSdouble, RSdouble) -> a) -> Surface a
- RSAGL.Math.CurveExtras: cylindricalCoordinates :: ((Angle, RSdouble) -> a) -> Surface a
- RSAGL.Math.CurveExtras: linearInterpolation :: (AbstractSubtract p v, AbstractAdd p v, AbstractMagnitude v, AbstractScale v) => [p] -> Curve p
- RSAGL.Math.CurveExtras: loopCurve :: (RSdouble, RSdouble) -> Curve a -> Curve a
- RSAGL.Math.CurveExtras: loopedLinearInterpolation :: (AbstractSubtract p v, AbstractAdd p v, AbstractMagnitude v, AbstractScale v) => [p] -> Curve p
- RSAGL.Math.CurveExtras: polarCoordinates :: ((Angle, RSdouble) -> a) -> Surface a
- RSAGL.Math.CurveExtras: regularPolygon :: Integer -> Curve Point3D
- RSAGL.Math.CurveExtras: smoothCurve :: (AbstractAdd p v, AbstractSubtract p v, AbstractVector v, AbstractZero p) => Integer -> RSdouble -> Curve p -> Curve p
- RSAGL.Math.CurveExtras: sphericalCoordinates :: ((Angle, Angle) -> a) -> Surface a
- RSAGL.Math.CurveExtras: toroidalCoordinates :: ((Angle, Angle) -> a) -> Surface a
- RSAGL.Math.CurveExtras: transformUnitCubeToUnitSphere :: Point3D -> Point3D
- RSAGL.Math.CurveExtras: transformUnitSquareToUnitCircle :: (RSdouble, RSdouble) -> (RSdouble, RSdouble)
- RSAGL.Math.FMod: class FMod f
- RSAGL.Math.FMod: fmod :: FMod f => f -> f -> f
- RSAGL.Math.FMod: instance FMod Double
- RSAGL.Math.FMod: instance FMod Float
- RSAGL.Math.FMod: instance FMod RSdouble
- RSAGL.Math.FMod: instance FMod RSfloat
- RSAGL.Math.Interpolation: lerp :: (AbstractScale v, AbstractSubtract p v, AbstractAdd p v, RealFloat r) => r -> (p, p) -> p
- RSAGL.Math.Interpolation: lerpBetween :: (AbstractScale v, AbstractSubtract p v, AbstractAdd p v, RealFloat r) => (r, r, r) -> (p, p) -> p
- RSAGL.Math.Interpolation: lerpBetweenClamped :: (AbstractScale v, AbstractSubtract p v, AbstractAdd p v, RealFloat r, Ord r) => (r, r, r) -> (p, p) -> p
- RSAGL.Math.Interpolation: lerpBetweenClampedMutated :: (AbstractScale v, AbstractSubtract p v, AbstractAdd p v, RealFloat r, Ord r) => (r -> r) -> (r, r, r) -> (p, p) -> p
- RSAGL.Math.Interpolation: lerpBetweenMutated :: (AbstractScale v, AbstractSubtract p v, AbstractAdd p v, RealFloat r) => (r -> r) -> (r, r, r) -> (p, p) -> p
- RSAGL.Math.Interpolation: lerpClamped :: (AbstractScale v, AbstractSubtract p v, AbstractAdd p v, RealFloat r) => r -> (p, p) -> p
- RSAGL.Math.Interpolation: lerpMap :: (RealFloat r, AbstractScale v, AbstractSubtract p v, AbstractAdd p v) => [(r, p)] -> r -> p
- RSAGL.Math.Interpolation: lerp_mutator_continuous_1st :: RealFloat r => r -> r
- RSAGL.Math.Matrix: colMajorForm :: Matrix -> [[RSdouble]]
- RSAGL.Math.Matrix: data Matrix
- RSAGL.Math.Matrix: determinant :: Matrix -> RSdouble
- RSAGL.Math.Matrix: determinantPrim :: Matrix -> RSdouble
- RSAGL.Math.Matrix: identity_matrix :: Matrix
- RSAGL.Math.Matrix: instance Eq Matrix
- RSAGL.Math.Matrix: instance Show Matrix
- RSAGL.Math.Matrix: matrix :: [[RSdouble]] -> Matrix
- RSAGL.Math.Matrix: matrixAdd :: Matrix -> Matrix -> Matrix
- RSAGL.Math.Matrix: matrixAt :: Matrix -> (Int, Int) -> RSdouble
- RSAGL.Math.Matrix: matrixInverse :: Matrix -> Matrix
- RSAGL.Math.Matrix: matrixInversePrim :: Matrix -> Matrix
- RSAGL.Math.Matrix: matrixInverseTransposePrim :: Matrix -> Matrix
- RSAGL.Math.Matrix: matrixMultiply :: Matrix -> Matrix -> Matrix
- RSAGL.Math.Matrix: matrixTranspose :: Matrix -> Matrix
- RSAGL.Math.Matrix: matrixTransposePrim :: Matrix -> Matrix
- RSAGL.Math.Matrix: rotationMatrix :: Vector3D -> Angle -> Matrix
- RSAGL.Math.Matrix: rowAt :: Matrix -> Int -> [RSdouble]
- RSAGL.Math.Matrix: rowMajorForm :: Matrix -> [[RSdouble]]
- RSAGL.Math.Matrix: scaleMatrix :: Vector3D -> Matrix
- RSAGL.Math.Matrix: transformHomogenous :: RSdouble -> RSdouble -> RSdouble -> RSdouble -> (RSdouble -> RSdouble -> RSdouble -> a) -> Matrix -> a
- RSAGL.Math.Matrix: translationMatrix :: Vector3D -> Matrix
- RSAGL.Math.Matrix: xyzMatrix :: Vector3D -> Vector3D -> Vector3D -> Matrix
- RSAGL.Math.Orthagonal: backward :: a -> FUR a
- RSAGL.Math.Orthagonal: data FUR a
- RSAGL.Math.Orthagonal: down :: a -> FUR a
- RSAGL.Math.Orthagonal: forward :: a -> FUR a
- RSAGL.Math.Orthagonal: instance Functor FUR
- RSAGL.Math.Orthagonal: left :: a -> FUR a
- RSAGL.Math.Orthagonal: modelLookAt :: AffineTransformable a => Point3D -> FUR (Either Point3D Vector3D) -> FUR (Either Point3D Vector3D) -> a -> a
- RSAGL.Math.Orthagonal: orthagonalFrame :: AffineTransformable a => FUR Vector3D -> FUR Vector3D -> a -> a
- RSAGL.Math.Orthagonal: right :: a -> FUR a
- RSAGL.Math.Orthagonal: up :: a -> FUR a
- RSAGL.Math.RK4: integrateRK4 :: AbstractVector v => (p -> v -> p) -> (Time -> p -> Rate v) -> p -> Time -> Time -> Integer -> p
- RSAGL.Math.RK4: integrateRK4' :: AbstractVector v => (p -> v -> p) -> (Time -> p -> Rate v -> Acceleration v) -> (p, Rate v) -> Time -> Time -> Integer -> (p, Rate v)
- RSAGL.Math.RK4: rk4 :: AbstractVector v => (p -> v -> p) -> (Time -> p -> Rate v) -> p -> Time -> Time -> p
- RSAGL.Math.RK4: rk4' :: AbstractVector v => (p -> v -> p) -> (Time -> p -> Rate v -> Acceleration v) -> (p, Rate v) -> Time -> Time -> (p, Rate v)
- RSAGL.Math.Ray: Ray3D :: Point3D -> Vector3D -> Ray3D
- RSAGL.Math.Ray: angleFrom :: Ray3D -> Point3D -> Angle
- RSAGL.Math.Ray: data Ray3D
- RSAGL.Math.Ray: distanceAlong :: Ray3D -> Point3D -> RSdouble
- RSAGL.Math.Ray: instance AffineTransformable Ray3D
- RSAGL.Math.Ray: instance Read Ray3D
- RSAGL.Math.Ray: instance Show Ray3D
- RSAGL.Math.Ray: normalizeRay :: Ray3D -> Ray3D
- RSAGL.Math.Ray: projectRay :: RSdouble -> Ray3D -> Point3D
- RSAGL.Math.Ray: ray_endpoint :: Ray3D -> Point3D
- RSAGL.Math.Ray: ray_vector :: Ray3D -> Vector3D
- RSAGL.Math.Vector: Point3D :: {-# UNPACK #-} !RSdouble -> {-# UNPACK #-} !RSdouble -> {-# UNPACK #-} !RSdouble -> Point3D
- RSAGL.Math.Vector: SurfaceVertex3D :: Point3D -> Vector3D -> SurfaceVertex3D
- RSAGL.Math.Vector: Vector3D :: {-# UNPACK #-} !RSdouble -> {-# UNPACK #-} !RSdouble -> {-# UNPACK #-} !RSdouble -> Vector3D
- RSAGL.Math.Vector: aLargeVector :: RSdouble -> Vector3D -> Maybe Vector3D
- RSAGL.Math.Vector: aNonZeroVector :: Vector3D -> Maybe Vector3D
- RSAGL.Math.Vector: angleBetween :: Vector3D -> Vector3D -> Angle
- RSAGL.Math.Vector: class Xyz a
- RSAGL.Math.Vector: crossProduct :: Vector3D -> Vector3D -> Vector3D
- RSAGL.Math.Vector: data Point3D
- RSAGL.Math.Vector: data SurfaceVertex3D
- RSAGL.Math.Vector: data Vector3D
- RSAGL.Math.Vector: distanceBetween :: Xyz xyz => xyz -> xyz -> RSdouble
- RSAGL.Math.Vector: distanceBetweenSquared :: Xyz xyz => xyz -> xyz -> RSdouble
- RSAGL.Math.Vector: dotProduct :: Vector3D -> Vector3D -> RSdouble
- RSAGL.Math.Vector: fixOrtho :: Vector3D -> Vector3D -> Vector3D
- RSAGL.Math.Vector: fixOrtho2 :: Vector3D -> Vector3D -> (Vector3D, Vector3D)
- RSAGL.Math.Vector: fixOrtho2Left :: Vector3D -> Vector3D -> (Vector3D, Vector3D)
- RSAGL.Math.Vector: fromXYZ :: Xyz a => XYZ -> a
- RSAGL.Math.Vector: instance AbstractAdd Point3D Vector3D
- RSAGL.Math.Vector: instance AbstractAdd Vector3D Vector3D
- RSAGL.Math.Vector: instance AbstractMagnitude Vector3D
- RSAGL.Math.Vector: instance AbstractScale Vector3D
- RSAGL.Math.Vector: instance AbstractSubtract Point3D Vector3D
- RSAGL.Math.Vector: instance AbstractSubtract Vector3D Vector3D
- RSAGL.Math.Vector: instance AbstractVector Vector3D
- RSAGL.Math.Vector: instance AbstractZero Point3D
- RSAGL.Math.Vector: instance AbstractZero Vector3D
- RSAGL.Math.Vector: instance Eq Point3D
- RSAGL.Math.Vector: instance Eq Vector3D
- RSAGL.Math.Vector: instance NFData Point3D
- RSAGL.Math.Vector: instance NFData SurfaceVertex3D
- RSAGL.Math.Vector: instance NFData Vector3D
- RSAGL.Math.Vector: instance Read Point3D
- RSAGL.Math.Vector: instance Read SurfaceVertex3D
- RSAGL.Math.Vector: instance Read Vector3D
- RSAGL.Math.Vector: instance Show Point3D
- RSAGL.Math.Vector: instance Show SurfaceVertex3D
- RSAGL.Math.Vector: instance Show Vector3D
- RSAGL.Math.Vector: instance Xyz (RSdouble, RSdouble, RSdouble)
- RSAGL.Math.Vector: instance Xyz Point3D
- RSAGL.Math.Vector: instance Xyz Vector3D
- RSAGL.Math.Vector: newell :: [Point3D] -> Maybe Vector3D
- RSAGL.Math.Vector: origin_point_3d :: Point3D
- RSAGL.Math.Vector: orthos :: Vector3D -> (Vector3D, Vector3D)
- RSAGL.Math.Vector: point2d :: (RSdouble, RSdouble) -> Point3D
- RSAGL.Math.Vector: point3d :: (RSdouble, RSdouble, RSdouble) -> Point3D
- RSAGL.Math.Vector: points2d :: [(RSdouble, RSdouble)] -> [Point3D]
- RSAGL.Math.Vector: points3d :: [(RSdouble, RSdouble, RSdouble)] -> [Point3D]
- RSAGL.Math.Vector: randomXYZ :: (RandomGen g, Xyz p) => (RSdouble, RSdouble) -> g -> (p, g)
- RSAGL.Math.Vector: sv3d_normal :: SurfaceVertex3D -> Vector3D
- RSAGL.Math.Vector: sv3d_position :: SurfaceVertex3D -> Point3D
- RSAGL.Math.Vector: toXYZ :: Xyz a => a -> XYZ
- RSAGL.Math.Vector: type XYZ = (RSdouble, RSdouble, RSdouble)
- RSAGL.Math.Vector: vector3d :: (RSdouble, RSdouble, RSdouble) -> Vector3D
- RSAGL.Math.Vector: vectorAdd :: Vector3D -> Vector3D -> Vector3D
- RSAGL.Math.Vector: vectorAverage :: [Vector3D] -> Vector3D
- RSAGL.Math.Vector: vectorLength :: Vector3D -> RSdouble
- RSAGL.Math.Vector: vectorLengthSquared :: Vector3D -> RSdouble
- RSAGL.Math.Vector: vectorNormalize :: Vector3D -> Vector3D
- RSAGL.Math.Vector: vectorScale :: RSdouble -> Vector3D -> Vector3D
- RSAGL.Math.Vector: vectorScaleTo :: RSdouble -> Vector3D -> Vector3D
- RSAGL.Math.Vector: vectorString :: Xyz a => a -> String
- RSAGL.Math.Vector: vectorSum :: [Vector3D] -> Vector3D
- RSAGL.Math.Vector: vectorToFrom :: Xyz xyz => xyz -> xyz -> Vector3D
- RSAGL.Math.Vector: zero_vector :: Vector3D
- RSAGL.Math.WrappedAffine: WrappedAffine :: CoordinateSystem -> a -> WrappedAffine a
- RSAGL.Math.WrappedAffine: data WrappedAffine a
- RSAGL.Math.WrappedAffine: instance AffineTransformable (WrappedAffine a)
- RSAGL.Math.WrappedAffine: instance Functor WrappedAffine
- RSAGL.Math.WrappedAffine: unwrapAffine :: AffineTransformable a => WrappedAffine a -> a
- RSAGL.Math.WrappedAffine: wrapAffine :: a -> WrappedAffine a
- RSAGL.Modeling.BoundingBox: boundingBox :: Bound3D a => a -> BoundingBox
- RSAGL.Modeling.BoundingBox: boundingCenterRadius :: BoundingBox -> (Point3D, RSdouble)
- RSAGL.Modeling.BoundingBox: class Bound3D a
- RSAGL.Modeling.BoundingBox: data BoundingBox
- RSAGL.Modeling.BoundingBox: instance AffineTransformable BoundingBox
- RSAGL.Modeling.BoundingBox: instance Bound3D BoundingBox
- RSAGL.Modeling.BoundingBox: instance Bound3D Point3D
- RSAGL.Modeling.BoundingBox: instance Bound3D SurfaceVertex3D
- RSAGL.Modeling.BoundingBox: instance Bound3D a => Bound3D [a]
- RSAGL.Modeling.BoundingBox: instance Show BoundingBox
- RSAGL.Modeling.BoundingBox: minimalDistanceToBoundingBox :: Point3D -> BoundingBox -> RSdouble
- RSAGL.Modeling.Color: RGB :: !RSdouble -> !RSdouble -> !RSdouble -> RGB
- RSAGL.Modeling.Color: RGBA :: !RSdouble -> !RGB -> RGBA
- RSAGL.Modeling.Color: addRGB :: RGB -> RGB -> RGB
- RSAGL.Modeling.Color: alpha :: ColorClass c => RSdouble -> c -> RGBA
- RSAGL.Modeling.Color: alpha256 :: (ColorClass c, Integral i) => i -> c -> RGBA
- RSAGL.Modeling.Color: brightness :: ColorClass c => c -> RSdouble
- RSAGL.Modeling.Color: clampColor :: ColorClass c => c -> c
- RSAGL.Modeling.Color: class AbstractVector c => ColorClass c
- RSAGL.Modeling.Color: colorToOpenGL :: ColorClass c => c -> Color4 GLdouble
- RSAGL.Modeling.Color: data RGB
- RSAGL.Modeling.Color: data RGBA
- RSAGL.Modeling.Color: filterRGB :: RGB -> RGB -> RGB
- RSAGL.Modeling.Color: filterRGBLinear :: RGB -> RGB -> RGB -> RGB
- RSAGL.Modeling.Color: fromRGB :: ColorClass c => RGB -> c
- RSAGL.Modeling.Color: gray :: RSdouble -> RGB
- RSAGL.Modeling.Color: gray256 :: Integral i => i -> RGB
- RSAGL.Modeling.Color: instance AbstractAdd RGB RGB
- RSAGL.Modeling.Color: instance AbstractAdd RGBA RGBA
- RSAGL.Modeling.Color: instance AbstractScale RGB
- RSAGL.Modeling.Color: instance AbstractScale RGBA
- RSAGL.Modeling.Color: instance AbstractSubtract RGB RGB
- RSAGL.Modeling.Color: instance AbstractSubtract RGBA RGBA
- RSAGL.Modeling.Color: instance AbstractVector RGB
- RSAGL.Modeling.Color: instance AbstractVector RGBA
- RSAGL.Modeling.Color: instance AbstractZero RGB
- RSAGL.Modeling.Color: instance AbstractZero RGBA
- RSAGL.Modeling.Color: instance ColorClass RGB
- RSAGL.Modeling.Color: instance ColorClass RGBA
- RSAGL.Modeling.Color: instance Eq RGB
- RSAGL.Modeling.Color: instance Eq RGBA
- RSAGL.Modeling.Color: instance NFData RGB
- RSAGL.Modeling.Color: instance NFData RGBA
- RSAGL.Modeling.Color: instance Show RGB
- RSAGL.Modeling.Color: instance Show RGBA
- RSAGL.Modeling.Color: invertRGB :: RGB -> RGB
- RSAGL.Modeling.Color: mapRGB :: (RSdouble -> RSdouble) -> RGB -> RGB
- RSAGL.Modeling.Color: maxRGB :: RGB -> RSdouble
- RSAGL.Modeling.Color: maximizeRGB :: RGB -> RGB
- RSAGL.Modeling.Color: meanBrightness :: ColorClass c => c -> RSdouble
- RSAGL.Modeling.Color: minRGB :: RGB -> RSdouble
- RSAGL.Modeling.Color: rgb :: ColorClass c => RSdouble -> RSdouble -> RSdouble -> c
- RSAGL.Modeling.Color: rgb256 :: (ColorClass c, Integral i) => i -> i -> i -> c
- RSAGL.Modeling.Color: rgbToOpenGL :: RGB -> Color4 GLdouble
- RSAGL.Modeling.Color: rgb_blue :: RGB -> !RSdouble
- RSAGL.Modeling.Color: rgb_green :: RGB -> !RSdouble
- RSAGL.Modeling.Color: rgb_red :: RGB -> !RSdouble
- RSAGL.Modeling.Color: rgba :: RSdouble -> RSdouble -> RSdouble -> RSdouble -> RGBA
- RSAGL.Modeling.Color: rgba256 :: Integral i => i -> i -> i -> i -> RGBA
- RSAGL.Modeling.Color: rgbaToOpenGL :: RGBA -> Color4 GLdouble
- RSAGL.Modeling.Color: rgba_a :: RGBA -> !RSdouble
- RSAGL.Modeling.Color: rgba_rgb :: RGBA -> !RGB
- RSAGL.Modeling.Color: scaleRGB :: RSdouble -> RGB -> RGB
- RSAGL.Modeling.Color: toPremultipliedRGB :: ColorClass c => c -> RGB
- RSAGL.Modeling.Color: toRGBA :: ColorClass c => c -> RGBA
- RSAGL.Modeling.Color: zipColor :: ColorClass c => (RSdouble -> RSdouble -> RSdouble) -> c -> c -> c
- RSAGL.Modeling.Color: zipRGB :: ColorClass c => (RSdouble -> RSdouble -> RSdouble) -> RGB -> c -> c
- RSAGL.Modeling.Color: zipRGB3 :: (RSdouble -> RSdouble -> RSdouble -> RSdouble) -> RGB -> RGB -> RGB -> RGB
- RSAGL.Modeling.RSAGLColors: amber :: RGB
- RSAGL.Modeling.RSAGLColors: amethyst :: RGB
- RSAGL.Modeling.RSAGLColors: azure :: RGB
- RSAGL.Modeling.RSAGLColors: beige :: RGB
- RSAGL.Modeling.RSAGLColors: black :: RGB
- RSAGL.Modeling.RSAGLColors: blackbody :: RGB
- RSAGL.Modeling.RSAGLColors: blue :: RGB
- RSAGL.Modeling.RSAGLColors: brass :: RGB
- RSAGL.Modeling.RSAGLColors: bronze :: RGB
- RSAGL.Modeling.RSAGLColors: brown :: RGB
- RSAGL.Modeling.RSAGLColors: burgundy :: RGB
- RSAGL.Modeling.RSAGLColors: burnt_sienna :: RGB
- RSAGL.Modeling.RSAGLColors: camouflage_green :: RGB
- RSAGL.Modeling.RSAGLColors: cardinal :: RGB
- RSAGL.Modeling.RSAGLColors: carnation :: RGB
- RSAGL.Modeling.RSAGLColors: carrot :: RGB
- RSAGL.Modeling.RSAGLColors: chartreuse :: RGB
- RSAGL.Modeling.RSAGLColors: chartreuse_yellow :: RGB
- RSAGL.Modeling.RSAGLColors: cobalt :: RGB
- RSAGL.Modeling.RSAGLColors: copper :: RGB
- RSAGL.Modeling.RSAGLColors: coral :: RGB
- RSAGL.Modeling.RSAGLColors: corn :: RGB
- RSAGL.Modeling.RSAGLColors: crimson :: RGB
- RSAGL.Modeling.RSAGLColors: cyan :: RGB
- RSAGL.Modeling.RSAGLColors: dark_brown :: RGB
- RSAGL.Modeling.RSAGLColors: eggplant :: RGB
- RSAGL.Modeling.RSAGLColors: emerald :: RGB
- RSAGL.Modeling.RSAGLColors: fern_green :: RGB
- RSAGL.Modeling.RSAGLColors: firebrick :: RGB
- RSAGL.Modeling.RSAGLColors: forest_green :: RGB
- RSAGL.Modeling.RSAGLColors: fuchsia :: RGB
- RSAGL.Modeling.RSAGLColors: gold :: RGB
- RSAGL.Modeling.RSAGLColors: goldenrod :: RGB
- RSAGL.Modeling.RSAGLColors: green :: RGB
- RSAGL.Modeling.RSAGLColors: indigo :: RGB
- RSAGL.Modeling.RSAGLColors: jade :: RGB
- RSAGL.Modeling.RSAGLColors: lavender :: RGB
- RSAGL.Modeling.RSAGLColors: lemon :: RGB
- RSAGL.Modeling.RSAGLColors: lilac :: RGB
- RSAGL.Modeling.RSAGLColors: magenta :: RGB
- RSAGL.Modeling.RSAGLColors: maroon :: RGB
- RSAGL.Modeling.RSAGLColors: mauve :: RGB
- RSAGL.Modeling.RSAGLColors: midnight_blue :: RGB
- RSAGL.Modeling.RSAGLColors: mint_green :: RGB
- RSAGL.Modeling.RSAGLColors: mustard :: RGB
- RSAGL.Modeling.RSAGLColors: ochre :: RGB
- RSAGL.Modeling.RSAGLColors: olive :: RGB
- RSAGL.Modeling.RSAGLColors: orange :: RGB
- RSAGL.Modeling.RSAGLColors: orchid :: RGB
- RSAGL.Modeling.RSAGLColors: pale_brown :: RGB
- RSAGL.Modeling.RSAGLColors: pink :: RGB
- RSAGL.Modeling.RSAGLColors: puce :: RGB
- RSAGL.Modeling.RSAGLColors: purple :: RGB
- RSAGL.Modeling.RSAGLColors: red :: RGB
- RSAGL.Modeling.RSAGLColors: royal_blue :: RGB
- RSAGL.Modeling.RSAGLColors: royal_purple :: RGB
- RSAGL.Modeling.RSAGLColors: rust :: RGB
- RSAGL.Modeling.RSAGLColors: safety_orange :: RGB
- RSAGL.Modeling.RSAGLColors: saffron :: RGB
- RSAGL.Modeling.RSAGLColors: salmon :: RGB
- RSAGL.Modeling.RSAGLColors: sapphire :: RGB
- RSAGL.Modeling.RSAGLColors: sea_green :: RGB
- RSAGL.Modeling.RSAGLColors: sepia :: RGB
- RSAGL.Modeling.RSAGLColors: shamrock :: RGB
- RSAGL.Modeling.RSAGLColors: silver :: RGB
- RSAGL.Modeling.RSAGLColors: slate_gray :: RGB
- RSAGL.Modeling.RSAGLColors: tan_color :: RGB
- RSAGL.Modeling.RSAGLColors: teal :: RGB
- RSAGL.Modeling.RSAGLColors: ultramarine :: RGB
- RSAGL.Modeling.RSAGLColors: vermillion :: RGB
- RSAGL.Modeling.RSAGLColors: violet :: RGB
- RSAGL.Modeling.RSAGLColors: viridian :: RGB
- RSAGL.Modeling.RSAGLColors: wheat :: RGB
- RSAGL.Modeling.RSAGLColors: white :: RGB
- RSAGL.Modeling.RSAGLColors: yellow :: RGB
- RSAGL.Types: data RSdouble
- RSAGL.Types: data RSfloat
- RSAGL.Types: f2f :: (RealFloat a, RealFloat b) => a -> b
- RSAGL.Types: fromGLdouble :: GLdouble -> RSdouble
- RSAGL.Types: fromGLfloat :: GLfloat -> RSfloat
- RSAGL.Types: instance Enum RSdouble
- RSAGL.Types: instance Enum RSfloat
- RSAGL.Types: instance Eq RSdouble
- RSAGL.Types: instance Eq RSfloat
- RSAGL.Types: instance Floating RSdouble
- RSAGL.Types: instance Floating RSfloat
- RSAGL.Types: instance Fractional RSdouble
- RSAGL.Types: instance Fractional RSfloat
- RSAGL.Types: instance NearZero RSdouble
- RSAGL.Types: instance NearZero RSfloat
- RSAGL.Types: instance Num RSdouble
- RSAGL.Types: instance Num RSfloat
- RSAGL.Types: instance Ord RSdouble
- RSAGL.Types: instance Ord RSfloat
- RSAGL.Types: instance Random RSdouble
- RSAGL.Types: instance Random RSfloat
- RSAGL.Types: instance Read RSdouble
- RSAGL.Types: instance Read RSfloat
- RSAGL.Types: instance Real RSdouble
- RSAGL.Types: instance Real RSfloat
- RSAGL.Types: instance RealFloat RSdouble
- RSAGL.Types: instance RealFloat RSfloat
- RSAGL.Types: instance RealFrac RSdouble
- RSAGL.Types: instance RealFrac RSfloat
- RSAGL.Types: instance Show RSdouble
- RSAGL.Types: instance Show RSfloat
- RSAGL.Types: toGLdouble :: RSdouble -> GLdouble
- RSAGL.Types: toGLfloat :: RSfloat -> GLfloat
- RSAGL.Types: type GLdouble = Double
- RSAGL.Types: type GLfloat = Float
+ RSAGL.Animation.AnimationExtras: particleSystem :: (CoordinateSystemClass s, (StateOf m) ~ s) => Frequency -> [PV] -> FRP e m ([PV] -> ForceFunction) [PVA]
+ RSAGL.Animation.AnimationExtras: singleParticle :: (CoordinateSystemClass s, (StateOf m) ~ s) => Frequency -> PV -> FRP e m ForceFunction PVA
+ RSAGL.Animation.AnimationExtras: type ForceFunction = Time -> Point3D -> Rate Vector3D -> Acceleration Vector3D
+ RSAGL.Animation.AnimationExtras: type PV = (Point3D, Rate Vector3D)
+ RSAGL.Animation.AnimationExtras: type PVA = (Point3D, Rate Vector3D, Acceleration Vector3D)
+ RSAGL.Animation.InverseKinematics: Insectoid :: LegStyle
+ RSAGL.Animation.InverseKinematics: Upright :: LegStyle
+ RSAGL.Animation.InverseKinematics: data LegStyle
+ RSAGL.Animation.InverseKinematics: instance (StateOf m ~ s, CoordinateSystemClass s) => AffineTransformable (Leg e m)
+ RSAGL.Animation.KinematicSensors: inertia :: (CoordinateSystemClass s, (StateOf m) ~ s) => CoordinateSystem -> Point3D -> FRP e m () (Acceleration Vector3D)
+ RSAGL.Color: filterRGB :: RGB -> RGB -> RGB
+ RSAGL.Color: filterRGBLinear :: RGB -> RGB -> RGB -> RGB
+ RSAGL.Color: invertRGB :: RGB -> RGB
+ RSAGL.Color: minRGB :: RGB -> RSdouble
+ RSAGL.Color: rgba :: RSdouble -> RSdouble -> RSdouble -> RSdouble -> RGBA
+ RSAGL.Color: type RGBA = Alpha RGB
+ RSAGL.Color.Alpha: Alpha :: {-# UNPACK #-} !RSdouble -> !c -> Alpha c
+ RSAGL.Color.Alpha: alpha :: RSdouble -> Alpha c -> Alpha c
+ RSAGL.Color.Alpha: alpha256 :: Integral i => i -> Alpha c -> Alpha c
+ RSAGL.Color.Alpha: alpha_alpha :: Alpha c -> {-# UNPACK #-} !RSdouble
+ RSAGL.Color.Alpha: alpha_color :: Alpha c -> !c
+ RSAGL.Color.Alpha: data Alpha c
+ RSAGL.Color.Alpha: instance AbstractAdd c c => AbstractAdd (Alpha c) (Alpha c)
+ RSAGL.Color.Alpha: instance AbstractScale c => AbstractScale (Alpha c)
+ RSAGL.Color.Alpha: instance AbstractSubtract c c => AbstractSubtract (Alpha c) (Alpha c)
+ RSAGL.Color.Alpha: instance AbstractVector c => AbstractVector (Alpha c)
+ RSAGL.Color.Alpha: instance AbstractZero c => AbstractZero (Alpha c)
+ RSAGL.Color.Alpha: instance Functor Alpha
+ RSAGL.Color.Alpha: instance ImportColorCoordinates c => ImportColorCoordinates (Alpha c)
+ RSAGL.Color.Alpha: instance NFData c => NFData (Alpha c)
+ RSAGL.Color.Channels: channel_blue :: ColorChannel
+ RSAGL.Color.Channels: channel_blue_yellow :: ColorChannel
+ RSAGL.Color.Channels: channel_boldness :: ColorChannel
+ RSAGL.Color.Channels: channel_brightness :: ColorChannel
+ RSAGL.Color.Channels: channel_chroma :: ColorChannel
+ RSAGL.Color.Channels: channel_cyan :: ColorChannel
+ RSAGL.Color.Channels: channel_green :: ColorChannel
+ RSAGL.Color.Channels: channel_green_magenta :: ColorChannel
+ RSAGL.Color.Channels: channel_intensity :: ColorChannel
+ RSAGL.Color.Channels: channel_luminance :: ColorChannel
+ RSAGL.Color.Channels: channel_magenta :: ColorChannel
+ RSAGL.Color.Channels: channel_red :: ColorChannel
+ RSAGL.Color.Channels: channel_red_cyan :: ColorChannel
+ RSAGL.Color.Channels: channel_value :: ColorChannel
+ RSAGL.Color.Channels: channel_yellow :: ColorChannel
+ RSAGL.Color.ColorSpace: LinearMetric :: Maybe (RSdouble, RSdouble) -> (RSdouble -> Color) -> RSdouble -> Color -> LinearMetric
+ RSAGL.Color.ColorSpace: affineColorSpaceOf :: ColorSpace cs => cs -> AffineColorSpace
+ RSAGL.Color.ColorSpace: channel_u :: ChannelIndex
+ RSAGL.Color.ColorSpace: channel_v :: ChannelIndex
+ RSAGL.Color.ColorSpace: channel_w :: ChannelIndex
+ RSAGL.Color.ColorSpace: class ColorSpace cs
+ RSAGL.Color.ColorSpace: class ExportColorCoordinates c
+ RSAGL.Color.ColorSpace: class ImportColorCoordinates c
+ RSAGL.Color.ColorSpace: color_space_rgb :: AffineColorSpace
+ RSAGL.Color.ColorSpace: color_wheel_rgbl :: ColorWheel
+ RSAGL.Color.ColorSpace: data AffineColorSpace
+ RSAGL.Color.ColorSpace: data ChannelIndex
+ RSAGL.Color.ColorSpace: data ColorChannel
+ RSAGL.Color.ColorSpace: data ColorWheel
+ RSAGL.Color.ColorSpace: data LinearMetric
+ RSAGL.Color.ColorSpace: exportColorCoordinates :: ExportColorCoordinates c => c -> AffineColorSpace -> Point3D
+ RSAGL.Color.ColorSpace: importColorCoordinates :: ImportColorCoordinates c => (AffineColorSpace -> Point3D) -> c
+ RSAGL.Color.ColorSpace: instance ColorSpace AffineColorSpace
+ RSAGL.Color.ColorSpace: instance ColorSpace ColorWheel
+ RSAGL.Color.ColorSpace: instance ExportColorCoordinates Color
+ RSAGL.Color.ColorSpace: instance ImportColorCoordinates Color
+ RSAGL.Color.ColorSpace: instance Show AffineColorSpace
+ RSAGL.Color.ColorSpace: instance Show ColorWheel
+ RSAGL.Color.ColorSpace: instance Show LinearMetric
+ RSAGL.Color.ColorSpace: linear_color_function :: LinearMetric -> RSdouble -> Color
+ RSAGL.Color.ColorSpace: linear_gamut_bounds :: LinearMetric -> Maybe (RSdouble, RSdouble)
+ RSAGL.Color.ColorSpace: linear_original :: LinearMetric -> Color
+ RSAGL.Color.ColorSpace: linear_value :: LinearMetric -> RSdouble
+ RSAGL.Color.ColorSpace: newAngularChannel :: ColorWheel -> Angle -> ColorChannel
+ RSAGL.Color.ColorSpace: newChannel :: ColorSpace cs => ChannelIndex -> cs -> ColorChannel
+ RSAGL.Color.ColorSpace: newColorSpace :: ExportColorCoordinates c => c -> c -> c -> c -> AffineColorSpace
+ RSAGL.Color.ColorSpace: newColorWheel :: ExportColorCoordinates c => c -> (c, Angle, RSdouble) -> (c, Angle, RSdouble) -> (c, Angle, RSdouble) -> ColorWheel
+ RSAGL.Color.ColorSpace: newMaximalChannel :: AffineColorSpace -> ColorChannel
+ RSAGL.Color.ColorSpace: newRadialChannel :: ColorWheel -> ColorChannel
+ RSAGL.Color.ColorSpace: transformColor :: (ExportColorCoordinates source, ImportColorCoordinates dest) => source -> dest
+ RSAGL.Color.ColorSpace: transformColorFromTo :: AffineColorSpace -> Point3D -> AffineColorSpace -> Point3D
+ RSAGL.Color.ColorSpace: viewChannel :: ExportColorCoordinates c => ColorChannel -> c -> LinearMetric
+ RSAGL.Color.HCL: HCL :: {-# UNPACK #-} !Angle -> {-# UNPACK #-} !RSdouble -> {-# UNPACK #-} !RSdouble -> HCL
+ RSAGL.Color.HCL: data HCL
+ RSAGL.Color.HCL: hcl_chroma :: HCL -> {-# UNPACK #-} !RSdouble
+ RSAGL.Color.HCL: hcl_hue :: HCL -> {-# UNPACK #-} !Angle
+ RSAGL.Color.HCL: hcl_luminance :: HCL -> {-# UNPACK #-} !RSdouble
+ RSAGL.Color.HCL: instance ColorSpace HCL
+ RSAGL.Color.HCL: instance Eq HCL
+ RSAGL.Color.HCL: instance ExportColorCoordinates HCL
+ RSAGL.Color.HCL: instance ImportColorCoordinates HCL
+ RSAGL.Color.HCL: instance Ord HCL
+ RSAGL.Color.HCL: instance Read HCL
+ RSAGL.Color.HCL: instance Show HCL
+ RSAGL.Color.LinearAdjust: adjustColor :: (ExportColorCoordinates c, ImportColorCoordinates c') => ColorChannel -> LinearAdjustment -> c -> c'
+ RSAGL.Color.LinearAdjust: clamp :: LinearAdjustment
+ RSAGL.Color.LinearAdjust: maximize :: LinearAdjustment
+ RSAGL.Color.LinearAdjust: minimize :: LinearAdjustment
+ RSAGL.Color.LinearAdjust: type LinearAdjustment = LinearMetric -> RSdouble
+ RSAGL.Color.OpenGL: class ColorToOpenGL c
+ RSAGL.Color.OpenGL: colorToOpenGL :: ColorToOpenGL c => c -> Color4 GLdouble
+ RSAGL.Color.OpenGL: instance ColorToOpenGL (Alpha RGB)
+ RSAGL.Color.OpenGL: instance ColorToOpenGL RGB
+ RSAGL.Color.RGB: RGB :: {-# UNPACK #-} !RSdouble -> {-# UNPACK #-} !RSdouble -> {-# UNPACK #-} !RSdouble -> RGB
+ RSAGL.Color.RGB: data RGB
+ RSAGL.Color.RGB: grayscale :: ImportColorCoordinates c => RSdouble -> c
+ RSAGL.Color.RGB: grayscale256 :: (Integral i, ImportColorCoordinates c) => i -> c
+ RSAGL.Color.RGB: greyscale :: ImportColorCoordinates c => RSdouble -> c
+ RSAGL.Color.RGB: greyscale256 :: (Integral i, ImportColorCoordinates c) => i -> c
+ RSAGL.Color.RGB: instance AbstractAdd RGB RGB
+ RSAGL.Color.RGB: instance AbstractScale RGB
+ RSAGL.Color.RGB: instance AbstractSubtract RGB RGB
+ RSAGL.Color.RGB: instance AbstractVector RGB
+ RSAGL.Color.RGB: instance AbstractZero RGB
+ RSAGL.Color.RGB: instance ColorSpace RGB
+ RSAGL.Color.RGB: instance Eq RGB
+ RSAGL.Color.RGB: instance ExportColorCoordinates RGB
+ RSAGL.Color.RGB: instance ImportColorCoordinates RGB
+ RSAGL.Color.RGB: instance NFData RGB
+ RSAGL.Color.RGB: instance Ord RGB
+ RSAGL.Color.RGB: instance Read RGB
+ RSAGL.Color.RGB: instance Show RGB
+ RSAGL.Color.RGB: instance Xyz RGB
+ RSAGL.Color.RGB: mapRGB :: (RSdouble -> RSdouble) -> RGB -> RGB
+ RSAGL.Color.RGB: rgb :: ImportColorCoordinates c => RSdouble -> RSdouble -> RSdouble -> c
+ RSAGL.Color.RGB: rgb256 :: (ImportColorCoordinates c, Integral i) => i -> i -> i -> c
+ RSAGL.Color.RGB: rgb_blue :: RGB -> {-# UNPACK #-} !RSdouble
+ RSAGL.Color.RGB: rgb_green :: RGB -> {-# UNPACK #-} !RSdouble
+ RSAGL.Color.RGB: rgb_red :: RGB -> {-# UNPACK #-} !RSdouble
+ RSAGL.Color.RGB: zipRGB :: (RSdouble -> RSdouble -> RSdouble) -> RGB -> RGB -> RGB
+ RSAGL.Color.RGB: zipRGB3 :: (RSdouble -> RSdouble -> RSdouble -> RSdouble) -> RGB -> RGB -> RGB -> RGB
+ RSAGL.Color.RSAGLColors: aqua :: RGB
+ RSAGL.Color.RSAGLColors: beige :: RGB
+ RSAGL.Color.RSAGLColors: black :: RGB
+ RSAGL.Color.RSAGLColors: blackbody :: RGB
+ RSAGL.Color.RSAGLColors: blue :: RGB
+ RSAGL.Color.RSAGLColors: bright_green :: RGB
+ RSAGL.Color.RSAGLColors: brown :: RGB
+ RSAGL.Color.RSAGLColors: cyan :: RGB
+ RSAGL.Color.RSAGLColors: dark_blue :: RGB
+ RSAGL.Color.RSAGLColors: dark_green :: RGB
+ RSAGL.Color.RSAGLColors: dark_pink :: RGB
+ RSAGL.Color.RSAGLColors: dark_purple :: RGB
+ RSAGL.Color.RSAGLColors: forest_green :: RGB
+ RSAGL.Color.RSAGLColors: green :: RGB
+ RSAGL.Color.RSAGLColors: grey :: RGB
+ RSAGL.Color.RSAGLColors: hot_pink :: RGB
+ RSAGL.Color.RSAGLColors: indigo :: RGB
+ RSAGL.Color.RSAGLColors: lavender :: RGB
+ RSAGL.Color.RSAGLColors: light_blue :: RGB
+ RSAGL.Color.RSAGLColors: light_brown :: RGB
+ RSAGL.Color.RSAGLColors: light_green :: RGB
+ RSAGL.Color.RSAGLColors: light_pink :: RGB
+ RSAGL.Color.RSAGLColors: light_purple :: RGB
+ RSAGL.Color.RSAGLColors: lilac :: RGB
+ RSAGL.Color.RSAGLColors: lime :: RGB
+ RSAGL.Color.RSAGLColors: lime_green :: RGB
+ RSAGL.Color.RSAGLColors: magenta :: RGB
+ RSAGL.Color.RSAGLColors: maroon :: RGB
+ RSAGL.Color.RSAGLColors: mauve :: RGB
+ RSAGL.Color.RSAGLColors: mustard :: RGB
+ RSAGL.Color.RSAGLColors: navy_blue :: RGB
+ RSAGL.Color.RSAGLColors: olive :: RGB
+ RSAGL.Color.RSAGLColors: olive_green :: RGB
+ RSAGL.Color.RSAGLColors: orange :: RGB
+ RSAGL.Color.RSAGLColors: pale_green :: RGB
+ RSAGL.Color.RSAGLColors: peach :: RGB
+ RSAGL.Color.RSAGLColors: periwinkle :: RGB
+ RSAGL.Color.RSAGLColors: pink :: RGB
+ RSAGL.Color.RSAGLColors: purple :: RGB
+ RSAGL.Color.RSAGLColors: red :: RGB
+ RSAGL.Color.RSAGLColors: royal_blue :: RGB
+ RSAGL.Color.RSAGLColors: salmon :: RGB
+ RSAGL.Color.RSAGLColors: sea_green :: RGB
+ RSAGL.Color.RSAGLColors: sky_blue :: RGB
+ RSAGL.Color.RSAGLColors: tan :: RGB
+ RSAGL.Color.RSAGLColors: teal :: RGB
+ RSAGL.Color.RSAGLColors: turquoise :: RGB
+ RSAGL.Color.RSAGLColors: violet :: RGB
+ RSAGL.Color.RSAGLColors: white :: RGB
+ RSAGL.Color.RSAGLColors: yellow :: RGB
+ RSAGL.Color.Spaces: color_space_cmy :: AffineColorSpace
+ RSAGL.Color.Spaces: color_space_neutral :: AffineColorSpace
+ RSAGL.Color.Spaces: color_wheel_blue_yellow_iso :: ColorWheel
+ RSAGL.Color.Spaces: color_wheel_cmyk :: ColorWheel
+ RSAGL.Color.Spaces: color_wheel_green_magenta_iso :: ColorWheel
+ RSAGL.Color.Spaces: color_wheel_red_cyan_iso :: ColorWheel
+ RSAGL.Color.Spaces: color_wheel_rgb_brightness :: ColorWheel
+ RSAGL.Scene.WrappedAffine: WrappedAffine :: CoordinateSystem -> a -> WrappedAffine a
+ RSAGL.Scene.WrappedAffine: data WrappedAffine a
+ RSAGL.Scene.WrappedAffine: instance AffineTransformable (WrappedAffine a)
+ RSAGL.Scene.WrappedAffine: instance Functor WrappedAffine
+ RSAGL.Scene.WrappedAffine: unwrapAffine :: AffineTransformable a => WrappedAffine a -> a
+ RSAGL.Scene.WrappedAffine: wrapAffine :: a -> WrappedAffine a
- RSAGL.Animation.AnimationExtras: animateA :: (CoordinateSystemClass s, StateOf m ~ s) => FRP e m j AffineTransformation -> FRP e m j p -> FRP e m j p
+ RSAGL.Animation.AnimationExtras: animateA :: (CoordinateSystemClass s, (StateOf m) ~ s) => FRP e m j AffineTransformation -> FRP e m j p -> FRP e m j p
- RSAGL.Animation.AnimationExtras: rotateA :: (CoordinateSystemClass s, StateOf m ~ s) => Vector3D -> Rate Angle -> FRP e m j p -> FRP e m j p
+ RSAGL.Animation.AnimationExtras: rotateA :: (CoordinateSystemClass s, (StateOf m) ~ s) => Vector3D -> Rate Angle -> FRP e m j p -> FRP e m j p
- RSAGL.Animation.InverseKinematics: jointAnimation :: (CoordinateSystemClass s, StateOf m ~ s) => FRP e m () () -> FRP e m () () -> FRP e m Joint ()
+ RSAGL.Animation.InverseKinematics: jointAnimation :: (CoordinateSystemClass s, (StateOf m) ~ s) => FRP e m () () -> FRP e m () () -> FRP e m Joint ()
- RSAGL.Animation.InverseKinematics: leg :: (CoordinateSystemClass s, StateOf m ~ s) => Vector3D -> Point3D -> RSdouble -> Point3D -> (FRP e m Joint ()) -> Leg e m
+ RSAGL.Animation.InverseKinematics: leg :: (CoordinateSystemClass s, (StateOf m) ~ s) => LegStyle -> Vector3D -> Point3D -> RSdouble -> Point3D -> (FRP e m Joint ()) -> Leg e m
- RSAGL.Animation.KinematicSensors: odometer :: (CoordinateSystemClass s, StateOf m ~ s) => CoordinateSystem -> Vector3D -> FRP e m () RSdouble
+ RSAGL.Animation.KinematicSensors: odometer :: (CoordinateSystemClass s, (StateOf m) ~ s) => CoordinateSystem -> Vector3D -> FRP e m () RSdouble
- RSAGL.Modeling.ModelingExtras: pattern :: ColorClass a => Pattern -> [(GLfloat, ColorFunction a)] -> ColorFunction a
+ RSAGL.Modeling.ModelingExtras: pattern :: AbstractVector a => Pattern -> [(RSfloat, ColorFunction a)] -> ColorFunction a
Files
- ProcessColors.hs +0/−61
- RSAGL/Animation/Animation.hs +94/−0
- RSAGL/Animation/Animation.lhs +0/−102
- RSAGL/Animation/AnimationExtras.hs +116/−0
- RSAGL/Animation/AnimationExtras.lhs +0/−124
- RSAGL/Animation/InverseKinematics.hs +204/−0
- RSAGL/Animation/InverseKinematics.lhs +0/−114
- RSAGL/Animation/Joint.hs +53/−0
- RSAGL/Animation/Joint.lhs +0/−51
- RSAGL/Animation/KinematicSensors.hs +34/−0
- RSAGL/Animation/KinematicSensors.lhs +0/−33
- RSAGL/Auxiliary/ApplicativeWrapper.hs +16/−1
- RSAGL/Auxiliary/Auxiliary.hs +2/−1
- RSAGL/Auxiliary/RecombinantState.hs +0/−16
- RSAGL/Color.hs +59/−0
- RSAGL/Color/Alpha.hs +48/−0
- RSAGL/Color/Auxiliary.hs +11/−0
- RSAGL/Color/Channels.hs +87/−0
- RSAGL/Color/ColorSpace.hs +297/−0
- RSAGL/Color/HCL.hs +31/−0
- RSAGL/Color/LinearAdjust.hs +36/−0
- RSAGL/Color/OpenGL.hs +26/−0
- RSAGL/Color/RGB.hs +99/−0
- RSAGL/Color/RSAGLColors.hs +156/−0
- RSAGL/Color/Spaces.hs +77/−0
- RSAGL/Extras/ColorPhysics.hs +2/−2
- RSAGL/Extras/Sky.hs +24/−14
- RSAGL/FRP.hs +0/−12
- RSAGL/FRP/Accumulation.hs +0/−112
- RSAGL/FRP/FRP.hs +0/−372
- RSAGL/FRP/FRPModel.hs +0/−93
- RSAGL/FRP/FactoryArrow.hs +0/−53
- RSAGL/FRP/Time.lhs +0/−162
- RSAGL/Math.hs +0/−23
- RSAGL/Math/AbstractVector.hs +0/−203
- RSAGL/Math/Affine.hs +0/−145
- RSAGL/Math/Angle.hs +0/−193
- RSAGL/Math/Curve.hs +0/−302
- RSAGL/Math/CurveExtras.lhs +0/−110
- RSAGL/Math/FMod.hs +0/−24
- RSAGL/Math/Interpolation.lhs +0/−109
- RSAGL/Math/Matrix.lhs +0/−190
- RSAGL/Math/Orthagonal.lhs +0/−83
- RSAGL/Math/RK4.lhs +0/−47
- RSAGL/Math/Ray.lhs +0/−42
- RSAGL/Math/Vector.lhs +0/−298
- RSAGL/Math/WrappedAffine.hs +0/−24
- RSAGL/Modeling.hs +1/−3
- RSAGL/Modeling/BoundingBox.lhs +0/−78
- RSAGL/Modeling/Color.lhs +0/−197
- RSAGL/Modeling/Deformation.hs +60/−0
- RSAGL/Modeling/Deformation.lhs +0/−49
- RSAGL/Modeling/Extrusion.hs +56/−0
- RSAGL/Modeling/Extrusion.lhs +0/−41
- RSAGL/Modeling/Material.hs +20/−20
- RSAGL/Modeling/Model.lhs +4/−3
- RSAGL/Modeling/ModelingExtras.lhs +12/−10
- RSAGL/Modeling/Noise.hs +83/−0
- RSAGL/Modeling/Noise.lhs +0/−83
- RSAGL/Modeling/Optimization.lhs +1/−1
- RSAGL/Modeling/RSAGLColors.hs +0/−229
- RSAGL/Modeling/Tesselation.hs +2/−2
- RSAGL/RayTrace/RayTrace.lhs +3/−3
- RSAGL/RayTrace/Scattering.lhs +23/−19
- RSAGL/Scene/CoordinateSystems.lhs +1/−1
- RSAGL/Scene/LightSource.hs +11/−10
- RSAGL/Scene/Scene.lhs +13/−13
- RSAGL/Scene/WrappedAffine.hs +26/−0
- RSAGL/Types.hs +0/−49
- rsagl.cabal +25/−25
− ProcessColors.hs
@@ -1,61 +0,0 @@-module Main- (main)- where--import RSAGL.Modeling.Material-import Control.Monad-import Data.List-import Numeric--data ColorTableEntry = ColorTableEntry { cte_name :: String, cte_red, cte_green, cte_blue :: Int }--readColorTableEntry :: String -> ColorTableEntry-readColorTableEntry s = ColorTableEntry name (read r :: Int) (read g :: Int) (read b :: Int)- where [name,r,g,b] = words s--cteToColor :: ColorTableEntry -> RGB-cteToColor cte = rgb256 (cte_red cte) (cte_green cte) (cte_blue cte)--cteToHaskell :: ColorTableEntry -> String-cteToHaskell (ColorTableEntry s r g b) = s ++ " :: RGB\n" ++ s ++ " = rgb256 " ++ (show r) ++ " " ++ (show g) ++ " " ++ (show b) ++ "\n"--wrapHaskellModule :: [ColorTableEntry] -> String -> String-wrapHaskellModule cte s = ("module RSAGL.Modeling.RSAGLColors (" ++ (listColors cte) ++ ") where") ++ - "\n\nimport RSAGL.Modeling.Material\n\n" ++ s--listColors :: [ColorTableEntry] -> String-listColors = concat . intersperse "," . map cte_name--wrapHTMLFile :: String -> String-wrapHTMLFile s = "<html><head><title>RSAGL Color Tables</title></head><body>" ++ s ++ "</body></html>"--cteToHTML :: ColorTableEntry -> String-cteToHTML (ColorTableEntry s r g b) = "<p><div style=\"background-color:" ++ (zeroes $ showHex (r * 0x10000 + g * 0x100 + b) "") ++ "\">" - ++ s ++ " " ++ show r ++ " " ++ show g ++ " " ++ show b ++ "</div>"- where zeroes x = replicate (6 - length x) '0' ++ x--cteSubtable :: String -> [ColorTableEntry] -> String-cteSubtable name color_tables = "<h4>" ++ name ++ "</h4>" ++ (unlines . map cteToHTML) color_tables--colorTablesToHTML :: [ColorTableEntry] -> String-colorTablesToHTML color_tables =- cteSubtable "All Colors" color_tables ++- cteSubtable "By Luminance" (reverse $ sortBy luminance color_tables) ++- cteSubtable "By Red" (takeHalf $ sortBy byred color_tables) ++- cteSubtable "By Green" (takeHalf $ sortBy bygreen color_tables) ++- cteSubtable "By Blue" (takeHalf $ sortBy byblue color_tables)- where luminance x y = compare (cteBrightness x) (cteBrightness y)- byred x y = compare (toRed y ^ 2 / flatBrightness y) (toRed x ^ 2 / flatBrightness x)- bygreen x y = compare (toGreen y ^ 2 / flatBrightness y) (toGreen x ^ 2 / flatBrightness x)- byblue x y = compare (toBlue y ^ 2 / flatBrightness y) (toBlue x ^ 2 / flatBrightness x)- cteBrightness = realToFrac . (1 +) . brightness . cteToColor- flatBrightness x = toRed x * toGreen x * toBlue x- toRed = realToFrac . cte_red- toGreen = realToFrac . cte_green- toBlue = realToFrac . cte_blue- takeHalf x = take (length x `div` 2) x--main :: IO ()-main = do color_tables <- liftM (map readColorTableEntry . lines) $ readFile "rsagl-rgb.txt"- writeFile "RSAGL/Modeling/RSAGLColors.hs" $ wrapHaskellModule color_tables $ (unlines . map cteToHaskell) color_tables- writeFile "rsagl-rgb.html" $ wrapHTMLFile $ colorTablesToHTML color_tables
+ RSAGL/Animation/Animation.hs view
@@ -0,0 +1,94 @@+{-# LANGUAGE Arrows,+ MultiParamTypeClasses,+ FlexibleInstances,+ GeneralizedNewtypeDeriving,+ TypeFamilies,+ ExistentialQuantification,+ Rank2Types #-}++-- | Supports monadic and arrow operations for animated+-- scenes.+module RSAGL.Animation.Animation+ (AniM,+ TimePlusSceneAccumulator,+ frameTime,+ runAniM,+ rotationM,+ animateM,+ rotateM,+ AnimationObject,+ newAnimationObjectM,+ newAnimationObjectA,+ runAnimationObject)+ where++import RSAGL.Scene.Scene+import Control.Monad.State+import RSAGL.Scene.CoordinateSystems+import RSAGL.Math.Angle+import RSAGL.Math.Vector+import RSAGL.Math.Affine+import RSAGL.FRP++-- | A time-aware scene accumulator.+newtype TimePlusSceneAccumulator m = TimePlusSceneAccumulator (Time,SceneAccumulator m)+ deriving (CoordinateSystemClass)++instance (Monad m) => ScenicAccumulator (TimePlusSceneAccumulator m) m where+ accumulateScene slayer scobj (TimePlusSceneAccumulator (t,sceneaccum)) = TimePlusSceneAccumulator (t,accumulateScene slayer scobj sceneaccum)++instance RecombinantState (TimePlusSceneAccumulator m) where+ type SubState (TimePlusSceneAccumulator m) = TimePlusSceneAccumulator m+ clone = id+ recombine (TimePlusSceneAccumulator (t,old)) (TimePlusSceneAccumulator (_,new)) = TimePlusSceneAccumulator (t,recombine old new)++-- | A monad for animation using RSAGL's scene accumulation system.+type AniM a = StateT (TimePlusSceneAccumulator IO) IO a++-- | Get's the time of the current frame.+frameTime :: AniM Time+frameTime = gets (\(TimePlusSceneAccumulator (t,_)) -> t)++runAniM :: AniM (a,SceneLayerInfo) -> IO (a,Scene)+runAniM anim = + do t <- getTime+ ((a,sli),TimePlusSceneAccumulator (_,sa)) <- runStateT anim $ TimePlusSceneAccumulator (t,null_scene_accumulator)+ result_scene <- assembleScene sli sa+ return (a,result_scene)++-- | Generates a continuous rotation.+rotationM :: Vector3D -> Rate Angle -> AniM AffineTransformation+rotationM v a =+ do t <- frameTime+ return (rotate v (a `over` t))++-- | Combine an animation with a continuous affine transformation.+animateM :: AniM AffineTransformation -> AniM b -> AniM b+animateM affineF action =+ do at <- affineF+ transformM (affineOf at) action++-- | Rotate an animation continuously.+rotateM :: Vector3D -> Rate Angle -> AniM a -> AniM a+rotateM v a = animateM (rotationM v a)++-- | An object that can capture either a monadic or+-- arrow-based animation.+data AnimationObject i o =+ AniMObject (i -> AniM o)+ | AniAObject (FRPProgram (SceneAccumulator IO) i o)++newAnimationObjectM :: (i -> AniM o) -> AnimationObject i o+newAnimationObjectM = AniMObject++newAnimationObjectA :: (forall e. FRP e (FRP1 (SceneAccumulator IO) i o) i o) -> IO (AnimationObject i o)+newAnimationObjectA thread = liftM AniAObject $ newFRP1Program thread++runAnimationObject :: AnimationObject i o -> i -> AniM o+runAnimationObject (AniMObject f) i = f i+runAnimationObject (AniAObject frpp) i =+ do TimePlusSceneAccumulator (t,old_s) <- get+ (o,new_s) <- liftIO $ updateFRPProgram (Just t) (i,old_s) frpp+ put $ TimePlusSceneAccumulator (t,new_s)+ return o+
− RSAGL/Animation/Animation.lhs
@@ -1,102 +0,0 @@-\section{Monads and Arrows for Animation}--The \texttt{AniM} monad and the \texttt{AniA} arrow support frame time, affine transformation and scene accumulation.--\begin{code}-{-# LANGUAGE Arrows,- MultiParamTypeClasses,- FlexibleInstances,- GeneralizedNewtypeDeriving,- TypeFamilies,- ExistentialQuantification,- Rank2Types #-}--module RSAGL.Animation.Animation- (AniM,- TimePlusSceneAccumulator,- frameTime,- runAniM,- rotationM,- animateM,- rotateM,- AnimationObject,- newAnimationObjectM,- newAnimationObjectA,- runAnimationObject)- where--import RSAGL.Scene.Scene-import Control.Monad.State-import RSAGL.Scene.CoordinateSystems-import RSAGL.Math.Angle-import RSAGL.Math.Vector-import RSAGL.Math.Affine-import RSAGL.FRP-import RSAGL.Auxiliary.RecombinantState-\end{code}--\subsection{The AniM Monad}--The AniM monad is a simple state layer over the IO monad that supports scene accumulation and getting the frame time (the time at the beginning of the frame, as opposed to real time that would change as the animation progresses).--\begin{code}-newtype TimePlusSceneAccumulator m = TimePlusSceneAccumulator (Time,SceneAccumulator m)- deriving (CoordinateSystemClass)--instance (Monad m) => ScenicAccumulator (TimePlusSceneAccumulator m) m where- accumulateScene slayer scobj (TimePlusSceneAccumulator (t,sceneaccum)) = TimePlusSceneAccumulator (t,accumulateScene slayer scobj sceneaccum)--instance RecombinantState (TimePlusSceneAccumulator m) where- type SubState (TimePlusSceneAccumulator m) = TimePlusSceneAccumulator m- clone = id- recombine (TimePlusSceneAccumulator (t,old)) (TimePlusSceneAccumulator (_,new)) = TimePlusSceneAccumulator (t,recombine old new)--type AniM a = StateT (TimePlusSceneAccumulator IO) IO a--frameTime :: AniM Time-frameTime = gets (\(TimePlusSceneAccumulator (t,_)) -> t)--runAniM :: AniM (a,SceneLayerInfo) -> IO (a,Scene)-runAniM anim = - do t <- getTime- ((a,sli),TimePlusSceneAccumulator (_,sa)) <- runStateT anim $ TimePlusSceneAccumulator (t,null_scene_accumulator)- result_scene <- assembleScene sli sa- return (a,result_scene)--rotationM :: Vector3D -> Rate Angle -> AniM AffineTransformation-rotationM v a =- do t <- frameTime- return (rotate v (a `over` t))--animateM :: AniM AffineTransformation -> AniM b -> AniM b-animateM affineF action =- do at <- affineF- transformM (affineOf at) action--rotateM :: Vector3D -> Rate Angle -> AniM a -> AniM a-rotateM v a = animateM (rotationM v a)-\end{code}--\subsection{Animation Objects}--This is one possible implementation of an animation object.--\begin{code}-data AnimationObject i o =- AniMObject (i -> AniM o)- | AniAObject (FRPProgram (SceneAccumulator IO) i o)--newAnimationObjectM :: (i -> AniM o) -> AnimationObject i o-newAnimationObjectM = AniMObject--newAnimationObjectA :: (forall e. FRP e (FRP1 (SceneAccumulator IO) i o) i o) -> IO (AnimationObject i o)-newAnimationObjectA thread = liftM AniAObject $ newFRP1Program thread--runAnimationObject :: AnimationObject i o -> i -> AniM o-runAnimationObject (AniMObject f) i = f i-runAnimationObject (AniAObject frpp) i =- do TimePlusSceneAccumulator (t,old_s) <- get- (o,new_s) <- liftIO $ updateFRPProgram (Just t) (i,old_s) frpp- put $ TimePlusSceneAccumulator (t,new_s)- return o-\end{code}
+ RSAGL/Animation/AnimationExtras.hs view
@@ -0,0 +1,116 @@+{-# LANGUAGE Arrows, TypeFamilies #-}++module RSAGL.Animation.AnimationExtras+ (rotationA,+ animateA,+ rotateA,+ pointAtCameraA,+ inverseSquareLaw,+ quadraticTrap,+ drag,+ concatForces,+ constrainForce,+ singleParticle,+ particleSystem,+ PV,+ PVA,+ ForceFunction)+ where++import RSAGL.Math.Vector+import RSAGL.FRP+import RSAGL.Math.AbstractVector+import Control.Arrow+import Control.Arrow.Operations+import RSAGL.Scene.CoordinateSystems+import RSAGL.Math.Affine+import RSAGL.Math.Angle+import RSAGL.Scene.Scene+import RSAGL.Modeling.Model+import RSAGL.Scene.WrappedAffine+import Control.Monad+import RSAGL.Math.Types+import Debug.Trace++-- | Answers a continuous rotation.+rotationA :: Vector3D -> Rate Angle -> FRP e m ignored AffineTransformation+rotationA v a = proc _ ->+ do t <- absoluteTime -< ()+ returnA -< rotate v (a `over` t)++-- | Apply an affine transformation to an animation.+animateA :: (CoordinateSystemClass s,StateOf m ~ s) => FRP e m j AffineTransformation -> FRP e m j p -> FRP e m j p+animateA affineA action = proc i ->+ do at <- affineA -< i+ transformA action -< (affineOf at,i)++-- | Animation that rotates continuously.+rotateA :: (CoordinateSystemClass s,StateOf m ~ s) => Vector3D -> Rate Angle -> FRP e m j p -> FRP e m j p+rotateA v a = animateA (rotationA v a)++-- | Always rotates the model so that it's Y+ axis points directly at the camera.+pointAtCameraA :: (Arrow a,ArrowState s a,CoordinateSystemClass s,ScenicAccumulator s m,ModelType model) => a (SceneLayer,m model) ()+pointAtCameraA = proc (slayer,the_model) ->+ do cs <- arr getCoordinateSystem <<< fetch -< ()+ accumulateSceneA -< (slayer,cameraRelativeSceneObject $ \c -> + liftM ((rotateToFrom (vectorToFrom (migrateToFrom root_coordinate_system cs $ camera_position c) $ origin_point_3d)+ (Vector3D 0 1 0)) . wrapAffine) (liftM toIntermediateModel the_model))++-- | A particle with a position and velocity.+type PV = (Point3D,Rate Vector3D)++-- | A particle with a position, velocity and acceleration.+type PVA = (Point3D,Rate Vector3D,Acceleration Vector3D)++-- | A time-varying, velocity-aware vector field that can act on a particle.+type ForceFunction = Time -> Point3D -> Rate Vector3D -> Acceleration Vector3D++-- | An energy-conserving force function describing gravitational attraction.+-- Accepts the intensity and singularity of the vector field.+inverseSquareLaw :: RSdouble -> Point3D -> ForceFunction+inverseSquareLaw g attractor _ p _ =+ if l > 0+ then perSecond $ perSecond $ vectorScaleTo (g * recip l) v+ else zero+ where l = vectorLengthSquared v+ v = vectorToFrom attractor p++-- | An energy-conserving force function that increases in+-- intensity with distance.+quadraticTrap :: RSdouble -> Point3D -> ForceFunction+quadraticTrap g attractor _ p _ = perSecond $ perSecond $ vectorScaleTo (g * vectorLengthSquared v) v+ where v = vectorToFrom attractor p++-- | A force function describing aerodynamic drag.+drag :: RSdouble -> ForceFunction+drag x _ _ v' = perSecond $ perSecond $ vectorScaleTo (negate $ x * vectorLengthSquared v) v+ where v = v' `over` fromSeconds 1++-- | Add many forces together.+concatForces :: [ForceFunction] -> ForceFunction+concatForces ffs t p v = abstractSum $ map (\f -> f t p v) ffs++-- | A filter function on forces. Where the filter is False,+-- the force is coerced to zero.+constrainForce :: (Time -> Point3D -> Rate Vector3D -> Bool) -> ForceFunction -> ForceFunction+constrainForce predicate f t p v = if predicate t p v+ then f t p v+ else zero++-- | Apply a varying force function to a particle.+singleParticle :: (CoordinateSystemClass s,StateOf m ~ s) =>+ Frequency -> PV -> FRP e m ForceFunction PVA+singleParticle f pv = proc force_function ->+ do (p,v) <- integralRK4' f (flip translate) pv -< force_function+ a <- derivative -< v+ returnA -< (p,v,a)++-- | Apply a varying force function to a system of particles.+particleSystem :: (CoordinateSystemClass s,StateOf m ~ s) =>+ Frequency -> [PV] -> FRP e m ([PV] -> ForceFunction) [PVA]+particleSystem f particles = proc force_function ->+ do (ps',vs') <- integralRK4' f (zipWith $ flip translate) (second pack $ unzip particles) -<+ \t ps vs -> packa $ zipWith (force_function (zip ps (unpack vs)) t) ps (unpack vs)+ as' <- derivative -< vs'+ returnA -< zip3 ps' (unpack vs') (unpacka as')+
− RSAGL/Animation/AnimationExtras.lhs
@@ -1,124 +0,0 @@-\section{Specific Animations}--\begin{code}-{-# LANGUAGE Arrows, TypeFamilies #-}--module RSAGL.Animation.AnimationExtras- (rotationA,- animateA,- rotateA,- pointAtCameraA,- inverseSquareLaw,- quadraticTrap,- drag,- concatForces,- constrainForce,- accelerationModel)- where--import RSAGL.Math.Vector-import RSAGL.FRP-import RSAGL.Math.AbstractVector-import Control.Arrow-import Control.Arrow.Operations-import RSAGL.Scene.CoordinateSystems-import RSAGL.Math.Affine-import RSAGL.Math.Angle-import RSAGL.Scene.Scene-import RSAGL.Modeling.Model-import RSAGL.Math.WrappedAffine-import Control.Monad-import RSAGL.Types-\end{code}--\subsection{Simple Animators}--\begin{code}-rotationA :: Vector3D -> Rate Angle -> FRP e m ignored AffineTransformation-rotationA v a = proc _ ->- do t <- absoluteTime -< ()- returnA -< rotate v (a `over` t)--animateA :: (CoordinateSystemClass s,StateOf m ~ s) => FRP e m j AffineTransformation -> FRP e m j p -> FRP e m j p-animateA affineA action = proc i ->- do at <- affineA -< i- transformA action -< (affineOf at,i)--rotateA :: (CoordinateSystemClass s,StateOf m ~ s) => Vector3D -> Rate Angle -> FRP e m j p -> FRP e m j p-rotateA v a = animateA (rotationA v a)-\end{code}--\subsection{Camera Relative Animators}--\texttt{pointAtCameraA} always points at the camera, using a single rotation.--\begin{code}-pointAtCameraA :: (Arrow a,ArrowState s a,CoordinateSystemClass s,ScenicAccumulator s m,ModelType model) => a (SceneLayer,m model) ()-pointAtCameraA = proc (slayer,the_model) ->- do cs <- arr getCoordinateSystem <<< fetch -< ()- accumulateSceneA -< (slayer,cameraRelativeSceneObject $ \c -> - liftM ((rotateToFrom (vectorToFrom (migrateToFrom root_coordinate_system cs $ camera_position c) $ origin_point_3d)- (Vector3D 0 1 0)) . wrapAffine) (liftM toIntermediateModel the_model))-\end{code}--\subsection{Particle Physics Models}--\begin{code}-type PV = (Point3D,Rate Vector3D)-type PVA = (Point3D,Rate Vector3D,Acceleration Vector3D)-type ForceFunction = Time -> Point3D -> Rate Vector3D -> Acceleration Vector3D-\end{code}--\texttt{inverseSquareLaw} produces a \texttt{ForceFunction} that attracts a particle as though by-a gravitational singularity.--\begin{code}-inverseSquareLaw :: RSdouble -> Point3D -> ForceFunction-inverseSquareLaw g attractor _ p _ = perSecond $ perSecond $ vectorScaleTo (g * (recip $ vectorLengthSquared v)) v- where v = vectorToFrom attractor p-\end{code}--\texttt{quadraticTrap} is the inverse of the inverse square law. Because the attraction increases with-distance, all particles are trapped (there is no escape velocity).--\begin{code}-quadraticTrap :: RSdouble -> Point3D -> ForceFunction-quadraticTrap g attractor _ p _ = perSecond $ perSecond $ vectorScaleTo (g * vectorLengthSquared v) v- where v = vectorToFrom attractor p-\end{code}--\texttt{drag} behaves like simple aerodynamic drag.--\begin{code}-drag :: RSdouble -> ForceFunction-drag x _ _ v' = perSecond $ perSecond $ vectorScaleTo (negate $ x * vectorLengthSquared v) v- where v = v' `over` fromSeconds 1-\end{code}--\texttt{concatForces} combines any arbitrary group of \texttt{ForceFunction}s.--\begin{code}-concatForces :: [ForceFunction] -> ForceFunction-concatForces ffs t p v = abstractSum $ map (\f -> f t p v) ffs-\end{code}--\texttt{constrainForce} acts as a conditional for \texttt{ForceFunction}s.--\begin{code}-constrainForce :: (Time -> Point3D -> Rate Vector3D -> Bool) -> ForceFunction -> ForceFunction-constrainForce predicate f t p v = if predicate t p v- then f t p v- else zero-\end{code}--\texttt{accelerationModel} implements the \texttt{ForceFunction}s on a single particle.--\begin{code}-accelerationModel :: (CoordinateSystemClass s,StateOf m ~ s) => - Frequency -> PV -> FRP e m j ForceFunction ->- FRP e m (PVA,j) p -> FRP e m j p-accelerationModel f pv forceA actionA = proc j ->- do (p,v) <- integralRK4' f (flip translate) pv <<< forceA -< j- a <- derivative -< v- transformA actionA -< (affineOf $ translate (vectorToFrom p origin_point_3d),((p,v,a),j))-\end{code}
+ RSAGL/Animation/InverseKinematics.hs view
@@ -0,0 +1,204 @@+{-# LANGUAGE Arrows,+ ExistentialQuantification,+ UndecidableInstances,+ TypeFamilies #-}++module RSAGL.Animation.InverseKinematics+ (leg,+ LegStyle(..),+ Leg,+ jointAnimation,+ legs,+ approach,+ approachFrom,+ approachA)+ where++import Control.Arrow+import RSAGL.Math.Vector+import RSAGL.FRP+import RSAGL.Math.Affine+import RSAGL.Scene.CoordinateSystems+import RSAGL.Animation.KinematicSensors+import RSAGL.Animation.Joint+import RSAGL.Math.AbstractVector+import RSAGL.Math.Angle+import RSAGL.Math.FMod+import RSAGL.Math.Types++-- | This simulates a single foot that hops along by itself whenever its+-- coordinate system moves. A foot always trys to walk on the plane @y == 0@.+-- foot takes as input a boolean which, if true, indicates that there are not+-- enough feet on the ground and that this \texttt{foot} should perform an+-- \"emergency foot down.\" 'foot' ignores the emergency foot down flag if it+-- is already down. 'foot' emits the position of the foot and a boolean+-- which indicates if the foot is up (True) or down (False).++-- foot works by reading two odometers, one for forward movement and another for+-- sideways movement. This is like spinning the wheel by a magical odometer+-- instead of spinning the odometer by the wheel. (INVERSE kinematics!)+--+-- 'pre_stepage' is the total odometer reading for all travel in both+-- directions. 'stepage_adjustment' is the amount by which we need to increase+-- 'pre_stepage' to ensure that the foot is correct based on an accumulation of+-- emergency foot downs. 'cyclic_stepage' is a value between 0 and 2,+-- where a value greater than 1 indicates that the foot is down.+foot :: (CoordinateSystemClass s,s ~ StateOf m) =>+ RSdouble ->+ RSdouble ->+ RSdouble ->+ FRP e m Bool (CSN Point3D,Bool)+foot forward_radius side_radius lift_radius = proc emergency_footdown ->+ -- total forward travel of the foot:+ do fwd_total_stepage <- arr (* recip (2*forward_radius)) <<<+ odometer root_coordinate_system (Vector3D 0 0 1) -< ()+ -- total sideways travel of the foot+ side_total_stepage <- arr (* recip (2*side_radius)) <<<+ odometer root_coordinate_system (Vector3D 1 0 0) -< ()+ -- total travel of the foot+ let pre_stepage = sqrt $ fwd_total_stepage^2 + side_total_stepage^2+ -- adjustment to comply with \"emergency foot downs.\"+ stepage_adjustment <- integralRK4 fps30 add 0 -<+ (\_ p -> if (p + pre_stepage) `fmod` 2 < 1 && emergency_footdown+ then perSecond 1+ else perSecond 0)+ let adjusted_stepage = stepage_adjustment + pre_stepage+ -- a value between 0 and 2, where a value greater than 1 indicates that+ -- the foot is down+ let cyclic_stepage = (`fmod` 2) $ adjusted_stepage+ motion <- derivative -< adjusted_stepage+ let foot_lift = max 0 $ min 1 (motion `over` fromSeconds 1) *+ lift_radius *+ (sine $ fromRotations (cyclic_stepage / 2))+ let stepage_offset = if cyclic_stepage > 1+ then 1.5 - cyclic_stepage+ else cyclic_stepage - 0.5+ let step_vector = scale (Vector3D (2*side_radius) 0 (2*forward_radius)) $+ vectorScaleTo stepage_offset $+ Vector3D side_total_stepage 0 fwd_total_stepage+ foot_position <- importA <<<+ arr (remoteCSN root_coordinate_system $ scale (Vector3D 1 0 1)) <<<+ exportA -< translate step_vector origin_point_3d+ csn_foot_position <- exportA -<+ translate (Vector3D 0 foot_lift 0) foot_position+ returnA -< (csn_foot_position,cyclic_stepage > 1)++data LegStyle = Upright | Insectoid++-- | A description of a leg.+data Leg e m = Leg (FRP e m [Bool] [Bool])++instance (CoordinateSystemClass s,StateOf m ~ s) =>+ AffineTransformable (Leg e m) where+ transform m (Leg l) =+ Leg (proc x -> transformA l -< (Affine $ transform m,x))++-- | Constructs a leg, based on several parameters.+-- See the descriptions of 'foot' and 'joint' for+-- more information on how some of these parameters+-- are interpreted.+--+-- * style - See LegStyle.+-- * bend - The bend vector of the articulated joint+-- * base - the base or shoulder or fixed point of the joint+-- * len - the total length of the articulation+-- * end - the natural resting point of the foot+-- the foot will rarely actually be here,+-- but will try to return to this point+-- as it walks.+-- * animation - an animation to display the joint+leg :: (CoordinateSystemClass s,StateOf m ~ s) =>+ LegStyle ->+ Vector3D ->+ Point3D ->+ RSdouble ->+ Point3D ->+ (FRP e m Joint ()) ->+ Leg e m+leg style bend base len end animation = Leg $ proc feet_that_are_down ->+ do let declare_emergency_foot_down =+ length (filter id feet_that_are_down) <+ length (filter not feet_that_are_down) &&+ not (and $ take 1 feet_that_are_down)+ (p,foot_is_down) <- first importA <<<+ transformA (foot foot_radius foot_radius (foot_radius/5)) -<+ (Affine $ translate (vectorToFrom end origin_point_3d),+ declare_emergency_foot_down)+ animation -< joint bend base len p+ returnA -< (foot_is_down || declare_emergency_foot_down) :+ feet_that_are_down+ where insectoid_style = sqrt (len^2 - foot_ideal_distance_squared) / 4+ upright_style = case (base,end) of+ (Point3D _ base_y _,Point3D _ end_y _) -> sqrt $ len^2 - (base_y - end_y)^2+ foot_ideal_distance_squared = distanceBetweenSquared base end+ foot_radius = case style of+ Insectoid -> insectoid_style+ Upright -> upright_style++-- | Combines a group of legs into a group that will try to keep at least half+-- of the legs on the ground at all times.+legs :: [Leg e m] -> FRP e m () ()+legs ls = (foldl (>>>) (arr $ const []) $ map (\(Leg l) -> l) ls) >>>+ (arr $ const ())++-- | Animates the upper and lower limbs of a joint into a single animation,+-- using the affine transformations 'joitn_arm_upper' and 'joint_arm_lower'.+jointAnimation :: (CoordinateSystemClass s,StateOf m ~ s) =>+ FRP e m () () ->+ FRP e m () () ->+ FRP e m Joint ()+jointAnimation upperJoint lowerJoint = proc j ->+ do transformA upperJoint -< (affineOf $ joint_arm_upper j,())+ transformA lowerJoint -< (affineOf $ joint_arm_lower j,())++-- | An acceleration function that that tries to approach a goal point.+-- It begins slowing down when it comes within the goal radius, and otherwise+-- travels at a fixed speed toward the goal. The goal radius and speed are+-- defined in terms of the magnitude method of the vector type.+--+-- This function is just a pure differential equation, see 'approachFrom'+-- and 'approachA'.+--+-- Parameters are:+-- * A goal point.+-- * A goal radius.+-- * An approach speed.+--+approach :: (AbstractVector v,AbstractSubtract p v,AbstractMagnitude v) =>+ p ->+ RSdouble ->+ Rate RSdouble ->+ (Time -> p -> Rate v)+approach goal_point goal_radius max_speed _ position =+ withTime (fromSeconds 1)+ (\x -> abstractScaleTo (x * speed_ratio) goal_vector)+ max_speed+ where goal_vector = goal_point `sub` position+ speed_ratio = min 1 $ magnitude goal_vector / goal_radius++-- | Approach a moving goal point from the specified starting point.+-- See the description of 'approach'.+approachFrom :: (AbstractVector v,+ AbstractAdd p v,+ AbstractSubtract p v,+ AbstractMagnitude v) =>+ RSdouble ->+ Rate RSdouble ->+ p ->+ FRP e m p p+approachFrom goal_radius max_speed initial_value = proc goal_point ->+ integralRK4 frequency add initial_value -<+ approach goal_point goal_radius max_speed+ where frequency = 1 `per` time goal_radius max_speed++-- | Approach a moving goal point, starting at the initial+-- position of the goal point. The particle won't move+-- until the goal point moves.+approachA :: (AbstractVector v,+ AbstractAdd p v,+ AbstractSubtract p v,+ AbstractMagnitude v,+ FRPModel m) => RSdouble -> Rate RSdouble -> FRP e m p p+approachA goal_radius max_speed = frp1Context $ proc p -> switchContinue -<+ (Just $ approachFrom goal_radius max_speed p,p)+
− RSAGL/Animation/InverseKinematics.lhs
@@ -1,114 +0,0 @@-\section{Inverse Kinematics}--\begin{code}-{-# LANGUAGE Arrows, ExistentialQuantification, UndecidableInstances, TypeFamilies #-}--module RSAGL.Animation.InverseKinematics- (leg,- Leg,- jointAnimation,- legs,- approach,- approachFrom,- approachA)- where--import Control.Arrow-import RSAGL.Math.Vector-import RSAGL.FRP-import RSAGL.Math.Affine-import RSAGL.Scene.CoordinateSystems-import RSAGL.Animation.KinematicSensors-import RSAGL.Animation.Joint-import RSAGL.Math.AbstractVector-import RSAGL.Math.Angle-import RSAGL.Math.FMod-import RSAGL.Types-\end{code}--\subsection{The Foot}--This simulates a single foot that hops along by itself whenever its coordinate system moves. A \texttt{foot} always trys to walk on the plane \texttt{y == 0}.-\texttt{foot} takes as input a boolean which, if true, indicates that there are not enough feet on the ground and that this \texttt{foot} should perform an-``emergency foot down.'' \texttt{foot} ignores the emergency foot down flag if it is already down. \texttt{foot} emits the position of the foot and a boolean-which indicates if the foot is up (\texttt{True}) or down (\texttt{False}).--\texttt{foot} works by reading two odometers, one for forward movement and another for sideways movement. This is like spinning the wheel by a magical odometer-instead of spinning the odometer by the wheel.--\texttt{pre\_stepage} is the total odometer reading for all travel in both directions. \texttt{stepage\_adjustment} is the amount by which we need to increase-\texttt{pre\_stepage} to ensure that the foot is correct based on an accumulation of emergency foot downs. \texttt{cyclic\_stepage} is a value between 0 and 2,-where a value greater than 1 indicates that the foot is down.--FIXME: this could be done better.--\begin{code}-foot :: (CoordinateSystemClass s,s ~ StateOf m) => RSdouble -> RSdouble -> RSdouble -> FRP e m Bool (CSN Point3D,Bool)-foot forward_radius side_radius lift_radius = proc emergency_footdown ->- do fwd_total_stepage <- arr (* recip forward_radius) <<< odometer root_coordinate_system (Vector3D 0 0 1) -< ()- side_total_stepage <- arr (* recip side_radius) <<< odometer root_coordinate_system (Vector3D 1 0 0) -< ()- let pre_stepage = sqrt $ fwd_total_stepage^2 + side_total_stepage^2- stepage_adjustment <- integralRK4 fps30 add 0 -< (\_ p -> if (p + pre_stepage) `fmod` 2 < 1 && emergency_footdown then perSecond 1 else perSecond 0) - let adjusted_stepage = stepage_adjustment + pre_stepage- let cyclic_stepage = (`fmod` 2) $ adjusted_stepage- motion <- derivative -< adjusted_stepage- let foot_lift = max 0 $ min 1 (motion `over` fromSeconds 1) * lift_radius * (sine $ fromRotations (cyclic_stepage / 2))- let stepage_offset = if cyclic_stepage > 1 then 1.5 - cyclic_stepage else cyclic_stepage - 0.5- let step_vector = scale (Vector3D side_radius 0 forward_radius) $ vectorScaleTo stepage_offset $ Vector3D side_total_stepage 0 fwd_total_stepage- foot_position <- importA <<< arr (remoteCSN root_coordinate_system $ scale (Vector3D 1 0 1)) <<< exportA -< translate step_vector origin_point_3d- csn_foot_position <- exportA -< translate (Vector3D 0 foot_lift 0) foot_position- returnA -< (csn_foot_position,cyclic_stepage > 1)-\end{code}--\texttt{leg} creates a leg that tries to walk over the ground no matter how it is positioned. \texttt{legs} combines a group of legs so that at least half-of the legs always try to touch the ground.--\begin{code}-data Leg e m = Leg (FRP e m [Bool] [Bool])--instance (CoordinateSystemClass s,StateOf m ~ s) => AffineTransformable (Leg e m) where- transform m (Leg l) = Leg (proc x -> transformA l -< (Affine $ transform m,x))--leg :: (CoordinateSystemClass s,StateOf m ~ s) => Vector3D -> Point3D -> RSdouble -> Point3D -> (FRP e m Joint ()) -> Leg e m-leg bend base len end animation = Leg $ proc feet_that_are_down ->- do let declare_emergency_foot_down = length (filter id feet_that_are_down) < length (filter not feet_that_are_down) &&- not (and $ take 1 feet_that_are_down)- (p,foot_is_down) <- first importA <<< - transformA (foot foot_radius foot_radius (foot_radius/5)) -< (Affine $ translate (vectorToFrom end origin_point_3d),declare_emergency_foot_down)- animation -< joint bend base len p- returnA -< (foot_is_down || declare_emergency_foot_down) : feet_that_are_down- where foot_radius = sqrt (len^2 - (distanceBetween base end)^2) / 2--legs :: [Leg e m] -> FRP e m () ()-legs ls = (foldl (>>>) (arr $ const []) $ map (\(Leg l) -> l) ls) >>> (arr $ const ())-\end{code}--\texttt{jointAnimation} is just a simple combinator to combine the upper and lower components of a joint into an animated Joint.--\begin{code}-jointAnimation :: (CoordinateSystemClass s,StateOf m ~ s) => FRP e m () () -> FRP e m () () -> FRP e m Joint ()-jointAnimation upperJoint lowerJoint = proc j ->- do transformA upperJoint -< (affineOf $ joint_arm_upper j,())- transformA lowerJoint -< (affineOf $ joint_arm_lower j,())-\end{code}--\subsection{Approach}--\texttt{approach} is an acceleration function that that tries to approach a goal point. It begins slowing down when it comes within-the goal radius, and otherwise travels at a fixed speed toward the goal. The goal radius and speed are defined in terms of the-\texttt{magnitude} of the vector type.--\begin{code}-approach :: (AbstractVector v,AbstractSubtract p v,AbstractMagnitude v) => p -> RSdouble -> Rate RSdouble -> (Time -> p -> Rate v)-approach goal_point goal_radius max_speed _ position = withTime (fromSeconds 1) (\x -> abstractScaleTo (x * speed_ratio) goal_vector) max_speed- where goal_vector = goal_point `sub` position- speed_ratio = min 1 $ magnitude goal_vector / goal_radius--approachFrom :: (AbstractVector v,AbstractAdd p v, AbstractSubtract p v,AbstractMagnitude v) => RSdouble -> Rate RSdouble -> p -> FRP e m p p-approachFrom goal_radius max_speed initial_value = proc goal_point -> integralRK4 frequency add initial_value -< approach goal_point goal_radius max_speed- where frequency = 1 `per` time goal_radius max_speed --approachA :: (AbstractVector v,AbstractAdd p v,AbstractSubtract p v,AbstractMagnitude v,FRPModel m) => RSdouble -> Rate RSdouble -> FRP e m p p-approachA goal_radius max_speed = frp1Context $ proc p -> switchContinue -< (Just $ approachFrom goal_radius max_speed p,p)-\end{code}-
+ RSAGL/Animation/Joint.hs view
@@ -0,0 +1,53 @@+module RSAGL.Animation.Joint+ (Joint(..),+ joint) where++import RSAGL.Math.Vector+import RSAGL.Math.Affine+import RSAGL.Math.Interpolation+import RSAGL.Scene.CoordinateSystems+import RSAGL.Math.Orthogonal+import RSAGL.Math.Types++-- | The result of computing a joint. It provides AffineTransformations that+-- describe the orientations of the components of the joint.+-- All affine transformations reorient the +Z axis to aim in the direction+-- of the far point. For example, in @joint_arm_lower@ the +Z axis aims+-- at the position of the hand.+data Joint = Joint { joint_shoulder :: Point3D,+ -- ^ The fixed point of the joint.+ joint_hand :: Point3D,+ -- ^ The far end point of the joint.+ joint_elbow :: Point3D,+ -- ^ The articulated point of the joint.+ joint_arm_lower :: AffineTransformation,+ -- ^ The affine transformation to the lower+ -- arm, where the origin is the elbow.+ joint_arm_upper :: AffineTransformation,+ -- ^ The affine transformation to the upper+ -- arm, where the origin is the shoulder.+ joint_arm_hand :: AffineTransformation+ -- ^ The affine transformation where the origin+ -- is the hand. Oriented to preserve as much as+ -- possible the +Y axis.+ }++-- | Compute a joint where given a bend vector, describing the direction+-- in which the articulated point (elbow) will try to move when the+-- arm is retracted, and shoulder or base of the joint, the total+-- length of the joint, and ideal position of the hand.+joint :: Vector3D -> Point3D -> RSdouble -> Point3D -> Joint+joint bend shoulder joint_length hand | distanceBetween shoulder hand > joint_length = -- if the end is out of range, constrict it to within range+ joint bend shoulder joint_length (translate (vectorScaleTo (0.99 * joint_length) $ vectorToFrom hand shoulder) shoulder)+joint bend shoulder joint_length hand = Joint {+ joint_shoulder = shoulder,+ joint_hand = hand,+ joint_elbow = elbow,+ joint_arm_lower = modelLookAt elbow (forward $ Left hand) (down $ Right bend),+ joint_arm_upper = modelLookAt shoulder (forward $ Left elbow) (down $ Right bend),+ joint_arm_hand = modelLookAt hand (backward $ Left elbow) (up $ Right (Vector3D 0 1 0)) }+ where joint_offset = sqrt (joint_length^2 - (distanceBetween shoulder hand)^2) / 2+ joint_offset_vector = vectorScaleTo joint_offset $ transformation+ (orthogonalFrame (forward $ vectorToFrom hand shoulder) (down bend)) (Vector3D 0 (-1) 0)+ elbow = translate joint_offset_vector $ lerp 0.5 (shoulder,hand)+
− RSAGL/Animation/Joint.lhs
@@ -1,51 +0,0 @@-\section{Joints}--Joints are a basic essential element of the RSAGL inverse kinematics subsystem.--\begin{code}-module RSAGL.Animation.Joint- (Joint(..),- joint) where--import RSAGL.Math.Vector-import RSAGL.Math.Affine-import RSAGL.Math.Interpolation-import RSAGL.Scene.CoordinateSystems-import RSAGL.Math.Orthagonal-import RSAGL.Types-\end{code}--\texttt{Joint} is the result of computing a joint. It provides AffineTransformations that describe the orientations of the bases of the components of the joint.--\texttt{joint\_arm\_upper} is the affine transformation to the position of the upper arm, where the origin is the shoulder (or base).-\texttt{joint\_arm\_lower} is the affine transformation to the lower arm, where the origin is the elbow.-\texttt{joint\_arm\_hand} is the affine transformation where the origin is the hand.-\texttt{joint\_shoulder}, \texttt{joint\_hand}, and \texttt{joint\_elbow} refer to the positions of those endpoints of the joint.--\begin{code}-data Joint = Joint { joint_shoulder :: Point3D,- joint_hand :: Point3D,- joint_elbow :: Point3D,- joint_arm_lower :: AffineTransformation,- joint_arm_upper :: AffineTransformation,- joint_arm_hand :: AffineTransformation }-\end{code}--Compute a joint where given a bend vector, two end points, and the total length of them limb. --\begin{code}-joint :: Vector3D -> Point3D -> RSdouble -> Point3D -> Joint-joint bend shoulder joint_length hand | distanceBetween shoulder hand > joint_length = -- if the end is out of range, constrict it to within range- joint bend shoulder joint_length (translate (vectorScaleTo (0.99 * joint_length) $ vectorToFrom hand shoulder) shoulder)-joint bend shoulder joint_length hand = Joint {- joint_shoulder = shoulder,- joint_hand = hand,- joint_elbow = elbow,- joint_arm_lower = modelLookAt elbow (forward $ Left hand) (down $ Right bend),- joint_arm_upper = modelLookAt shoulder (forward $ Left elbow) (down $ Right bend),- joint_arm_hand = modelLookAt hand (backward $ Left elbow) (up $ Right (Vector3D 0 1 0)) }- where joint_offset = sqrt (joint_length^2 - (distanceBetween shoulder hand)^2) / 2- joint_offset_vector = vectorScaleTo joint_offset $ transformation- (orthagonalFrame (forward $ vectorToFrom hand shoulder) (down bend)) (Vector3D 0 (-1) 0)- elbow = translate joint_offset_vector $ lerp 0.5 (shoulder,hand)-\end{code}
+ RSAGL/Animation/KinematicSensors.hs view
@@ -0,0 +1,34 @@+{-# LANGUAGE TypeFamilies, Arrows #-}++module RSAGL.Animation.KinematicSensors+ (odometer,+ inertia)+ where++import Control.Arrow+import RSAGL.Math.Vector+import RSAGL.FRP+import RSAGL.Scene.CoordinateSystems+import RSAGL.Math++-- | Measures the distance traveled, by the origin of the local coordinate+-- system, as measured in a remote coordinate system, in terms+-- of a vector in the local coordinate system.+--+-- For example, if we are animating a model of a wheel, we could put an+-- odometer at the bottom-most point of the wheel, and then rotate+-- the wheel according to the result. The wheel would seem to+-- turn as it travels, but would not turn when dragged sidewise.+odometer :: (CoordinateSystemClass s,StateOf m ~ s) => CoordinateSystem -> Vector3D -> FRP e m () RSdouble+odometer cs measurement_vector_ =+ arr (const origin_point_3d) >>> exportToA cs >>> derivative >>> importFromA cs >>>+ arr (withTime (fromSeconds 1) (dotProduct measurement_vector)) >>>+ integral 0+ where measurement_vector = vectorNormalize measurement_vector_++-- | Measures the (presumed) acceleration due to inertia of a point+-- in the local coordinate system, relative to a (presumably) inertial frame a reference.+inertia :: (CoordinateSystemClass s,StateOf m ~ s) =>+ CoordinateSystem -> Point3D -> FRP e m () (Acceleration Vector3D)+inertia cs p = proc () -> arr (scalarMultiply (-1)) <<< derivative <<< derivative <<< exportToA cs -< p+
− RSAGL/Animation/KinematicSensors.lhs
@@ -1,33 +0,0 @@-\section{Sensors for Inverse Kinematics}--These are various composable modules that provide physics information for the inverse kinematics system.--\begin{code}--{-# LANGUAGE TypeFamilies #-}--module RSAGL.Animation.KinematicSensors- (odometer)- where--import Control.Arrow-import RSAGL.Math.Vector-import RSAGL.FRP-import RSAGL.Scene.CoordinateSystems-import RSAGL.Types-\end{code}--\subsection{Odometer}--The \texttt{odometer} indicates the distance traveled in a remote coordinate system along a vector in the local coordinate system.-It does not measure side-to-side motion, only motion in the direction of the vector.--\begin{code}-odometer :: (CoordinateSystemClass s,StateOf m ~ s) => CoordinateSystem -> Vector3D -> FRP e m () RSdouble-odometer cs measurement_vector_ =- arr (const origin_point_3d) >>> exportToA cs >>> derivative >>> importFromA cs >>>- arr (withTime (fromSeconds 1) (dotProduct measurement_vector)) >>>- integral 0- where measurement_vector = vectorNormalize measurement_vector_-\end{code}-
RSAGL/Auxiliary/ApplicativeWrapper.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleContexts, MultiParamTypeClasses, UndecidableInstances #-} module RSAGL.Auxiliary.ApplicativeWrapper (ApplicativeWrapper(..),@@ -12,6 +12,7 @@ import Control.Applicative import Data.Maybe import Control.Parallel.Strategies+import RSAGL.Math.AbstractVector -- | 'ApplicativeWrapper' captures an applicative entity and remembers whether the entity is pure. newtype ApplicativeWrapper f a = ApplicativeWrapper (Either (f a) a)@@ -27,6 +28,20 @@ instance (NFData (f a),NFData a) => NFData (ApplicativeWrapper f a) where rnf (ApplicativeWrapper ethr) = rnf ethr++instance (Applicative f,AbstractZero p) => AbstractZero (ApplicativeWrapper f p) where+ zero = pure zero++instance (Applicative f,AbstractAdd p v) => AbstractAdd (ApplicativeWrapper f p) (ApplicativeWrapper f v) where+ add p v = add <$> p <*> v++instance (Applicative f,AbstractSubtract p v) => AbstractSubtract (ApplicativeWrapper f p) (ApplicativeWrapper f v) where+ sub x y = sub <$> x <*> y++instance (Applicative f,AbstractScale v) => AbstractScale (ApplicativeWrapper f v) where+ scalarMultiply d v = scalarMultiply d <$> v++instance (Applicative f,AbstractVector v) => AbstractVector (ApplicativeWrapper f v) fromPure :: (Applicative f) => ApplicativeWrapper f a -> Maybe a fromPure = either (const Nothing) Just . unwrapApplicative
RSAGL/Auxiliary/Auxiliary.hs view
@@ -18,7 +18,7 @@ import Control.Parallel import Control.Parallel.Strategies import Debug.Trace-import RSAGL.Types+import RSAGL.Math.Types -- doubles transforms a list to a list of adjacent elements. @@ -116,3 +116,4 @@ waitParList :: Strategy a -> Strategy [a] waitParList s a = parList s a `pseq` seqList s a+
− RSAGL/Auxiliary/RecombinantState.hs
@@ -1,16 +0,0 @@-{-# LANGUAGE TypeFamilies #-}-module RSAGL.Auxiliary.RecombinantState- (RecombinantState(..))- where---- | Describes concurrency-aware state. The goal is to take some stateful information, clone it into a variety of concurrent threads,--- and then recombine with the (possibly modified) state as the concurrent threads complete.-class RecombinantState s where- type SubState s :: *- clone :: s -> SubState s- recombine :: s -> SubState s -> s--instance RecombinantState () where- type SubState () = ()- clone = id- recombine = const
+ RSAGL/Color.hs view
@@ -0,0 +1,59 @@+{-# LANGUAGE MultiParamTypeClasses #-}+module RSAGL.Color+ (module RSAGL.Color.RGB,+ module RSAGL.Color.Alpha,+ module RSAGL.Color.HCL,+ module RSAGL.Color.Spaces,+ module RSAGL.Color.Channels,+ module RSAGL.Color.LinearAdjust,+ module RSAGL.Color.ColorSpace,+ module RSAGL.Color.OpenGL,+ RGBA,+ rgba,+ minRGB,+ invertRGB,+ filterRGB,+ filterRGBLinear)+ where++import RSAGL.Color.RGB+import RSAGL.Color.Alpha+import RSAGL.Color.HCL+import RSAGL.Color.ColorSpace+import RSAGL.Color.Spaces+import RSAGL.Color.Channels+import RSAGL.Color.LinearAdjust+import RSAGL.Color.OpenGL+import Control.Parallel.Strategies+import Graphics.Rendering.OpenGL.Raw.Core31 (GLdouble,GLfloat)+import Graphics.Rendering.OpenGL hiding (RGB,RGBA,Alpha)+import RSAGL.Math.AbstractVector+import RSAGL.Math.Interpolation+import RSAGL.Math.Types++type RGBA = Alpha RGB++-- | Construct an RGBA color.+rgba :: RSdouble -> RSdouble -> RSdouble -> RSdouble -> RGBA+rgba r g b a = Alpha a $ RGB r g b++-- | maps an RGB color between a black point and a white point.+-- The first parameter, the black point, will map to RGB 0 0 0.+-- The second parameter, the white point, will map to RGB 1 1 1.+filterRGBLinear :: RGB -> RGB -> RGB -> RGB+filterRGBLinear black_point white_point = zipRGB3+ (\b w c -> lerpBetweenClamped (b,c,w) (0,1)) black_point white_point++-- | Get the minimum of the three RGB components.+minRGB :: RGB -> RSdouble+minRGB (RGB r g b) = min r (min g b)++filterRGB :: RGB -> RGB -> RGB+filterRGB = zipRGB (*)++-- | Arithmetic inverse of a color.+invertRGB :: RGB -> RGB+invertRGB = mapRGB (1-)++---------------------------------------------------------------------------+
+ RSAGL/Color/Alpha.hs view
@@ -0,0 +1,48 @@+{-# LANGUAGE MultiParamTypeClasses #-}+module RSAGL.Color.Alpha+ (Alpha(..),alpha,alpha256)+ where++import RSAGL.Math.Types+import RSAGL.Color.Auxiliary+import RSAGL.Math.AbstractVector+import Control.Parallel.Strategies+import Control.Applicative+import RSAGL.Color.ColorSpace++-- | A color with an alpha channel.+data Alpha c = Alpha {+ alpha_alpha :: {-# UNPACK #-} !RSdouble,+ alpha_color :: !c }++instance (NFData c) => NFData (Alpha c) where+ rnf (Alpha a c) = rnf c++instance Functor Alpha where+ fmap f (Alpha a c) = Alpha a $ f c++instance (ImportColorCoordinates c) => ImportColorCoordinates (Alpha c) where+ importColorCoordinates f = Alpha 1.0 $ importColorCoordinates f++-- | Apply (more) transparency to a color.+alpha :: RSdouble -> Alpha c -> Alpha c+alpha x (Alpha a c) = Alpha (a*x) c++-- | In the range \[0..255\].+alpha256 :: (Integral i) => i -> Alpha c -> Alpha c+alpha256 i = alpha (i2f256 i)++instance (AbstractZero c) => AbstractZero (Alpha c) where+ zero = Alpha 0 zero++instance (AbstractAdd c c) => AbstractAdd (Alpha c) (Alpha c) where+ add (Alpha a1 c1) (Alpha a2 c2) = Alpha (a1 + a2) (c1 `add` c2)++instance (AbstractSubtract c c) => AbstractSubtract (Alpha c) (Alpha c) where+ sub (Alpha a1 c1) (Alpha a2 c2) = Alpha (a1 - a2) (c1 `sub` c2)++instance (AbstractScale c) => AbstractScale (Alpha c) where+ scalarMultiply d (Alpha a c) = Alpha (d*a) $ scalarMultiply d c++instance (AbstractVector c) => AbstractVector (Alpha c)+
+ RSAGL/Color/Auxiliary.hs view
@@ -0,0 +1,11 @@+module RSAGL.Color.Auxiliary+ (i2f256)+ where++import RSAGL.Math.Types++-- | Convert a value in the range \[0..255\] to the range+-- \[0.0..1.0\].+i2f256 :: (Integral i) => i -> RSdouble+i2f256 = (/ 255) . fromIntegral+
+ RSAGL/Color/Channels.hs view
@@ -0,0 +1,87 @@+module RSAGL.Color.Channels+ (channel_red,+ channel_green,+ channel_blue,+ channel_luminance,+ channel_chroma,+ channel_cyan,+ channel_magenta,+ channel_yellow,+ channel_brightness,+ channel_red_cyan,+ channel_blue_yellow,+ channel_green_magenta,+ channel_value,+ channel_boldness,+ channel_intensity)+ where++import RSAGL.Color.ColorSpace+import RSAGL.Math.Angle+import RSAGL.Color.Spaces++-- | The red channel of the RGB color space.+channel_red :: ColorChannel+channel_red = newChannel channel_u color_space_rgb++-- | The green channel of the RGB color space.+channel_green :: ColorChannel+channel_green = newChannel channel_v color_space_rgb++-- | The blue channel of the RGB color space.+channel_blue :: ColorChannel+channel_blue = newChannel channel_w color_space_rgb++-- | The Chroma (colorfulness) of a color, isotropic to luminance.+channel_chroma :: ColorChannel+channel_chroma = newRadialChannel color_wheel_rgbl++-- | Luminance of a color as percieved by the human eye.+channel_luminance :: ColorChannel+channel_luminance = newChannel channel_w color_wheel_rgbl++-- | The cyan channel of the CMY color space.+channel_cyan :: ColorChannel+channel_cyan = newChannel channel_u color_space_cmy++-- | The magenta channel of the CMY color space.+channel_magenta :: ColorChannel+channel_magenta = newChannel channel_v color_space_cmy++-- | The yellow channel of the CMY color space.+channel_yellow :: ColorChannel+channel_yellow = newChannel channel_w color_space_cmy++-- | The brightness channel in simple device interpretation.+-- That is, (red + green + blue) / 3.+channel_brightness :: ColorChannel+channel_brightness = newChannel channel_w color_wheel_rgb_brightness++-- | A red (1.0) vs. cyan (-1.0) channel.+channel_red_cyan :: ColorChannel+channel_red_cyan = newAngularChannel color_wheel_red_cyan_iso (fromDegrees 0)++-- | A blue (1.0) vs. yellow (-1.0) channel.+channel_blue_yellow :: ColorChannel+channel_blue_yellow = newAngularChannel color_wheel_blue_yellow_iso (fromDegrees 240)++-- | A green (1.0) vs. magenta (-1.0) channel.+channel_green_magenta :: ColorChannel+channel_green_magenta = newAngularChannel color_wheel_green_magenta_iso (fromDegrees 120)++-- | The maximum channel of the additive RGB color space.+-- This is identical to the value channel of the HSB color model.+-- This channel represents the device gamut: it should be between 0 and 1.+channel_value :: ColorChannel+channel_value = newMaximalChannel color_space_rgb++-- | The maximum channel of the subtractive CMY color space.+-- This channel represents the device gamut: it should be between 0 and 1.+channel_boldness :: ColorChannel+channel_boldness = newMaximalChannel color_space_cmy++-- | The maximum channel of the neutral RGB color space.+-- This channel represents the device gamut: it should be between -1 and 1.+channel_intensity :: ColorChannel+channel_intensity = newMaximalChannel color_space_neutral+
+ RSAGL/Color/ColorSpace.hs view
@@ -0,0 +1,297 @@+module RSAGL.Color.ColorSpace+ (ColorSpace(..),+ ImportColorCoordinates(..),+ ExportColorCoordinates(..),+ AffineColorSpace,+ ColorWheel,+ ColorChannel,+ ChannelIndex,+ LinearMetric(..),+ newChannel,+ newAngularChannel,+ newRadialChannel,+ newMaximalChannel,+ viewChannel,+ channel_u,+ channel_v,+ channel_w,+ newColorSpace,+ newColorWheel,+ color_space_rgb,+ color_wheel_rgbl,+ transformColorFromTo,+ transformColor)+ where++import RSAGL.Math.Types+import RSAGL.Math.Matrix+import RSAGL.Math.Vector+import RSAGL.Math.AbstractVector+import RSAGL.Math.Affine+import Data.Vec (nearZero)+import RSAGL.Math.Angle+import Control.Arrow (first,second)++-- | An affine transformation from the default RGB color space+-- to the specified color space.+newtype AffineColorSpace = AffineColorSpace Matrix+ deriving (Show)++-- | A rotatable color space.+newtype ColorWheel = ColorWheel Matrix+ deriving (Show)++-- | A specific component of a 3-channel color space.+data ColorChannel =+ -- A color space in which the 'u_channel' is the channel in question.+ LinearChannel Matrix+ -- | A channel that depends on the input color.+ | Preconfigure (Color -> ColorChannel)++-- | 'channel_u', 'channel_v', 'channel_w', of a 3-channel color space.+data ChannelIndex = ChannelIndex { channel_index :: Matrix }++-- | The first channel of a color space represented by the ordered tripple,+-- @(u,v,w)@.+channel_u :: ChannelIndex+channel_u = ChannelIndex identity_matrix++-- | The second channel of a color space represented by the ordered tripple,+-- @(u,v,w)@.+channel_v :: ChannelIndex+channel_v = ChannelIndex $ matrix+ [[0,1,0,0],+ [1,0,0,0],+ [0,0,1,0],+ [0,0,0,1]]++-- | The third channel of a color space represented by the ordered tripple,+-- @(u,v,w)@.+channel_w :: ChannelIndex+channel_w = ChannelIndex $ matrix+ [[0,0,1,0],+ [0,1,0,0],+ [1,0,0,0],+ [0,0,0,1]]++-- | Pick a channel from a color space.+newChannel :: (ColorSpace cs) => ChannelIndex -> cs -> ColorChannel+newChannel (ChannelIndex ch_ix) cs = LinearChannel $ ch_ix `matrixMultiply` m+ where (AffineColorSpace m) = affineColorSpaceOf cs++-- | Construct an isotropic 'ColorChannel' that runs along a+-- hue angle. The meaning of the hue angle depends on the+-- primary colors used in the construction of the color wheel.+newAngularChannel :: ColorWheel -> Angle -> ColorChannel+newAngularChannel (ColorWheel m) a = LinearChannel $+ rotationMatrix (Vector3D 0 0 1) (scalarMultiply (-1) a)+ `matrixMultiply`+ m++-- | Construct an isotropic 'ColorChannel' along the radii+-- of a color wheel. This is exactly like calling+-- 'newAngularChannel' knowing in advance the specific+-- hue of the color in question.+newRadialChannel :: ColorWheel -> ColorChannel+newRadialChannel (ColorWheel m) = Preconfigure $ \c ->+ let Point3D u v w = exportColorCoordinates c $ AffineColorSpace m+ (a,_) = cartesianToPolar (u,v)+ in newAngularChannel (ColorWheel m) a++-- | Construct a 'ColorChannel' representing the maximum+-- of the three color components. For example, the+-- maximum of @RGB 0.25 0.5 0.4@ is 0.5.+newMaximalChannel :: AffineColorSpace -> ColorChannel+newMaximalChannel cs@(AffineColorSpace m) = Preconfigure $ \c ->+ let Point3D u v w = exportColorCoordinates c cs+ maxi = maximum [abs u,abs v, abs w]+ magn = magnitude [u,v,w]+ in LinearChannel $+ scale' (maxi / if nearZero magn then 1.0 else magn) $+ rotateToFrom (Vector3D 1 0 0) (Vector3D u v w) $+ transform m identity_matrix++-- | A view of a specific color channel, such as red, or luminance.+data LinearMetric = LinearMetric {+ -- | The range of a color channel that is within gamut.+ -- This range depends on the channel and the particular+ -- color being observed, and may not exist if the+ -- color itself is out of gamut.+ linear_gamut_bounds :: Maybe (RSdouble,RSdouble),+ -- | A function to modify a color channel independantly+ -- from the other color channels in the same color space.+ linear_color_function :: RSdouble -> Color,+ -- | The value of the particular color channel for the+ -- particular color.+ linear_value :: RSdouble,+ -- | The original color.+ linear_original :: Color }++instance Show LinearMetric where+ show x = show (linear_gamut_bounds x,+ linear_value x,+ exportColorCoordinates (linear_original x) color_space_rgb)++-- | Read a specific channel of a color.+viewChannel :: (ExportColorCoordinates c) =>+ ColorChannel -> c -> LinearMetric+viewChannel (LinearChannel m) c = LinearMetric {+ linear_gamut_bounds = case intersections of+ [] -> Nothing+ is -> Just (minimum is,maximum is),+ linear_color_function = \x -> importColorCoordinates $+ transformColorFromTo (AffineColorSpace m) (Point3D x v w),+ linear_value = u,+ linear_original = transformColor c }+ where Point3D u v w = exportColorCoordinates c $ AffineColorSpace m+ rgb@(Point3D r g b) = exportColorCoordinates c color_space_rgb+ -- The vector describinb an adjustment of the specified+ -- color channel.+ rgb'@(Vector3D r' g' b') = colorVectorOf (AffineColorSpace m)+ (Vector3D 1 0 0)+ -- Find the intersections between the vector describing an+ -- adjustment of the specified channel and the boundaries+ -- of the RGB gamut's color cube.+ intersections = map (+u) $ filter gamutValid $+ map (uncurry (/)) $ filter (not . nearZero . snd)+ [(1-r,r'),(1-g,g'),(1-b,b'),+ (-r,r'),(-g,g'),(-b,b')]+ -- Construct the color with a particular linear adjustment of the+ -- specified color channel+ colorFunction x = rgb `add` scalarMultiply x rgb'+ -- Test that a color is within the RGB device gamut.+ gamutValid x = let Point3D r'' g'' b'' = colorFunction x+ in (>=3) $ length $ filter (>= (-0.001)) $ filter (<= 1.001) $ [r'',g'',b'']+viewChannel (Preconfigure f) c =+ viewChannel (f $ transformColor c) c++-- | A color space specification or color type that has an associated+-- color space.+--+-- If a type implements both 'ImportColorCoordinates' and+-- 'ColorSpace', then it must ensure that:+--+-- @importColorCoordinates f =+-- (let c = importColorCoordinates (const $ f $ affineColorSpaceOf c) in c)@+--+-- This is not hard -- all that is required is that+-- @affineColorSpaceOf undefined@ is defined.+--+class ColorSpace cs where+ affineColorSpaceOf :: cs -> AffineColorSpace++-- | A color type that can export its color coordinates.+-- An easy implementation is+--+-- @transformColorFromTo your_color_space your_color_coordinates@+--+-- If a type implements both 'ExportColorCoordinates' and+-- 'ImportColorCoordinates', then it must ensure that+-- @importColorCoordinates . exportColorCoordinates = id@.+--+class ExportColorCoordinates c where+ exportColorCoordinates ::+ c -> AffineColorSpace -> Point3D++-- | A color type that can import its color coordinates.+class ImportColorCoordinates c where+ importColorCoordinates ::+ (AffineColorSpace -> Point3D) -> c++instance ColorSpace AffineColorSpace where+ affineColorSpaceOf = id++instance ColorSpace ColorWheel where+ affineColorSpaceOf (ColorWheel m) = AffineColorSpace m++-- | A generic representation of Color.+newtype Color = Color { fromColor ::+ AffineColorSpace -> Point3D }++instance ExportColorCoordinates Color where+ exportColorCoordinates = fromColor++instance ImportColorCoordinates Color where+ importColorCoordinates = Color++-- | Construct a new color space. This requires a minimal point+-- (the black point in an additive color space, or the white point+-- in a subtractive color space), and three primary colors.+-- The three primarys color correspond to the 'channel_u',+-- 'channel_v', and 'channel_w' respectively.+newColorSpace :: (ExportColorCoordinates c) =>+ c -> c -> c -> c -> AffineColorSpace+newColorSpace k u v w = AffineColorSpace $ matrixInverse $+ translationMatrix (vectorToFrom k' zero)+ `matrixMultiply`+ xyzMatrix (u' `sub` k')+ (v' `sub` k')+ (w' `sub` k')+ where k' = exportColorCoordinates k color_space_rgb+ u' = exportColorCoordinates u color_space_rgb+ v' = exportColorCoordinates v color_space_rgb+ w' = exportColorCoordinates w color_space_rgb++-- | Construct a new color wheel. This requires a minimal point,+-- (the black point in an additive color space, or the white point+-- in a subtractive color space), and three primary colors with+-- assigned hue angles and value parameters.+-- The hue angle maps onto 'channel_u' and 'channel_v', while+-- the value parameter maps directly and additively onto+-- 'channel_w'.+newColorWheel :: (ExportColorCoordinates c) =>+ c -> (c,Angle,RSdouble) ->+ (c,Angle,RSdouble) ->+ (c,Angle,RSdouble) ->+ ColorWheel+newColorWheel k (u,theta_u,u') (v,theta_v,v') (w,theta_w,w') =+ ColorWheel $ uvw_to_wheel `matrixMultiply` matrixInverse uvw_to_rgb+ where uvw_to_wheel = matrix $+ [ [cosine theta_u, cosine theta_v, cosine theta_w, 0 ],+ [ sine theta_u, sine theta_v, sine theta_w, 0 ],+ [ u', v', w', 0 ],+ [ 0, 0, 0, 1 ] ]+ AffineColorSpace uvw_to_rgb = newColorSpace k u v w++-- | A color wheel constructed with red, green and blue device primaries+-- and a luminance component. This is the basis of the HCL color system.+{-# NOINLINE color_wheel_rgbl #-}+color_wheel_rgbl :: ColorWheel+color_wheel_rgbl = ColorWheel $ matrix $+ [ [1.0 , -0.5 , -0.5 , 0.0],+ [0.0 , (sqrt 3/2) , (negate $ sqrt 3 / 2) , 0.0],+ [0.2126 , 0.7152 , 0.0722 , 0.0],+ [0.0 , 0.0 , 0.0 , 1.0] ]++-- | The red-green-blue device color space.+{-# NOINLINE color_space_rgb #-}+color_space_rgb :: AffineColorSpace+color_space_rgb = AffineColorSpace $ identity_matrix++-- | Transform ordered triples between color spaces.+transformColorFromTo :: AffineColorSpace ->+ Point3D ->+ AffineColorSpace ->+ Point3D+transformColorFromTo (AffineColorSpace source)+ uvw+ (AffineColorSpace destination) =+ transform (destination `matrixMultiply` matrixInverse source)+ uvw++-- | Transform a color vector into RGB space.+colorVectorOf :: AffineColorSpace ->+ Vector3D ->+ Vector3D+colorVectorOf (AffineColorSpace m) uvw =+ inverseTransform m uvw++{-# RULES+"transformColor::a->a" transformColor = id+ #-}+-- | Transform colors between color spaces.+transformColor :: (ExportColorCoordinates source,+ ImportColorCoordinates dest) =>+ source -> dest+transformColor = importColorCoordinates . exportColorCoordinates+
+ RSAGL/Color/HCL.hs view
@@ -0,0 +1,31 @@+{-# LANGUAGE MultiParamTypeClasses #-}+module RSAGL.Color.HCL+ (HCL(..))+ where++import RSAGL.Math.AbstractVector+import RSAGL.Math.Types+import RSAGL.Math.Vector+import RSAGL.Math.Angle+import RSAGL.Color.ColorSpace++-- | A color in the hue-chroma-luminance color space.+-- This is an additive color system (like RGB).+data HCL = HCL { hcl_hue :: {-# UNPACK #-} !Angle,+ hcl_chroma :: {-# UNPACK #-} !RSdouble,+ hcl_luminance :: {-# UNPACK #-} !RSdouble }+ deriving (Eq,Ord,Read,Show)++instance ColorSpace HCL where+ affineColorSpaceOf _ = affineColorSpaceOf color_wheel_rgbl++instance ExportColorCoordinates HCL where+ exportColorCoordinates (HCL h c l) =+ transformColorFromTo (affineColorSpaceOf color_wheel_rgbl) $ Point3D u v l+ where (u,v) = polarToCartesian (h,c)++instance ImportColorCoordinates HCL where+ importColorCoordinates f = HCL h c l+ where (h,c) = cartesianToPolar (u,v)+ Point3D u v l = f $ affineColorSpaceOf $ color_wheel_rgbl+
+ RSAGL/Color/LinearAdjust.hs view
@@ -0,0 +1,36 @@+module RSAGL.Color.LinearAdjust+ (LinearAdjustment,+ adjustColor,+ maximize,+ minimize,+ clamp)+ where++import Data.Maybe+import RSAGL.Math.Types+import RSAGL.Color.ColorSpace++type LinearAdjustment = LinearMetric -> RSdouble++-- | Manipulate an arbitrary component of a color.+adjustColor :: (ExportColorCoordinates c, ImportColorCoordinates c') =>+ ColorChannel -> LinearAdjustment -> c -> c'+adjustColor chan f c = transformColor $ linear_color_function metric (f metric)+ where metric = viewChannel chan c++-- | Increase a channel to a maximum in-gamut value.+maximize :: LinearAdjustment+maximize metric = maybe (linear_value metric) snd $+ linear_gamut_bounds metric++-- | Decrease a channel to it's minimum in-gamut value.+minimize :: LinearAdjustment+minimize metric = maybe (linear_value metric) fst $+ linear_gamut_bounds metric++-- | Clamp a channel to the gamut.+clamp :: LinearAdjustment+clamp metric = max lo . min hi $ linear_value metric+ where (lo,hi) = fromMaybe (linear_value metric,linear_value metric) $+ linear_gamut_bounds metric+
+ RSAGL/Color/OpenGL.hs view
@@ -0,0 +1,26 @@+{-# LANGUAGE FlexibleInstances #-}+module RSAGL.Color.OpenGL+ (ColorToOpenGL(..))+ where++import RSAGL.Math.Types+import RSAGL.Color.RGB+import RSAGL.Color.Alpha+import Graphics.Rendering.OpenGL.Raw.Core31 (GLdouble,GLfloat)+import Graphics.Rendering.OpenGL hiding (RGB,RGBA,Alpha)++class ColorToOpenGL c where+ colorToOpenGL :: c -> Color4 GLdouble++instance ColorToOpenGL RGB where+ colorToOpenGL (RGB r g b) = Color4 (toGLdouble r)+ (toGLdouble g)+ (toGLdouble b)+ 1++instance ColorToOpenGL (Alpha RGB) where+ colorToOpenGL (Alpha a (RGB r g b)) = Color4 (toGLdouble r)+ (toGLdouble g)+ (toGLdouble b)+ (toGLdouble a)+
+ RSAGL/Color/RGB.hs view
@@ -0,0 +1,99 @@+{-# LANGUAGE MultiParamTypeClasses #-}+module RSAGL.Color.RGB+ (RGB(..),+ rgb,+ rgb256,+ grayscale,+ greyscale,+ grayscale256,+ greyscale256,+ mapRGB,+ zipRGB,+ zipRGB3)+ where++import RSAGL.Math.Types+import RSAGL.Color.ColorSpace+import RSAGL.Color.Auxiliary+import RSAGL.Math.Vector+import RSAGL.Math.AbstractVector+import Control.Parallel.Strategies++-- | A color in the red-green-blue color space.+data RGB = RGB { rgb_red :: {-# UNPACK #-} !RSdouble,+ rgb_green :: {-# UNPACK #-} !RSdouble,+ rgb_blue :: {-# UNPACK #-} !RSdouble }+ deriving (Eq,Ord,Read,Show)++instance NFData RGB where++instance Xyz RGB where+ toXYZ c = (rgb_red c,rgb_green c,rgb_blue c)+ fromXYZ (r,g,b) = RGB r g b++instance ColorSpace RGB where+ affineColorSpaceOf _ = color_space_rgb++instance ExportColorCoordinates RGB where+ exportColorCoordinates (RGB r g b) =+ transformColorFromTo color_space_rgb $ Point3D r g b+instance ImportColorCoordinates RGB where+ importColorCoordinates f = RGB r g b+ where Point3D r g b = f color_space_rgb++-- | Construct a color from an RGB triple in the range \[0.0..1.0\].+rgb :: (ImportColorCoordinates c) => RSdouble -> RSdouble -> RSdouble -> c+rgb r g b = transformColor $ RGB r g b+{-# SPECIALIZE rgb :: RSdouble -> RSdouble -> RSdouble -> RGB #-}++-- | Construct a color from an RGB triple in the range \[0..255\].+rgb256 :: (ImportColorCoordinates c,Integral i) => i -> i -> i -> c+rgb256 r g b = rgb (i2f256 r) (i2f256 g) (i2f256 b)+{-# SPECIALIZE rgb256 :: (Integral i) => i -> i -> i -> RGB #-}++-- | Construct a gray color from a value in the range+-- \[0.0..1.0\].+grayscale :: (ImportColorCoordinates c) => RSdouble -> c+grayscale = greyscale+{-# SPECIALIZE grayscale :: RSdouble -> RGB #-}++greyscale :: (ImportColorCoordinates c) => RSdouble -> c+greyscale x = transformColor $ RGB x x x+{-# SPECIALIZE greyscale :: RSdouble -> RGB #-}++-- | Construct a gray color from a value in the range+-- \[0..255\].+grayscale256 :: (Integral i,ImportColorCoordinates c) => i -> c+grayscale256 = greyscale256+{-# SPECIALIZE grayscale256 :: (Integral i) => i -> RGB #-}++greyscale256 :: (Integral i,ImportColorCoordinates c) => i -> c+greyscale256 x = transformColor (rgb256 x x x :: RGB)+{-# SPECIALIZE greyscale256 :: (Integral i) => i -> RGB #-}++instance AbstractZero RGB where+ zero = RGB 0 0 0++instance AbstractAdd RGB RGB where+ add = zipRGB (+)++instance AbstractSubtract RGB RGB where+ sub = zipRGB (-)++instance AbstractScale RGB where+ scalarMultiply d = mapRGB (*d)++instance AbstractVector RGB++mapRGB :: (RSdouble -> RSdouble) -> RGB -> RGB+mapRGB f (RGB r g b) = RGB (f r) (f g) (f b)++zipRGB :: (RSdouble -> RSdouble -> RSdouble) -> RGB -> RGB -> RGB+zipRGB f (RGB r1 g1 b1) (RGB r2 g2 b2) = RGB (f r1 r2) (f g1 g2) (f b1 b2)++-- | A combining function on three RGB values.+zipRGB3 :: (RSdouble -> RSdouble -> RSdouble -> RSdouble) ->+ RGB -> RGB -> RGB -> RGB+zipRGB3 f (RGB r1 g1 b1) (RGB r2 g2 b2) (RGB r3 g3 b3) =+ RGB (f r1 r2 r3) (f g1 g2 g3) (f b1 b2 b3)+
+ RSAGL/Color/RSAGLColors.hs view
@@ -0,0 +1,156 @@+module RSAGL.Color.RSAGLColors (light_pink,mustard,indigo,lime,sea_green,periwinkle,dark_pink,olive_green,peach,pale_green,light_brown,hot_pink,black,lilac,navy_blue,royal_blue,beige,salmon,olive,maroon,bright_green,dark_purple,mauve,forest_green,aqua,cyan,tan,dark_blue,lavender,turquoise,dark_green,violet,light_purple,lime_green,grey,sky_blue,yellow,magenta,light_green,orange,teal,light_blue,red,brown,pink,blue,green,purple,white,blackbody) where++import Prelude ()+import RSAGL.Modeling.Material+import RSAGL.Color++light_pink :: RGB+light_pink = rgb256 255 209 209++mustard :: RGB+mustard = rgb256 204 179 3++indigo :: RGB+indigo = rgb256 51 2 130++lime :: RGB+lime = rgb256 170 255 63++sea_green :: RGB+sea_green = rgb256 85 252 172++periwinkle :: RGB+periwinkle = rgb256 136 130 242++dark_pink :: RGB+dark_pink = rgb256 204 65 97++olive_green :: RGB+olive_green = rgb256 102 122 10++peach :: RGB+peach = rgb256 255 176 112++pale_green :: RGB+pale_green = rgb256 204 253 189++light_brown :: RGB+light_brown = rgb256 170 129 81++hot_pink :: RGB+hot_pink = rgb256 255 2 130++black :: RGB+black = rgb256 1 1 1++lilac :: RGB+lilac = rgb256 204 162 242++navy_blue :: RGB+navy_blue = rgb256 0 17 65++royal_blue :: RGB+royal_blue = rgb256 0 4 164++beige :: RGB+beige = rgb256 238 218 170++salmon :: RGB+salmon = rgb256 255 121 105++olive :: RGB+olive = rgb256 102 117 5++maroon :: RGB+maroon = rgb256 102 0 32++bright_green :: RGB+bright_green = rgb256 0 255 15++dark_purple :: RGB+dark_purple = rgb256 51 6 54++mauve :: RGB+mauve = rgb256 170 113 129++forest_green :: RGB+forest_green = rgb256 0 71 7++aqua :: RGB+aqua = rgb256 17 234 202++cyan :: RGB+cyan = rgb256 0 255 255++tan :: RGB+tan = rgb256 221 178 98++dark_blue :: RGB+dark_blue = rgb256 0 3 83++lavender :: RGB+lavender = rgb256 204 159 239++turquoise :: RGB+turquoise = rgb256 0 194 162++dark_green :: RGB+dark_green = rgb256 0 53 5++violet :: RGB+violet = rgb256 153 14 238++light_purple :: RGB+light_purple = rgb256 187 119 247++lime_green :: RGB+lime_green = rgb256 136 254 14++grey :: RGB+grey = rgb256 153 149 149++sky_blue :: RGB+sky_blue = rgb256 119 187 251++yellow :: RGB+yellow = rgb256 255 255 31++magenta :: RGB+magenta = rgb256 204 0 112++light_green :: RGB+light_green = rgb256 153 249 121++orange :: RGB+orange = rgb256 255 115 3++teal :: RGB+teal = rgb256 0 147 131++light_blue :: RGB+light_blue = rgb256 153 208 240++red :: RGB+red = rgb256 238 0 0++brown :: RGB+brown = rgb256 102 55 7++pink :: RGB+pink = rgb256 255 129 193++blue :: RGB+blue = rgb256 0 67 211++green :: RGB+green = rgb256 17 176 16++purple :: RGB+purple = rgb256 119 30 158++white :: RGB+white = rgb256 255 255 255++blackbody :: RGB+blackbody = rgb256 0 0 0+
+ RSAGL/Color/Spaces.hs view
@@ -0,0 +1,77 @@+module RSAGL.Color.Spaces+ (color_space_neutral,+ color_space_cmy,+ color_wheel_rgb_brightness,+ color_wheel_cmyk,+ color_wheel_red_cyan_iso,+ color_wheel_blue_yellow_iso,+ color_wheel_green_magenta_iso)+ where++import RSAGL.Color.ColorSpace+import RSAGL.Color.RGB+import RSAGL.Math.Angle++-- | The RGB color space with neutral gray as the+-- origin.+color_space_neutral :: AffineColorSpace+color_space_neutral = newColorSpace (RGB 0.5 0.5 0.5)+ (RGB 1.0 0.5 0.5)+ (RGB 0.5 1.0 0.5)+ (RGB 0.5 0.5 1.0)++-- | The subtractive Cyan-Magenta-Yellow color space.+color_space_cmy :: AffineColorSpace+color_space_cmy = newColorSpace (RGB 1 1 1)+ (RGB 0 1 1)+ (RGB 1 0 1)+ (RGB 1 1 0)++-- | A color wheel using a simple definition of brightness,+-- @(red + green + blue) / 3@. The hue definition is+-- identical to 'color_wheel_rgbl'.+color_wheel_rgb_brightness :: ColorWheel+color_wheel_rgb_brightness =+ newColorWheel (RGB 0 0 0)+ (RGB 1 0 0,fromDegrees 0,1/3)+ (RGB 0 1 0,fromDegrees 120,1/3)+ (RGB 0 0 1,fromDegrees 240,1/3)++-- | A color wheel in the subtractive Cyan-Magenta-Yellow color space.+-- The hue definition is identical to 'color_wheel_rgbl'.+-- This color wheel uses a simple definition of black,+-- @(cyan + magenta + yellow) / 3@.+color_wheel_cmyk :: ColorWheel+color_wheel_cmyk =+ newColorWheel (RGB 1 1 1)+ (RGB 0 1 1,fromDegrees 180,1/3)+ (RGB 1 0 1,fromDegrees 300,1/3)+ (RGB 1 1 0,fromDegrees 60 ,1/3)++-- | A color wheel with an isotropic Red-Cyan channel.+-- The hue definition is identical to 'color_wheel_rgbl'.+color_wheel_red_cyan_iso :: ColorWheel+color_wheel_red_cyan_iso =+ newColorWheel (RGB 0 0 0)+ (RGB 1 0 0,fromDegrees 0,1.0)+ (RGB 0 1 0,fromDegrees 120,0.5)+ (RGB 0 0 1,fromDegrees 240,0.5)++-- | A color wheel with an isotropic Blue-Yellow channel.+-- The hue definition is identical to 'color_wheel_rgbl'.+color_wheel_blue_yellow_iso :: ColorWheel+color_wheel_blue_yellow_iso =+ newColorWheel (RGB 0 0 0)+ (RGB 1 0 0,fromDegrees 0,0.5)+ (RGB 0 1 0,fromDegrees 120,0.5)+ (RGB 0 0 1,fromDegrees 240,1.0)++-- | A color wheel with an isotropic Green-Magenta channel.+-- The hue definition is identical to 'color_wheel_rgbl'.+color_wheel_green_magenta_iso :: ColorWheel+color_wheel_green_magenta_iso =+ newColorWheel (RGB 0 0 0)+ (RGB 1 0 0,fromDegrees 0,0.5)+ (RGB 0 1 0,fromDegrees 120,1.0)+ (RGB 0 0 1,fromDegrees 240,0.5)+
RSAGL/Extras/ColorPhysics.hs view
@@ -4,11 +4,11 @@ blackBodyRGB, spectralRGB) where -import RSAGL.Modeling.Color+import RSAGL.Color import RSAGL.Math.AbstractVector import RSAGL.Auxiliary.Auxiliary import RSAGL.Math.Interpolation-import RSAGL.Types+import RSAGL.Math.Types -- | Evaluates planck's law respecting blackbody radiation. -- Accepts temperature in Kelvins (K) and wavelength in nanometers (nm).
RSAGL/Extras/Sky.hs view
@@ -18,7 +18,7 @@ import RSAGL.RayTrace.RayTrace import RSAGL.RayTrace.Scattering import RSAGL.Math.Vector-import RSAGL.Modeling.Color+import RSAGL.Color import RSAGL.Math.Angle import RSAGL.Auxiliary.ApplicativeWrapper import Data.Monoid@@ -26,7 +26,8 @@ import Data.Ord import System.Random import RSAGL.Modeling.Model hiding (sphere)-import RSAGL.Types+import RSAGL.Math.Types+import RSAGL.Math.AbstractVector -- | An atmosphere that is fairly typical of the earth. earth_atmosphere :: Atmosphere@@ -78,7 +79,7 @@ -- dynamicSkyFilter :: RSdouble -> RSdouble -> SkyFilter dynamicSkyFilter max_black min_white origF = case () of- () | min_color > 0 -> Just $ filterRGBLinear (gray min_color) (gray max_color)+ () | min_color > 0 -> Just $ filterRGBLinear (grayscale min_color) (grayscale max_color) () | otherwise -> Nothing where max_color = foldr (\(RGB r g b) x -> max (max r g) (max b x)) min_white cs min_color = foldr (\(RGB r g b) x -> minimum $ filter (/= 0) [r,g,b,x]) max_black cs@@ -91,8 +92,10 @@ atmosphereLayerToScatteringModel l@(AtmosphereLayer { atmosphere_composition = Air }) = rayleigh (atmosphere_altitude l / atmosphere_thickness l) rayleigh_sky atmosphereLayerToScatteringModel l@(AtmosphereLayer { atmosphere_composition = Vapor }) = mconcat [- elasticOmnidirectionalScatter (atmosphere_altitude l / atmosphere_thickness l) (gray $ meanBrightness rayleigh_sky),- elasticForwardScatter (atmosphere_altitude l / atmosphere_thickness l) (fromDegrees 30) (gray $ meanBrightness rayleigh_sky)]+ elasticOmnidirectionalScatter (atmosphere_altitude l / atmosphere_thickness l)+ (grayscale $ linear_value $ viewChannel channel_brightness rayleigh_sky),+ elasticForwardScatter (atmosphere_altitude l / atmosphere_thickness l) (fromDegrees 30)+ (grayscale $ linear_value $ viewChannel channel_brightness rayleigh_sky)] atmosphereLayerToScatteringModel l@(AtmosphereLayer { atmosphere_composition = Dust c }) = dust (f2f $ atmosphere_altitude l / atmosphere_thickness l) c atmosphereLayerToScatteringModel l@(AtmosphereLayer { atmosphere_composition = Fog c }) = @@ -115,18 +118,18 @@ -- | Calculate the amount of absorbtion along a specific ray inside a single 'AtmosphereLayer'. atmosphereLayerAbsorbtion :: AtmosphereLayer -> Ray3D -> RGB-atmosphereLayerAbsorbtion l r = castSkyRay (sphere origin_point_3d (1 + atmosphere_altitude l)) (gray 1) absorbF r+atmosphereLayerAbsorbtion l r = castSkyRay (sphere origin_point_3d (1 + atmosphere_altitude l)) (grayscale 1) absorbF r where absorbF p_near p_far = postFilter $ traceAbsorbtion (const $ scattering_model) linearSamples p_near p_far 1 postFilter = case atmosphere_composition l of- Air -> maximizeRGB+ Air -> adjustColor channel_value maximize _ -> id scattering_model = atmosphereLayerToScatteringModel l -- | Calculate the amount of scattering along a specific ray inside a single 'AtmosphereLayer' given the position and color of a single sun. atmosphereLayerScattering :: AtmosphereLayer -> (Vector3D,RGB) -> Ray3D -> RGB-atmosphereLayerScattering l (sun_vector,sun_color) r = castSkyRay (sphere origin_point_3d (1 + atmosphere_altitude l)) (gray 0) scatterF r+atmosphereLayerScattering l (sun_vector,sun_color) r = castSkyRay (sphere origin_point_3d (1 + atmosphere_altitude l)) (grayscale 0) scatterF r where scatterF p_near p_far = fst $ traceScattering (const scattering_model) - (\p -> (sun_vector,scaleRGB (lightingF p) sun_color)) adaptiveSamples p_near p_far $+ (\p -> (sun_vector,scalarMultiply (lightingF p) sun_color)) adaptiveSamples p_near p_far $ round $ max 20 $ (* 800) $ toRotations $ angleBetween (Vector3D 0 1 0) (ray_vector r) scattering_model = achromaticAbsorbtion $ atmosphereLayerToScatteringModel l lightingF p = f2f $ castSkyRay UnitSphere 1 @@ -135,12 +138,12 @@ -- | Aggrigated absorbtion from multiple 'AtmosphereLayers'. atmosphereAbsorbtion :: Atmosphere -> Point3D -> Vector3D -> RGB-atmosphereAbsorbtion atm p v = foldr filterRGB (gray 1) $ map ($ Ray3D p v) absorbFs+atmosphereAbsorbtion atm p v = foldr filterRGB (grayscale 1) $ map ($ Ray3D p v) absorbFs where absorbFs = map atmosphereLayerAbsorbtion atm -- | Aggrigated scattering from multiple 'AtmosphereLayers' and multiple suns. atmosphereScattering :: Atmosphere -> [(Vector3D,RGB)] -> Point3D -> Vector3D -> RGB-atmosphereScattering atm_ suns p v_ = foldr addRGB (gray 0) $ map ($ v_) scatterFs+atmosphereScattering atm_ suns p v_ = foldr add (grayscale 0) $ map ($ v_) scatterFs where atm = reverse $ sortBy (comparing atmosphere_altitude) atm_ scatterFs = do (this_layer,sun_absorbtion_layers,post_absorbtion_layers) <- zip3 atm (inits atm) (drop 1 $ tails atm)@@ -156,7 +159,12 @@ -- In particular, atmosphereScatteringMaterial uses this. -- absorbtionFilter :: RGB -> RGB-absorbtionFilter c = scaleRGB (recip $ 1 + (abs $ log (maxRGB c) / log 2)) $ maximizeRGB c+absorbtionFilter c =+ let maximal_rgb = linear_value $ viewChannel channel_value c+ maximized_rgb = adjustColor channel_value maximize c+ in scalarMultiply+ (recip $ 1 + (abs $ log maximal_rgb / log 2))+ maximized_rgb -- | Generate a material for a sky sphere. This material includes both scattering and absorbtion information. -- The material assumes the origin as the eye point, tracing to the geometric point at each vertex. Therefore,@@ -164,8 +172,10 @@ -- atmosphereScatteringMaterial :: Atmosphere -> [(Vector3D,RGB)] -> SkyFilter -> MaterialM attr () atmosphereScatteringMaterial [] _ _ = return ()-atmosphereScatteringMaterial _ suns _ | all ((== 0) . maxRGB . snd) suns = return ()-atmosphereScatteringMaterial atm suns sky_filter = material $ +atmosphereScatteringMaterial _ suns _ |+ all ((== 0) . linear_value . viewChannel channel_value . snd) suns =+ return ()+atmosphereScatteringMaterial atm suns sky_filter = material $ do filtering $ ApplicativeWrapper $ Left $ \(SurfaceVertex3D p _) -> absorbtionFilter $ atmosphereAbsorbtion atm (Point3D 0 1 0) (vectorToFrom p origin_point_3d) case m_skyFilterF of
− RSAGL/FRP.hs
@@ -1,12 +0,0 @@-module RSAGL.FRP- (module RSAGL.FRP.FRP,- module RSAGL.FRP.FRPModel,- module RSAGL.FRP.Time,- module RSAGL.FRP.Accumulation)- where--import RSAGL.FRP.FRP-import RSAGL.FRP.FRPModel-import RSAGL.FRP.Time-import RSAGL.FRP.Accumulation-
− RSAGL/FRP/Accumulation.hs
@@ -1,112 +0,0 @@-{-# LANGUAGE Arrows #-}--module RSAGL.FRP.Accumulation- (delay,- integral,- derivative,- accumulateNumerical,- integralRK4,- integralRK4',- summation,- threadTime,- sticky,- initial,- EdgeDetectionMode(..),- edge,- changed,- clingy)- where--import RSAGL.FRP.FRP-import RSAGL.FRP.Time-import RSAGL.Math.RK4-import System.Mem.StableName-import Control.Arrow-import RSAGL.Math.AbstractVector-import Data.Maybe---- | Delay a piece of data for one frame.-delay :: x -> FRP e m x x-delay initial_value = accumulate (initial_value,error "delay: impossible") (\new_value (old_value,_) -> (new_value,old_value)) >>> arr snd---- | Take the integral of a rate over time, using the trapezoidal rule.-integral :: (AbstractVector v,AbstractAdd p v) => p -> FRP e m (Rate v) p-integral initial_value = proc v ->- do delta_t <- deltaTime -< ()- (new_accum,_) <- accumulate (zero,perSecond zero) (\(delta_t,new_rate) (old_accum,old_rate) ->- (old_accum `add` ((scalarMultiply (recip 2) $ new_rate `add` old_rate) `over` delta_t),new_rate)) -< (delta_t,v)- returnA -< initial_value `add` new_accum---- | Take the derivative of a value over time, by simple subtraction between frames.-derivative :: (AbstractVector v,AbstractSubtract p v) => FRP e m p (Rate v)-derivative = proc new_value ->- do delta_t <- deltaTime -< ()- m_old_value <- delay Nothing -< Just new_value- let z = perSecond zero- returnA -< maybe z (\old_value -> if delta_t == zero then z else (new_value `sub` old_value) `per` delta_t) m_old_value---- | 'accumulate' harness for some numerical methods.--- Parameters are: current input, previous output, delta time, absolute time, and number of frames at the specified frequency.-accumulateNumerical :: Frequency -> (i -> o -> Time -> Time -> Integer -> o) -> o -> FRP e m i o-accumulateNumerical frequency accumF initial_value = proc i ->- do absolute_time <- absoluteTime -< ()- delta_t <- deltaTime -< ()- accumulate initial_value (\(i,absolute_time',delta_t',frames) o -> accumF i o absolute_time' delta_t' frames) -< - (i,absolute_time,delta_t,ceiling $ toSeconds delta_t / toSeconds (interval frequency))--integralRK4 :: (AbstractVector v) => Frequency -> (p -> v -> p) -> p -> FRP e m (Time -> p -> Rate v) p-integralRK4 f addPV = accumulateNumerical f (\diffF p abs_t delta_t -> integrateRK4 addPV diffF p (abs_t `sub` delta_t) abs_t)--integralRK4' :: (AbstractVector v) => Frequency -> (p -> v -> p) -> (p,Rate v) -> - FRP e m (Time -> p -> Rate v -> Acceleration v) (p,Rate v)-integralRK4' f addPV = accumulateNumerical f (\diffF p abs_t delta_t -> integrateRK4' addPV diffF p (abs_t `sub` delta_t) abs_t)---- | Sum some data frame-by-frame.-summation :: (AbstractAdd p v) => p -> FRP e m v p-summation initial_value = accumulate initial_value (\v p -> p `add` v)---- | Elapsed time since the instantiation of this switch or thread. Reset when a thread switches.-threadTime :: FRP e m () Time-threadTime = summation zero <<< deltaTime---- | The edge detection mode. If 'Discrete', detect edge between subsequent frames only.--- If 'Fuzzy' detect edge since the most recent previous detected edge.--- If 'HashedDiscrete', the comparison function is itself expensive, and the FRP runtime will compare by 'StableName's as a short-circuit optimization.-data EdgeDetectionMode = Fuzzy | Discrete | HashedDiscrete---- | Answer the most recent input that satisfies the predicate.--- Accepts an initial value, which need not itself satisfy the predicate.------ This can be a performance optimization, if it prevents unecessary evaluation of an input.-sticky :: (x -> Bool) -> x -> FRP e m x x-sticky f x = accumulate x (\new_x old_x -> if f new_x then new_x else old_x)---- | Answer the first input that ever passes through a function.-initial :: FRP e m x x-initial = accumulate Nothing (\new_x m_old_x -> Just $ fromMaybe new_x m_old_x) >>> arr (fromMaybe $ error "initial: impossible happened")---- | Returns 'True' only during frames on which the input has changed, based on a user-specified equality predicate.--- The predicate function takes the most recent input as its first parameter.-edge :: EdgeDetectionMode -> (x -> x -> Bool) -> FRP e m x Bool-edge Discrete predicateF = proc x ->- do d_x <- delay Nothing -< Just x- returnA -< maybe True (not . predicateF x) d_x-edge HashedDiscrete predicateF = proc x ->- do x_stable <- ioAction makeStableName -< x- stable_edge <- edge Discrete (==) -< x_stable- edge Discrete (\(a_stable,a) (b_stable,b) -> if a_stable == b_stable then True else predicateF a b) -< (stable_edge,x)-edge Fuzzy predicateF = arr snd <<< accumulate (Nothing,error "changed: impossible")- (\x_now (x_old,_) -> if maybe True (predicateF x_now) x_old- then (x_old,False)- else (Just x_now,True))---- | Same as 'edge Discrete'.-changed :: (x -> x -> Bool) -> FRP e m x Bool-changed = edge Discrete---- | Recalculate a function only at the edges of it's input.-clingy :: EdgeDetectionMode -> (j -> j -> Bool) -> (j -> p) -> FRP e m j p-clingy edm predicateF f = proc j ->- do e <- edge edm predicateF -< j- arr snd <<< sticky fst (error "clingy: impossible") -< (e,f j)-
− RSAGL/FRP/FRP.hs
@@ -1,372 +0,0 @@-{-# LANGUAGE ExistentialQuantification, Arrows, ScopedTypeVariables, Rank2Types,- FlexibleInstances, MultiParamTypeClasses, TypeFamilies,- UndecidableInstances, DoRec #-}--module RSAGL.FRP.FRP- (FRP,- switchContinue,- switchTerminate,- spawnThreads,- killThreadIf,- threadIdentity,- withThreadIdentity,- frpTest,- FRPProgram,- newFRPProgram,- newFRP1Program,- updateFRPProgram,- accumulate,- absoluteTime,- deltaTime,- ThreadIdentityRule,- forbidDuplicates,- allowAnonymous,- nullaryThreadIdentity,- frpContext,- frp1Context,- whenJust,- ioAction)- where--import Prelude hiding ((.),id)-import RSAGL.FRP.FactoryArrow-import Control.Monad.Cont-import RSAGL.FRP.Time-import RSAGL.FRP.FRPModel-import Control.Concurrent.MVar-import Control.Category-import Control.Arrow-import Control.Arrow.Operations hiding (delay)-import Data.IORef-import Control.Applicative-import RSAGL.Math.AbstractVector-import Data.List-import Data.Maybe-import Control.Exception-import RSAGL.Auxiliary.RecombinantState--{--------------------------------------------------------------------------------}--- FRP Data Structures-{--------------------------------------------------------------------------------}---- | State information for a currently-executed FRP program.-data FRPState i o = FRPState { - -- | Ending time of the current frame, and the frame-local time horizon.- frpstate_absolute_time :: Time,- -- | Delta to the ending time of the previous frame.- frpstate_delta_time :: Time,- -- | Continuation to exit the current switch.- frpstate_exit :: (Maybe o) -> ContT (Maybe o) IO (Maybe o) }--data FRPInit s t i o = FRPInit {- frp_current_switch :: IORef (i -> ContT (Maybe o) IO (Maybe o)),- frp_state :: IORef (FRPState i o),- frp_user_state :: IORef s,- -- | Put a thread in here to spawn it.- frp_spawned_threads :: MVar [FRPInit s t i o],- frp_previous_time :: IORef (Maybe Time),- frp_thread_identity :: t,- frp_previous_result :: IORef (Maybe o) }--type FRPProgram s i o = FRPInit s () i o---- | A switchable automata with timewise numerical methods.-newtype FRP e m j p = FRP (FRPInit (StateOf m) (ThreadIDOf m) (SwitchInputOf m) (SwitchOutputOf m) -> - FactoryArrow IO (ContT (Maybe (SwitchOutputOf m)) IO) j p)--instance Functor (FRP e m j) where- fmap f frpx = frpx >>> arr f--instance Applicative (FRP e m j) where- pure a = proc _ -> returnA -< a- f <*> s = proc i ->- do s' <- s -< i- f' <- f -< i- returnA -< f' s'--instance Category (FRP e m) where- (FRP a) . (FRP b) = FRP $ \frp_init -> a frp_init . b frp_init- id = FRP $ const id--instance Arrow (FRP e m) where- arr f = FRP $ \_ -> arr f- first (FRP f) = FRP $ \frp_init -> first (f frp_init)- second (FRP f) = FRP $ \frp_init -> second (f frp_init)--instance (StateOf m ~ s) => ArrowState s (FRP e m) where- fetch = frpxOf $ \frpinit _ -> lift $ getProgramState frpinit- store = frpxOf $ \frpinit x -> lift $ putProgramState frpinit x---- | Construct a single-threaded FRPProgram.-newFRP1Program :: (forall e. FRP e (FRP1 s i o) i o) -> IO (FRPProgram s i o)-newFRP1Program thread = unsafeFRPProgram (error "newFRP1Program: impossible, tried to access the spawned_threads pool from a single threaded FRPProgram.") () thread---- | Construct a multi-threaded FRPProgram.-newFRPProgram :: (RecombinantState s,Eq t) => - ThreadIdentityRule t -> - (forall e. [(t,FRP e (FRPX t s i o) i o)]) -> - IO (FRPProgram s i [(t,o)])-newFRPProgram rule seed_threads = newFRP1Program $ frpContext rule seed_threads---- | Construct an FRPProgram from a single seed thread. This program will spawn threads--- into the specified MVar.-unsafeFRPProgram :: MVar [FRPInit (StateOf m) (ThreadIDOf m) (SwitchInputOf m) (SwitchOutputOf m)] -> - ThreadIDOf m -> - FRP e m (SwitchInputOf m) (SwitchOutputOf m) -> - IO (FRPInit (StateOf m) (ThreadIDOf m) (SwitchInputOf m) (SwitchOutputOf m))-unsafeFRPProgram spawned_threads t frpx =- do frpstate_ref <- newIORef $ error "Tried to use uninitialized FRPState variable."- current_switch_ref <- newIORef $ error "Tried to use uninitialized frp_current_switch variable."- previous_time_ref <- newIORef Nothing- previous_result_ref <- newIORef Nothing- user_state_ref <- newIORef $ error "Tried to use uninitialized user state variable. (use setProgramState)."- let frp_init = FRPInit current_switch_ref frpstate_ref user_state_ref spawned_threads previous_time_ref t previous_result_ref- writeIORef current_switch_ref =<< constructSwitch frp_init frpx- return frp_init--getProgramState :: FRPInit s t i o -> IO s-getProgramState = readIORef . frp_user_state--putProgramState :: FRPInit s t i o -> s -> IO ()-putProgramState frp_init s = writeIORef (frp_user_state frp_init) $ s--modifyProgramState :: FRPInit s t i o -> (s -> s) -> IO ()-modifyProgramState frp_init f = putProgramState frp_init =<< liftM f (getProgramState frp_init)---- | Bring an FRPProgram up-to-date with the current time or a specific time.-updateFRPProgram :: Maybe Time -> (i,s) -> FRPProgram s i o -> IO (o,s)-updateFRPProgram user_t (i,s) frp_init =- do actual_t <- getTime- prev_t <- readIORef $ frp_previous_time frp_init- when (maybe False (> actual_t) prev_t) $ error "updateFRPProgram: previous time greater than current actual time"- when (maybe False (> actual_t) user_t) $ error "updateFRPProgram: user time greater than current actual time"- let t = minimum $ catMaybes [Just actual_t,user_t]- liftM (fromMaybe $ error "updateFRPProgram: unexpected termination") $ unsafeRunFRPProgram t (i,s) frp_init--frpTest :: (forall e. [FRP e (FRPX () () i o) i o]) -> [i] -> IO [[o]]-frpTest seed_threads inputs =- do test_program <- newFRPProgram nullaryThreadIdentity $ map (\thread -> ((),thread)) seed_threads- liftM (map $ map snd . maybe (error "frpTest: unexpected termination") fst) $ - mapM (\(t,i) -> unsafeRunFRPProgram t (i,()) test_program) $ zip (map fromSeconds [0.0,0.1..]) inputs---- | Update an FRPProgram.-unsafeRunFRPProgram :: Time -> (i,s) -> FRPInit s t i o -> IO (Maybe (o,s))-unsafeRunFRPProgram t (i,s) frp_init =- do prev_t <- readIORef (frp_previous_time frp_init)- m_o <- flip runContT return $- do o <- callCC $ \exit ->- do let state = FRPState {- frpstate_absolute_time = t,- frpstate_delta_time = fromMaybe zero $ sub <$> pure t <*> prev_t,- frpstate_exit = exit }- lift $ writeIORef (frp_state frp_init) state- lift $ putProgramState frp_init s- action <- lift $ readIORef (frp_current_switch frp_init)- action i- lift $ writeIORef (frp_previous_time frp_init) $ Just t- lift $ writeIORef (frp_previous_result frp_init) $ o- return o- s' <- readIORef (frp_user_state frp_init)- return $ fmap (\o -> (o,s')) m_o--getFRPState :: FRPInit s t i o -> IO (FRPState i o)-getFRPState = readIORef . frp_state---- | Shorthand for simple operations in the ContT monad.-frpxOf :: (FRPInit (StateOf m) (ThreadIDOf m) (SwitchInputOf m) (SwitchOutputOf m) -> j -> ContT (Maybe (SwitchOutputOf m)) IO p) -> FRP e m j p-frpxOf action = FRP $ \frpinit -> FactoryArrow $ return $ Kleisli $ action frpinit---- | Framewise accumulation of signals.--- The embedded function recieves the current input and the previous output.-accumulate :: p -> (j -> p -> p) -> FRP e m j p-accumulate initial_value accumF = FRP $ \_ -> FactoryArrow $- do prev_o_ref <- newIORef initial_value- return $ Kleisli $ \i -> lift $- do prev_o <- readIORef prev_o_ref- let o = accumF i prev_o- writeIORef prev_o_ref o- _ <- evaluate o- return o---- | Get the current absolute time.-absoluteTime :: FRP e m () Time-absoluteTime = frpxOf $ \frpinit () -> lift $ do liftM frpstate_absolute_time $ getFRPState frpinit---- | Get the change in time since the last update.-deltaTime :: FRP e m () Time-deltaTime = frpxOf $ \frpinit () -> lift $ do liftM frpstate_delta_time $ getFRPState frpinit---- | Replace the 'frpinit_current_switch' value of the currently running thread with a newly constructed switch.-replaceSwitch :: FRPInit (StateOf m) (ThreadIDOf m) (SwitchInputOf m) (SwitchOutputOf m) -> FRP e m (SwitchInputOf m) (SwitchOutputOf m) -> - ContT (Maybe (SwitchOutputOf m)) IO (SwitchInputOf m -> ContT (Maybe (SwitchOutputOf m)) IO (Maybe (SwitchOutputOf m)))-replaceSwitch frpinit switch =- do newSwitch <- lift $ constructSwitch frpinit switch- lift $ writeIORef (frp_current_switch frpinit) newSwitch- return newSwitch--constructSwitch :: FRPInit (StateOf m) (ThreadIDOf m) (SwitchInputOf m) (SwitchOutputOf m) -> - FRP e m (SwitchInputOf m) (SwitchOutputOf m) -> - IO (SwitchInputOf m -> ContT (Maybe (SwitchOutputOf m)) IO (Maybe (SwitchOutputOf m)))-constructSwitch frp_init (FRP f) =- do (Kleisli current_switch) <- runFactory $ f frp_init- return $ \i ->- do o <- current_switch i- exit <- liftM frpstate_exit $ lift $ getFRPState frp_init- exit $ Just o---- | Whenever a value is provided, change the presently running switch (or thread) to the specified new value,--- and execute that switch before continuing. This destroys all state local to the currently running--- switch (or thread).--- This function acts as if the switch were performed at frame begin.-switchContinue :: FRP e m (Maybe (FRP e m (SwitchInputOf m) (SwitchOutputOf m)),SwitchInputOf m) (SwitchInputOf m)-switchContinue = frpxOf $ \frpinit (m_switch,i) ->- do case m_switch of- (Just switch) ->- do newSwitch <- replaceSwitch frpinit switch- _ <- callCC $ \_ -> newSwitch i- error "switchContinue: Unreachable code."- Nothing -> return i---- | Whenever a value is provided, change the presently running switch (or thread) to the specified new value,--- and execute that switch before continuing. This destroys all state local to the currently running--- switch (or thread).--- This function acts as if the switch were performed at frame end.-switchTerminate :: FRP e m (Maybe (FRP e m (SwitchInputOf m) (SwitchOutputOf m)),SwitchOutputOf m) (SwitchOutputOf m)-switchTerminate = frpxOf $ \frp_init (m_switch,o) ->- do case m_switch of- (Just switch) ->- do _ <- replaceSwitch frp_init switch- exit <- lift $ liftM frpstate_exit $ getFRPState frp_init- _ <- exit $ Just o- error "switchTerminate: Unreachable code."- Nothing -> return o---- | Spawn new threads once per frame.-spawnThreads :: (ThreadingOf m ~ Enabled) => FRP e m [(ThreadIDOf m,FRP e m (SwitchInputOf m) (SwitchOutputOf m))] ()-spawnThreads = frpxOf $ \frp_init new_threads -> lift $- do constructed_new_threads <- mapM (uncurry $ unsafeFRPProgram $ frp_spawned_threads frp_init) new_threads- modifyMVar_ (frp_spawned_threads frp_init) $ return . (constructed_new_threads ++)- return ()---- | Kill the current thread, only when the given parameter is true.-killThreadIf :: (ThreadingOf m ~ Enabled) => FRP e m Bool ()-killThreadIf = frpxOf $ \frpinit b ->- do exit <- lift $ liftM frpstate_exit $ getFRPState frpinit- when b $ exit Nothing >> return ()- return ()---- | Should a thread be allowed to spawn? Typical values are 'nullaryThreadIdentity', 'forbidDuplicates'.--- The predicate tests whether or not a particular thread is already running.-type ThreadIdentityRule t = (t -> Bool) -> t -> Bool---- | Allow unlimited duplicate threads.-nullaryThreadIdentity :: ThreadIdentityRule a-nullaryThreadIdentity _ _ = True---- | Forbig duplicate threads by equality on the thread identity.-forbidDuplicates :: (Eq t) => ThreadIdentityRule t-forbidDuplicates = (not .)---- | Allow unlimited duplicate 'Nothing' threads, while restricting all other threads according to the specified rule.-allowAnonymous :: ThreadIdentityRule t -> ThreadIdentityRule (Maybe t)-allowAnonymous _ _ Nothing = True-allowAnonymous r f (Just x) = r (f . Just) x--accumulateThreads :: (Eq t) => ThreadIdentityRule t -> [t] -> [FRPInit s t i o] -> [FRPInit s t i o]-accumulateThreads _ _ [] = []-accumulateThreads rule ts (x:xs) | rule (`elem` ts) (frp_thread_identity x) = x : accumulateThreads rule (frp_thread_identity x : ts) xs-accumulateThreads rule ts (_:xs) | otherwise = accumulateThreads rule ts xs---- | Get the current thread's identity. -threadIdentity :: FRP e m () (ThreadIDOf m)-threadIdentity = frpxOf $ \frpinit () -> return $ frp_thread_identity frpinit---- | Construct an arrow from its thread identity.-withThreadIdentity :: (ThreadIDOf m -> FRP e m j p) -> FRP e m j p-withThreadIdentity (actionF) = FRP $ \frp_init -> - let (FRP actionA) = actionF $ frp_thread_identity frp_init- in actionA frp_init--data ThreadGroup s t i o = ThreadGroup {- thread_outputs :: [ThreadResult s t i o],- thread_group :: MVar [FRPInit s t i o] }--data ThreadResult s t i o = ThreadResult {- thread_output :: o,- thread_object :: FRPInit s t i o }--threadResults :: ThreadGroup s t i o -> [(t,o)]-threadResults = map (\t -> (frp_thread_identity $ thread_object t,thread_output t)) . thread_outputs---- | A complex function that embeds a thread group inside another running thread. If the parent thread terminates--- or switches, the embedded thread group is instantly lost.------ 'threadGroup' accepts two paremters:--- * A transformation from the current state to the nested state.--- * A state-append function, which takes the original state as the first parameter, and one of the threaded results as the second parameter.--- This will be run repeatedly to accumulate the output state.--- * A multithreading algorithm. The simplest implementation is sequence_.--- * A list of seed threads with their associated thread identities.-unsafeThreadGroup :: forall e m n.- (FRPModel m,FRPModel n,Unwrap n ~ m) => - (StateOf m -> StateOf n) -> - (StateOf m -> StateOf n -> StateOf m) -> - ThreadIdentityRule (ThreadIDOf n) -> - ([IO ()] -> IO ()) -> - [(ThreadIDOf n,FRP e n (SwitchInputOf n) (SwitchOutputOf n))] -> - FRP e m (SwitchInputOf n) (ThreadGroup (StateOf n) (ThreadIDOf n) (SwitchInputOf n) (SwitchOutputOf n))-unsafeThreadGroup sclone sappend rule multithread seed_threads = FRP $ \frp_init -> FactoryArrow $- do threads <- newEmptyMVar- putMVar threads =<< (mapM (uncurry $ unsafeFRPProgram threads) seed_threads)- let runThreads :: [ThreadIDOf n] -> SwitchInputOf n -> IO [ThreadResult (StateOf n) (ThreadIDOf n) (SwitchInputOf n) (SwitchOutputOf n)]- runThreads already_running_threads j =- do threads_this_pass <- liftM (accumulateThreads rule already_running_threads) $ takeMVar threads- putMVar threads []- s_orig_clone <- liftM sclone $ getProgramState frp_init- absolute_time <- liftM frpstate_absolute_time $ getFRPState frp_init- multithread $ map (\t -> unsafeRunFRPProgram absolute_time (j,s_orig_clone) t >> return ()) threads_this_pass- results_this_pass <- liftM catMaybes $ forM threads_this_pass $ \t ->- do m_o <- readIORef (frp_previous_result t)- s <- readIORef (frp_user_state t)- modifyProgramState frp_init (`sappend` s)- return $- do o <- m_o- return $ ThreadResult o t- results <- liftM (results_this_pass++) (if null threads_this_pass - then return [] - else runThreads (nub $ map frp_thread_identity threads_this_pass ++ already_running_threads) j)- modifyMVar_ threads (return . ((map thread_object results_this_pass)++))- return results- return $ Kleisli $ \j ->- do results <- lift $ runThreads [] j- return $ ThreadGroup {- thread_outputs = results,- thread_group = threads }---- | Embed some threads inside another running thread, as 'threadGroup'.-frpContext :: (RecombinantState s,s ~ StateOf m,FRPModel m,Eq t) => - ThreadIdentityRule t -> [(t,FRP e (FRPContext t j p m) j p)] -> FRP e m j [(t,p)]-frpContext rule seed_threads = arr threadResults . unsafeThreadGroup clone recombine rule sequence_ seed_threads---- | Embed a single-threaded, bracketed switch inside another running thread.-frp1Context :: (FRPModel m) => FRP e (FRP1Context j p m) j p -> FRP e m j p-frp1Context thread = proc i ->- do os <- withThreadIdentity (\t -> unsafeThreadGroup id (const id) nullaryThreadIdentity sequence_ [(t,thread)]) -< i- returnA -< case threadResults os of- [(_,o)] -> o- _ -> error "frp1Context: unexpected non-singular result."---- | Run a computation only when the input is defined.-whenJust :: (FRPModel m) => (forall x y. FRP e (FRP1Context x y m) j p) -> FRP e m (Maybe j) (Maybe p)-whenJust actionA = frp1Context whenJust_- where whenJust_ = proc i ->- do switchContinue -< (maybe (Just whenNothing_) (const Nothing) i,i)- arr (Just) <<< actionA -< fromMaybe (error "whenJust: impossible case") i- whenNothing_ = proc i ->- do switchContinue -< (fmap (const whenJust_) i,i)- returnA -< Nothing---- | Perform an arbitrary IO action.-ioAction :: (j -> IO p) -> FRP e m j p-ioAction action = frpxOf $ \_ j -> lift $ action j-
− RSAGL/FRP/FRPModel.hs
@@ -1,93 +0,0 @@-{-# LANGUAGE TypeFamilies,- EmptyDataDecls,- UndecidableInstances,- FlexibleContexts #-}---- | A model of the types used by an FRP program.-module RSAGL.FRP.FRPModel- (Enabled,- Disabled,- Capability,- FRPModel(..),- FRP1,- FRPX,- FRPContext,- FRP1Context,- Switch,- SimpleSwitch)- where--import RSAGL.Auxiliary.RecombinantState--class RSAGL_FRP_FRPMODEL a where--data Enabled-data Disabled--class (RSAGL_FRP_FRPMODEL a) => Capability a where--instance RSAGL_FRP_FRPMODEL Enabled where-instance Capability Enabled where-instance RSAGL_FRP_FRPMODEL Disabled where-instance Capability Disabled where--class (RSAGL_FRP_FRPMODEL frp,Eq (ThreadIDOf frp)) => FRPModel frp where- -- | The threading capability, either 'Enabled' or 'Disabled'.- type ThreadingOf frp :: *- -- | The a type of the thread ID (for example, a unique integer).- type ThreadIDOf frp :: *- -- | The 'ArrowState' type.- type StateOf frp :: *- -- | The type of the switch input- -- (used in switchTerminate/switchContinue, etc)- type SwitchInputOf frp :: *- -- | The type of the switch output- -- (used in switchTerminate/switchContinue, etc)- type SwitchOutputOf frp :: *- -- | Unwrap to get the nested Switch type.- type Unwrap frp :: *--instance RSAGL_FRP_FRPMODEL () where--instance FRPModel () where- type ThreadingOf () = Disabled- type ThreadIDOf () = ()- type StateOf () = ()- type SwitchInputOf () = ()- type SwitchOutputOf () = ()- type Unwrap () = ()---- | The FRPModel type that represents a switch.--- Consists of the following type variables.------ Note: Don't pattern-match against this type directly, as it is a volatile--- interface. Either use a type synonym, such as 'SimpleSwitch', or match--- against the type functions in FRPModel.------ * k - See, ThreadingOf.--- * t - See, ThreadIDOf.--- * s - See, StateOf.--- * i - See, SwitchInputOf.--- * o - See, SwitchOutputOf.--- * m - A variable that represents switch nesting.-data Switch k t s i o m--instance (RSAGL_FRP_FRPMODEL m, Capability k) =>- RSAGL_FRP_FRPMODEL (Switch k t s i o m) where--instance (RSAGL_FRP_FRPMODEL m, Eq t, Capability k) =>- FRPModel (Switch k t s i o m) where- type ThreadingOf (Switch k t s i o m) = k- type ThreadIDOf (Switch k t s i o m) = t- type StateOf (Switch k t s i o m) = s- type SwitchInputOf (Switch k t s i o m) = i- type SwitchOutputOf (Switch k t s i o m) = o- type Unwrap (Switch k t s i o m) = m--type FRP1 s i o = Switch Disabled () s i o ()-type FRPX t s i o = FRPContext t i o (FRP1 s i [(t,o)])-type FRPContext t i o m = Switch Enabled t (SubState (StateOf m)) i o m-type FRP1Context i o m = Switch Disabled (ThreadIDOf m) (StateOf m) i o m--type SimpleSwitch k t s i o m = Switch k t s i o m-
− RSAGL/FRP/FactoryArrow.hs
@@ -1,53 +0,0 @@-{-# LANGUAGE Arrows, MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, ExistentialQuantification, Rank2Types #-}--module RSAGL.FRP.FactoryArrow- (FactoryArrow(..))- where--import Prelude hiding ((.),id)-import Control.Arrow-import Control.Monad-import Control.Monad.Fix-import Control.Category---- | An 'Arrow' that constructs an associated monadic computation.-newtype FactoryArrow m n i o = FactoryArrow { runFactory :: m (Kleisli n i o) }--instance (Monad m,Monad n) => Category (FactoryArrow m n) where- (FactoryArrow a) . (FactoryArrow b) = FactoryArrow $- do b' <- b- a' <- a- return $ a' . b'- id = FactoryArrow $ return id--instance (Monad m,Monad n) => Arrow (FactoryArrow m n) where- arr = FactoryArrow . return . arr- first = FactoryArrow . liftM first . runFactory- second = FactoryArrow . liftM second . runFactory--instance (Monad m,MonadFix n) => ArrowLoop (FactoryArrow m n) where- loop = FactoryArrow . liftM loop . runFactory---- | Careful! To implement ArrowApply, the factory action must run imbedded in the constructed action.-instance (Monad m) => ArrowApply (FactoryArrow m m) where- app = factoryApp id---- | Implements ArrowApply for any FactoryArrow capable of it, --- but this requires a way to lift operations in m into n.-factoryApp :: (Monad m,Monad n) => (forall a. m a -> n a) -> FactoryArrow m n (FactoryArrow m n i o,i) o-factoryApp liftM2N = FactoryArrow $ return $ Kleisli $ \(FactoryArrow m,i) ->- do (Kleisli n) <- liftM2N m- n i---- | A choice is constructed at factory time whether or not the constructed action is ever evaluated.-instance (Monad m,Monad n) => ArrowChoice (FactoryArrow m n) where- left = FactoryArrow . liftM left . runFactory- right = FactoryArrow . liftM right . runFactory--instance (Monad m,MonadPlus n) => ArrowZero (FactoryArrow m n) where- zeroArrow = FactoryArrow $ return zeroArrow---- | As with ArrowChoice, both branches are constructed at factory time whether or not the constructed actions are ever evaluated.-instance (Monad m,MonadPlus n) => ArrowPlus (FactoryArrow m n) where- a <+> b = FactoryArrow $ liftM2 (<+>) (runFactory a) (runFactory b)-
− RSAGL/FRP/Time.lhs
@@ -1,162 +0,0 @@-\section{RSAGL.Time}--RSAGL.Time provides a fixed-point (as opposed to a floating-point number) representation of time.-This is necessary because the Float and RSdouble types are inadequate to precisely represent large-quantities of time.--This time library is designed to support real-time animation.--\begin{code}-{-# LANGUAGE TypeSynonymInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses #-}--module RSAGL.FRP.Time- (Time,- Rate,- Acceleration,- Frequency,- fps30,- fps60,- fps120,- minute,- day,- month,- year,- fromSeconds,- toSeconds,- getTime,- cyclical,- cyclical',- over,- rate,- time,- perSecond,- per,- interval,- withTime)- where--import RSAGL.Math.AbstractVector-import System.Time-import RSAGL.Math.Affine-import RSAGL.Types--{-# INLINE time_resolution #-}-time_resolution :: (Num n) => n-time_resolution = 1000000--newtype Time = Time Integer deriving (Show,Eq,Ord)-newtype Rate a = Rate a deriving (Show,Eq,Ord,AffineTransformable)-type Acceleration a = Rate (Rate a)-type Frequency = Rate RSdouble--instance AbstractZero Time where- zero = Time 0--instance AbstractAdd Time Time where- add (Time a) (Time b) = Time $ a + b--instance AbstractSubtract Time Time where- sub (Time a) (Time b) = Time $ a - b--instance AbstractScale Time where- scalarMultiply d (Time t) = Time $ round $ d * fromInteger t--instance AbstractVector Time--instance (AbstractZero a) => AbstractZero (Rate a) where- zero = Rate zero--instance (AbstractAdd a a) => AbstractAdd (Rate a) (Rate a) where- add (Rate a) (Rate b) = Rate $ a `add` b--instance (AbstractSubtract a a) => AbstractSubtract (Rate a) (Rate a) where- sub (Rate a) (Rate b) = Rate $ a `sub` b--instance (AbstractScale a) => AbstractScale (Rate a) where- scalarMultiply d (Rate r) = Rate $ scalarMultiply d r--instance (AbstractVector a) => AbstractVector (Rate a)-\end{code}--\subsection{Getting and Constructing Time}--getTime gets the current, absolute time, using Haskell's standard time facilities, getClockTime.--\begin{code}-minute :: Time-minute = fromSeconds 60--hour :: Time-hour = scalarMultiply 60 minute--day :: Time-day = scalarMultiply 24 hour--month :: Time-month = scalarMultiply 30.43 day--year :: Time-year = scalarMultiply 365.25 month--fps30 :: Frequency-fps30 = perSecond 30--fps60 :: Frequency-fps60 = perSecond 60--fps120 :: Frequency-fps120 = perSecond 120--fromSeconds :: RSdouble -> Time-fromSeconds = Time . round . (* time_resolution)--toSeconds :: Time -> RSdouble-toSeconds (Time t) = fromInteger t / time_resolution--getTime :: IO Time-getTime = - do (TOD secs picos) <- getClockTime- return $ Time $ secs * time_resolution + (picos * time_resolution) `div` 1000000000000-\end{code}--\subsection{Modulo Division for Time}--\texttt{cyclical} answers the amount of time into a cycle. \texttt{cyclical'} answers the fraction of time into a cycle, -in the range \texttt{0 <= x <= 1}.--\begin{code}-cyclical :: Time -> Time -> Time-cyclical (Time t) (Time k) = Time $ t `mod` k--cyclical' :: Time -> Time -> RSdouble-cyclical' t k = (toSeconds $ t `cyclical` k) / toSeconds k-\end{code}--\subsection{Rate as Change over Time}--\begin{code}-{-# INLINE over #-}-over :: (AbstractVector a) => Rate a -> Time -> a-over (Rate a) (Time t) = (fromInteger t / time_resolution) `scalarMultiply` a--{-# INLINE rate #-}-rate :: (AbstractVector a) => (a,Time) -> (a,Time) -> Rate a-rate (x,t1) (y,t2) = (y `sub` x) `per` (t2 `sub` t1)--perSecond :: a -> Rate a-perSecond a = Rate a--{-# INLINE per #-}-per :: (AbstractVector a) => a -> Time -> Rate a-per a (Time t) = Rate $ (recip $ fromInteger t / time_resolution) `scalarMultiply` a--interval :: Frequency -> Time-interval (Rate x) = fromSeconds $ recip x--time :: RSdouble -> Rate RSdouble -> Time-time d r = interval $ withTime (fromSeconds 1) (/d) r--{-# INLINE withTime #-}-withTime :: (AbstractVector a,AbstractVector b) => Time -> (a -> b) -> Rate a -> Rate b-withTime t f = (`per` t) . f . (`over` t)-\end{code}
− RSAGL/Math.hs
@@ -1,23 +0,0 @@-module RSAGL.Math (- module RSAGL.Math.AbstractVector,- module RSAGL.Math.Affine,- module RSAGL.Math.Angle,- module RSAGL.Math.Curve,- module RSAGL.Math.Interpolation,- module RSAGL.Math.Matrix,- module RSAGL.Math.Orthagonal,- module RSAGL.Math.Ray,- module RSAGL.Math.RK4,- module RSAGL.Math.Vector)- where--import RSAGL.Math.AbstractVector-import RSAGL.Math.Affine-import RSAGL.Math.Angle-import RSAGL.Math.Curve-import RSAGL.Math.Interpolation-import RSAGL.Math.Matrix-import RSAGL.Math.Orthagonal-import RSAGL.Math.Ray-import RSAGL.Math.RK4-import RSAGL.Math.Vector
− RSAGL/Math/AbstractVector.hs
@@ -1,203 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, UndecidableInstances #-}---- | Provides generic typeclasses for common operations among many types: addition, subtraction, scalar multiplication, magnitude, and zero.-module RSAGL.Math.AbstractVector- (AbstractVector,- AbstractZero(..),- AbstractAdd(..),- AbstractSubtract(..),- AbstractScale(..),- AbstractMagnitude(..),- abstractScaleTo,- abstractSum,- abstractAverage,- abstractDistance)- where--import Data.Fixed-import Control.Applicative-import RSAGL.Auxiliary.ApplicativeWrapper-import RSAGL.Types--class AbstractZero a where- zero :: a--class AbstractAdd p v | p -> v where- add :: p -> v -> p--class AbstractSubtract p v | p -> v where- sub :: p -> p -> v--class AbstractScale v where- scalarMultiply :: RSdouble -> v -> v--class AbstractMagnitude v where- magnitude :: v -> RSdouble--class (AbstractZero v,AbstractAdd v v,AbstractSubtract v v,AbstractScale v) => AbstractVector v where---- Integer--instance AbstractZero Integer where- zero = 0--instance AbstractAdd Integer Integer where- add = (+)--instance AbstractSubtract Integer Integer where- sub = (-)--instance AbstractMagnitude Integer where- magnitude = abs . fromInteger---- Float--instance AbstractZero Float where- zero = 0--instance AbstractAdd Float Float where- add = (+)--instance AbstractSubtract Float Float where- sub = (-)--instance AbstractScale Float where- scalarMultiply d = (f2f d *)--instance AbstractMagnitude Float where- magnitude = abs . f2f--instance AbstractVector Float---- Double--instance AbstractAdd Double Double where- add = (+)--instance AbstractSubtract Double Double where- sub = (-)--instance AbstractScale Double where- scalarMultiply d = (f2f d *)--instance AbstractMagnitude Double where- magnitude = abs . f2f--instance AbstractVector Double--instance AbstractZero Double where- zero = 0---- Fixed--instance (HasResolution a) => AbstractZero (Fixed a) where- zero = 0--instance (HasResolution a) => AbstractAdd (Fixed a) (Fixed a) where- add = (+)--instance (HasResolution a) => AbstractSubtract (Fixed a) (Fixed a) where- sub = (-)--instance (HasResolution a) => AbstractScale (Fixed a) where- scalarMultiply d = (realToFrac d *)--instance (HasResolution a) => AbstractMagnitude (Fixed a) where- magnitude = abs . realToFrac--instance (HasResolution a) => AbstractVector (Fixed a)---- | ApplicativeWrapper--instance (Applicative f,AbstractZero p) => AbstractZero (ApplicativeWrapper f p) where- zero = pure zero--instance (Applicative f,AbstractAdd p v) => AbstractAdd (ApplicativeWrapper f p) (ApplicativeWrapper f v) where- add p v = add <$> p <*> v--instance (Applicative f,AbstractSubtract p v) => AbstractSubtract (ApplicativeWrapper f p) (ApplicativeWrapper f v) where- sub x y = sub <$> x <*> y--instance (Applicative f,AbstractScale v) => AbstractScale (ApplicativeWrapper f v) where- scalarMultiply d v = scalarMultiply d <$> v--instance (Applicative f,AbstractVector v) => AbstractVector (ApplicativeWrapper f v)---- Tuples--instance (AbstractZero a,AbstractZero b) => AbstractZero (a,b) where- zero = (zero,zero)--instance (AbstractAdd a a',AbstractAdd b b') => AbstractAdd (a,b) (a',b') where- add (a,b) (c,d) = (add a c,add b d)--instance (AbstractSubtract a a',AbstractSubtract b b') => AbstractSubtract (a,b) (a',b') where- sub (a,b) (c,d) = (sub a c,sub b d)--instance (AbstractScale a,AbstractScale b) => AbstractScale (a,b) where- scalarMultiply d (a,b) = (scalarMultiply d a,scalarMultiply d b)--instance (AbstractMagnitude a,AbstractMagnitude b) => AbstractMagnitude (a,b) where- magnitude (a,b) = sqrt $ magnitude a ^ 2 + magnitude b ^ 2--instance (AbstractVector a,AbstractVector b) => AbstractVector (a,b)---- RSfloat--instance AbstractAdd RSfloat RSfloat where- add = (+)--instance AbstractSubtract RSfloat RSfloat where- sub = (-)--instance AbstractScale RSfloat where- scalarMultiply d = (f2f d *)--instance AbstractMagnitude RSfloat where- magnitude = abs . f2f--instance AbstractVector RSfloat--instance AbstractZero RSfloat where- zero = 0---- RSdouble--instance AbstractAdd RSdouble RSdouble where- add = (+)--instance AbstractSubtract RSdouble RSdouble where- sub = (-)--instance AbstractScale RSdouble where- scalarMultiply = (*)--instance AbstractMagnitude RSdouble where- magnitude = abs . f2f--instance AbstractVector RSdouble--instance AbstractZero RSdouble where- zero = 0---- Lists--instance (AbstractScale a) => AbstractScale [a] where- scalarMultiply d = map (scalarMultiply d)---- Generic functions.--abstractScaleTo :: (AbstractScale v,AbstractMagnitude v) => RSdouble -> v -> v-abstractScaleTo _ v | magnitude v == 0 = v-abstractScaleTo x v = scalarMultiply (x / magnitude v) v--abstractSum :: (AbstractAdd p v,AbstractZero p) => [v] -> p-abstractSum = foldr (flip add) zero--abstractAverage :: (AbstractAdd p v,AbstractSubtract p v,AbstractVector v,AbstractZero p) => [p] -> p-abstractAverage vs = zero `add` scalarMultiply (recip $ fromInteger total_count) total_sum- where f y (i,x) = i `seq` x `seq` (i+1,y `add` x)- (total_count,total_sum) = foldr f (0,zero) $ map (`sub` zero) vs--abstractDistance :: (AbstractMagnitude v,AbstractSubtract p v) => p -> p -> RSdouble-abstractDistance x y = magnitude $ x `sub` y
− RSAGL/Math/Affine.hs
@@ -1,145 +0,0 @@--- | Affine Transformations of Arbitrary Geometric Objects-module RSAGL.Math.Affine- (AffineTransformable(..),- scale',- inverseTransform,- withTransformation,- transformAbout,- translateToFrom,- rotateToFrom,- scaleAlong)- where--import Graphics.Rendering.OpenGL.GL as GL hiding (R)-import RSAGL.Math.Vector-import RSAGL.Math.Matrix-import RSAGL.Math.Angle-import RSAGL.Types-import Data.Maybe---- | 'AffineTransformable' objects are subject to affine transformations using matrix multiplication.-class AffineTransformable a where- -- | Apply an affine transformation, defined by a 4x4 matrix. (This is the only required method.)- transform :: RSAGL.Math.Matrix.Matrix -> a -> a- -- | Scale an entity along the @x@ @y@ and @z@ axes. For example, @scale (Vector3D 2 3 4)@ will make an object twice as wide, three times as tall,- -- and four times as deep. It may be helpful to think of the vector as a control point on the vertex of a unit cube.- scale :: Vector3D -> a -> a- scale vector = transform $ scaleMatrix vector- -- | Translate an entity along the specified vector.- translate :: Vector3D -> a -> a- translate vector = transform $ translationMatrix vector- -- | Rotate an entity about the origin, using the specified vector as the axis of rotation.- -- See also 'transformAbout' to rotate around an arbitrary point.- rotate :: Vector3D -> Angle -> a -> a- rotate vector angle = transform $ rotationMatrix vector angle- -- | Specific rotation around the x-axis.- rotateX :: Angle -> a -> a- rotateX = RSAGL.Math.Affine.rotate (Vector3D 1 0 0)- -- | Specific rotation around the y-axis.- rotateY :: Angle -> a -> a- rotateY = RSAGL.Math.Affine.rotate (Vector3D 0 1 0)- -- | Specific rotation around the z-axis.- rotateZ :: Angle -> a -> a- rotateZ = RSAGL.Math.Affine.rotate (Vector3D 0 0 1)---- | Apply the inverse of an affine transformation, defined by a 4x4 matrix.-{-# INLINE inverseTransform #-}-inverseTransform :: (AffineTransformable a) => RSAGL.Math.Matrix.Matrix -> a -> a-inverseTransform m = transform (matrixInverse m)---- | Specific scale preserving proportions.-{-# INLINE scale' #-}-scale' :: (AffineTransformable a) => RSdouble -> a -> a-scale' x = RSAGL.Math.Affine.scale (Vector3D x x x)---- | Apply a function under an affine transformation. @withTransformation m id@ is an identity if @m@ is invertable.-{-# INLINE withTransformation #-}-withTransformation :: (AffineTransformable a) => RSAGL.Math.Matrix.Matrix -> (a -> a) -> a -> a-withTransformation m f = inverseTransform m . f . transform m---- | Apply a function treating a particular point as the origin. For example, combining 'transformAbout' with 'RSAGL.Math.Affine.rotate'--- performs a rotation about an arbitrary point rather than the origin.-{-# INLINE transformAbout #-}-transformAbout :: (AffineTransformable a) => Point3D -> (a -> a) -> a -> a-transformAbout center f = withTransformation (translateToFrom origin_point_3d center identity_matrix) f---- | Specific translation along the vector between two points.--- This ordinary use is to set the second point as the center of a model (typically origin_point_3d)--- and the first point as the desired position of the model.-{-# INLINE translateToFrom #-}-translateToFrom :: (AffineTransformable a) => Point3D -> Point3D -> a -> a-translateToFrom a b = RSAGL.Math.Affine.translate (vectorToFrom a b)---- | Specific rotation along the shortest path that brings the second vector in line with the first.-{-# INLINE rotateToFrom #-}-rotateToFrom :: (AffineTransformable a) => Vector3D -> Vector3D -> a -> a-rotateToFrom u v = RSAGL.Math.Affine.rotate c a- where c = vectorNormalize $ vectorScale (-1) $ fromMaybe (fst $ orthos u) $ aNonZeroVector $ crossProduct u v- a = angleBetween u v---- | Specific scale along an arbitary axis.-{-# INLINE scaleAlong #-}-scaleAlong :: (AffineTransformable a) => Vector3D -> RSdouble -> a -> a-scaleAlong v u = withTransformation (rotateToFrom (Vector3D 0 1 0) v identity_matrix) (RSAGL.Math.Affine.scale (Vector3D 1 u 1))--instance AffineTransformable a => AffineTransformable (Maybe a) where- transform m = fmap (transform m)--instance AffineTransformable a => AffineTransformable [a] where- transform m = map (transform m)--instance (AffineTransformable a,AffineTransformable b) => AffineTransformable (a,b) where- transform m (a,b) = (transform m a,transform m b)--instance (AffineTransformable a,AffineTransformable b,AffineTransformable c) => AffineTransformable (a,b,c) where- transform m (a,b,c) = (transform m a,transform m b,transform m c)--instance AffineTransformable RSAGL.Math.Matrix.Matrix where- transform mat = matrixMultiply mat--instance AffineTransformable Vector3D where- transform m (Vector3D x y z) = transformHomogenous x y z 0 Vector3D m- scale (Vector3D x1 y1 z1) (Vector3D x2 y2 z2) = Vector3D (x1*x2) (y1*y2) (z1*z2)- translate _ = id- rotateX a (Vector3D x y z) = Vector3D x (c*y-s*z) (c*z+s*y)- where s = sine a- c = cosine a- rotateY a (Vector3D x y z) = Vector3D (c*x+s*z) y (c*z-s*x)- where s = sine a- c = cosine a- rotateZ a (Vector3D x y z) = Vector3D (c*x-s*y) (c*y+s*x) z- where s = sine a- c = cosine a--instance AffineTransformable Point3D where- transform m (Point3D x y z) = transformHomogenous x y z 1 Point3D m- scale (Vector3D x1 y1 z1) (Point3D x2 y2 z2) = Point3D (x1*x2) (y1*y2) (z1*z2)- translate (Vector3D x1 y1 z1) (Point3D x2 y2 z2) = Point3D (x1+x2) (y1+y2) (z1+z2)- rotateX a (Point3D x y z) = Point3D x (c*y-s*z) (c*z+s*y)- where s = sine a- c = cosine a- rotateY a (Point3D x y z) = Point3D (c*x+s*z) y (c*z-s*x)- where s = sine a- c = cosine a- rotateZ a (Point3D x y z) = Point3D (c*x-s*y) (c*y+s*x) z- where s = sine a- c = cosine a--instance AffineTransformable SurfaceVertex3D where- transform m (SurfaceVertex3D p v) = SurfaceVertex3D (RSAGL.Math.Affine.transform m p) (RSAGL.Math.Affine.transform (matrixTranspose $ matrixInverse m) v)- translate vector (SurfaceVertex3D p v) = SurfaceVertex3D (RSAGL.Math.Affine.translate vector p) v---- | The IO monad itself is AffineTransformable. This is done by wrapping the IO action in an OpenGL transformation.-instance AffineTransformable (IO a) where- transform mat iofn = preservingMatrix $ do mat' <- newMatrix RowMajor $ map f2f $ concat $ rowMajorForm mat- multMatrix (mat' :: GLmatrix GLdouble)- iofn- translate (Vector3D x y z) iofn = preservingMatrix $ - do GL.translate $ Vector3 (f2f x) (f2f y) (f2f z :: GLdouble)- iofn- scale (Vector3D x y z) iofn = preservingMatrix $ - do GL.scale (f2f x) (f2f y) (f2f z :: GLdouble)- iofn- rotate (Vector3D x y z) angle iofn = preservingMatrix $ - do GL.rotate (f2f $ toDegrees_ angle) (Vector3 (f2f x) (f2f y) (f2f z :: GLdouble))- iofn
− RSAGL/Math/Angle.hs
@@ -1,193 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}-module RSAGL.Math.Angle- (Angle,- BoundAngle(..),- fromDegrees,- fromRadians,- fromRotations,- fromTimeOfDayHMS,- fromArcMinutes,- fromArcSeconds,- sine,- arcSine,- cosine,- arcCosine,- tangent,- arcTangent,- cartesianToPolar,- polarToCartesian,- toRadians,- toRadians_,- toDegrees,- toDegrees_,- toRotations,- toRotations_,- scaleAngle,- supplementaryAngle,- zero_angle,- angularIncrements,- angleAdd,- angleSubtract,- angleNegate,- absoluteAngle,- unboundAngle)- where--import RSAGL.Math.FMod-import RSAGL.Math.AbstractVector-import RSAGL.Types---- | An angular value.-newtype Angle = Radians RSdouble deriving (Show)---- | An angular value. 'BoundAngle's are always in the range between -180 and 180 degrees, inclusive.-newtype BoundAngle = BoundAngle Angle deriving (Show)--zero_angle :: Angle-zero_angle = Radians 0--instance Eq Angle where- (==) a b = case (toRadians_ a,toRadians_ b) of- (x,y) | abs x == pi && abs y == pi -> True- (x,y) | x == y -> True- _ -> False--instance Ord Angle where- compare x y = case () of- _ | x == y -> EQ- _ -> compare (toRadians_ x) (toRadians_ y)--instance AbstractZero Angle where- zero = zero_angle--instance AbstractZero BoundAngle where- zero = BoundAngle zero_angle--instance AbstractAdd Angle Angle where- add = angleAdd--instance AbstractAdd BoundAngle Angle where- add (BoundAngle a) x = BoundAngle $ boundAngle $ a `add` x--instance AbstractSubtract Angle Angle where- sub = angleSubtract--instance AbstractSubtract BoundAngle Angle where- sub (BoundAngle a) (BoundAngle b) = boundAngle $ a `sub` b--instance AbstractScale Angle where- scalarMultiply = scaleAngle--instance AbstractVector Angle--instance AbstractMagnitude Angle where- magnitude = toRotations_ . absoluteAngle---- | angularIncrements answers n evenly distributed angles from 0 to 2*pi.-angularIncrements :: Integer -> [Angle]-angularIncrements subdivisions = map (fromRadians . (2*pi*) . (/ fromInteger subdivisions) . fromInteger) [0 .. subdivisions - 1]---- | There are 2*pi radians in a circle.-fromRadians :: RSdouble -> Angle-fromRadians = Radians---- | There are 260 degrees in a circle.-fromDegrees :: RSdouble -> Angle-fromDegrees = Radians . ((*) (pi/180))---- | There is 1 rotation in a circle.-fromRotations :: RSdouble -> Angle-fromRotations = Radians . ((*) (2*pi))---- | Get an angle based on time of day, hours, minutes, seconds, where noon is considered a zero angle.-fromTimeOfDayHMS :: RSdouble -> RSdouble -> RSdouble -> Angle-fromTimeOfDayHMS h m s = fromRotations (((s/60+m)/60+h)/24)---- | There are 21600 arc minutes in a circle, 60 arc minutes in a degree.-fromArcMinutes :: RSdouble -> Angle-fromArcMinutes = fromDegrees . (/60)---- | There are 1296000 arc seconds in a circle, 60 arc seconds in an arc minutes.-fromArcSeconds :: RSdouble -> Angle-fromArcSeconds = fromArcMinutes . (/60)---- | Answers the angle in the range of -180 to 180, inclusive.-toDegrees :: Angle -> RSdouble-toDegrees x = let x' = toRadians x- in x' * 180 / pi----- | 'toDegrees_' answers the angle in degrees with no range limitation.-toDegrees_ :: Angle -> RSdouble-toDegrees_ (Radians x) = x * 180 / pi---- | 'toRadians' answers the angle in the range of -pi .. pi, inclusive.-toRadians :: Angle -> RSdouble-toRadians x = let (Radians x') = boundAngle x- in x'----- | toRadians answers the angle in radians with no range limitation.-toRadians_ :: Angle -> RSdouble-toRadians_ (Radians x) = x---- | 'toRotations' answers the angle in the range of -0.5 to 0.5, inclusive.-toRotations :: Angle -> RSdouble-toRotations x= let x' = toRadians x- in x' / pi / 2----- | 'toRotations' answers the angle in rotations with no range limitation.-toRotations_ :: Angle -> RSdouble-toRotations_ (Radians x) = x / pi / 2--scaleAngle :: RSdouble -> Angle -> Angle-scaleAngle x = Radians . (*x) . toRadians_--supplementaryAngle :: Angle -> Angle-supplementaryAngle (Radians x) = Radians $ pi - x--angleAdd :: Angle -> Angle -> Angle-angleAdd (Radians x) (Radians y) = Radians $ x + y--angleSubtract :: Angle -> Angle -> Angle-angleSubtract (Radians x) (Radians y) = Radians $ x - y--angleNegate :: Angle -> Angle-angleNegate (Radians x) = Radians $ negate x---- | Absolute value of an angle.-absoluteAngle :: Angle -> Angle-absoluteAngle (Radians x) = Radians $ abs x--sine :: Angle -> RSdouble-sine (Radians x) = sin x--arcSine :: RSdouble -> Angle-arcSine = fromRadians . asin--cosine :: Angle -> RSdouble-cosine (Radians x) = cos x--arcCosine :: RSdouble -> Angle-arcCosine = fromRadians . acos--tangent :: Angle -> RSdouble-tangent (Radians x) = tan x--arcTangent :: RSdouble -> Angle-arcTangent = fromRadians . atan--cartesianToPolar :: (RSdouble,RSdouble) -> (Angle,RSdouble)-cartesianToPolar (u,v) = (fromRadians $ atan2 v u,sqrt $ u*u + v*v)--polarToCartesian :: (Angle,RSdouble) -> (RSdouble,RSdouble)-polarToCartesian (a,d) = (cosine a*d,sine a*d)---- | 'boundAngle' forces the angle into the range (-pi..pi).-boundAngle :: Angle -> Angle-boundAngle (Radians x) = Radians $ if bounded > pi then bounded - 2*pi else bounded- where bounded = x `fmod` (2*pi)--unboundAngle :: BoundAngle -> Angle-unboundAngle (BoundAngle a) = a
− RSAGL/Math/Curve.hs
@@ -1,302 +0,0 @@-{-# LANGUAGE GeneralizedNewtypeDeriving, ExistentialQuantification, Rank2Types #-}-module RSAGL.Math.Curve- (Curve,- zipCurve,- iterateCurve,- transposeCurve,- curve,- Surface,- surface,- wrapSurface,- unwrapSurface,- transposeSurface,- zipSurface,- iterateSurface,- halfIterateSurface,- flipTransposeSurface,- translateCurve,- scaleCurve,- clampCurve,- loopCurve,- controlCurve,- transformCurve2,- uv_identity,- translateSurface,- scaleSurface,- transformSurface,- transformSurface2,- surfaceDerivative,- curveDerivative,- orientationLoops,- newellCurve,- surfaceNormals3D,- SamplingAlgorithm,- IntervalSample,- intervalRange,- intervalSize,- intervalSample,- intervalSingleIntegral,- linearSamples,- adaptiveMagnitudeSamples,- integrateCurve)- where--import RSAGL.Math.Vector-import RSAGL.Math.Angle-import RSAGL.Auxiliary.Auxiliary-import RSAGL.Math.Affine-import Data.List-import Data.Maybe-import Control.Parallel.Strategies-import Control.Applicative-import RSAGL.Math.AbstractVector-import Debug.Trace-import RSAGL.Modeling.BoundingBox-import RSAGL.Math.Interpolation-import RSAGL.Math.FMod-import RSAGL.Types---- | A parametric function that is aware of it's own sampling interval. The first parameter is the sampling interval, while the second is the curve input parameter.-type CurveF a = (RSdouble,RSdouble) -> a--- | A surface is a curve of curves.-type SurfaceF a = CurveF (CurveF a)--- | A 'Curve' is a parametric function from a one-dimensional space into a space of an arbitrary datatype. The key feature of a 'Curve' is that it is aware of it's own--- sampling interval. Using this information and appropriate arithmetic and scalar multiplication functions provided by RSAGL.AbstractVector, a 'Curve' can be differentiated or integrated.-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)- rotateX angle = fmap (rotateX angle)- rotateY angle = fmap (rotateY angle)- rotateZ angle = fmap (rotateZ angle)--instance NFData (Curve a) where- rnf (Curve f) = seq f ()---- | Sample a specific point on a curve given the sampling interval (first parameter) and the point on the curve (second parameter).-sampleCurve :: Curve a -> RSdouble -> RSdouble -> a-sampleCurve (Curve f) = curry f---- | Sample a curve at regular intervals in the range 0..1 inclusive.-iterateCurve :: Integer -> Curve x -> [x]-iterateCurve n c = map f $ zeroToOne n- where f = sampleCurve c (0.25/fromInteger n)---- | Combine two curves using an arbitrary function.-zipCurve :: (x -> y -> z) -> Curve x -> Curve y -> Curve z-zipCurve f (Curve x) (Curve y) = Curve $ \hu -> f (x hu) (y hu)---- | Arbitrarily transform a 'Curve'.-mapCurve :: (CurveF a -> CurveF a) -> Curve a -> Curve a-mapCurve f = Curve . f . fromCurve---- | Arbitrarily transform a surface 'Curve'.-mapCurve2 :: (SurfaceF a -> SurfaceF a) -> Curve (Curve a) -> Curve (Curve a)-mapCurve2 f = Curve . (Curve .) . f . (fromCurve .) . fromCurve---- | Translate a curve along the axis of the input parameter.-translateCurve :: RSdouble -> Curve a -> Curve a-translateCurve x = mapCurve $ \f (h,u) -> f (h,u-x)---- | Scale a curve along the axis of the input parameter. Factors greater than one have a "zoom in" effect, while--- factors less than one have a "zoom out" effect.-scaleCurve :: RSdouble -> Curve a -> Curve a-scaleCurve s = mapCurve (\f (h,u) -> f (h/s,u/s))---- | Clamp lower and upper bounds of a curve along the axis of the input parameter.-clampCurve :: (RSdouble,RSdouble) -> Curve a -> Curve a-clampCurve (a,b) | b < a = clampCurve (b,a)-clampCurve (a,b) = mapCurve $ \f (h,u) -> f (h,min b $ max a u)---- | Loop a curve onto itself at the specified bounds.-loopCurve :: (RSdouble,RSdouble) -> Curve a -> Curve a-loopCurve (a,b) | b < a = loopCurve (b,a)-loopCurve (a,b) = mapCurve $ \f (h,u) -> f (h,(u-a) `fmod` (b-a) + a)---- | Transform a curve by manipulating control points.-controlCurve :: (RSdouble,RSdouble) -> (RSdouble,RSdouble) -> Curve a -> Curve a-controlCurve (u,v) (u',v') = translateCurve u' . scaleCurve ((u'-v') / (u-v)) . translateCurve (negate u)---- | Transpose the inner and outer components of a curve.-transposeCurve :: Curve (Curve a) -> Curve (Curve a)-transposeCurve = mapCurve2 flip---- | Lift two curve transformations onto each axis of a second order curve.-transformCurve2 :: (forall u. Curve u -> Curve u) -> (forall v. Curve v -> Curve v) -> Curve (Curve a) -> Curve (Curve a)-transformCurve2 fu fv = transposeCurve . fu . transposeCurve . fv---- | Define a simple curve.-curve :: (RSdouble -> a) -> Curve a-curve = Curve . uncurry . const---- | A 'Surface' is a based on a 'Curve' with an output of another 'Curve'.-newtype Surface a = Surface (Curve (Curve a)) deriving (NFData,AffineTransformable)---- | Define a simple surface.-surface :: (RSdouble -> RSdouble -> a) -> Surface a-surface f = Surface $ curve (\u -> curve $ flip f u)--wrapSurface :: Curve (Curve a) -> Surface a-wrapSurface = Surface--unwrapSurface :: Surface a -> Curve (Curve a)-unwrapSurface (Surface s) = s---- | Transpose the axes of a 'Surface'.-transposeSurface :: Surface a -> Surface a-transposeSurface (Surface s) = Surface $ transposeCurve s---- | Sample a surface at regularly spaced lattice points in the range 0..1 inclusive.-iterateSurface :: (Integer,Integer) -> Surface a -> [[a]]-iterateSurface (u,v) (Surface s) = map (iterateCurve u) $ iterateCurve v s---- | Sample the outer 'Curve' of a 'Surface' at regularly spaced intervals.-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---- | Combine two surfaces using an arbitrary function.-zipSurface :: (x -> y -> z) -> Surface x -> Surface y -> Surface z-zipSurface f (Surface x) (Surface y) = Surface $ zipCurve (zipCurve f) x y---- | Lift a transformation on a second order 'Curve' onto a Surface.-transformSurface :: (Curve (Curve a) -> Curve (Curve a)) -> Surface a -> Surface a-transformSurface f = Surface . f . unwrapSurface---- | Lift two curve transformations onto each axis of a Surface.-transformSurface2 :: (forall u. Curve u -> Curve u) -> (forall v. Curve v -> Curve v) -> Surface a -> Surface a-transformSurface2 fu fv = transformSurface (transformCurve2 fu fv)---- | Translate a surface over each of its input parameter axes, as translateCurve.-translateSurface :: (RSdouble,RSdouble) -> Surface a -> Surface a-translateSurface (u,v) = transformSurface2 (translateCurve u) (translateCurve v)---- | Scale a surface along each of its input parameter axes, as scaleCurve.-scaleSurface :: (RSdouble,RSdouble) -> Surface a -> Surface a-scaleSurface (u,v) = transformSurface2 (scaleCurve u) (scaleCurve v)---- | Transpose a surface while flipping the inner curve, so that that orientable surfaces retain their original orientation.-flipTransposeSurface :: Surface a -> Surface a-flipTransposeSurface = transformSurface (mapCurve2 $ \f (hu,u) (hv,v) -> f (hu,u) (hv,1-v)) . transposeSurface---- | An identity 'Surface'.-uv_identity :: Surface (RSdouble,RSdouble)-uv_identity = surface (curry id)---- | Take the derivative of a 'Curve'.-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,u-h)---- | Take the piecewise derivative of a 'Surface' along the inner and outer curves.-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---- | Determine the orientation of a 'Surface' by passing very small circles centered on each sampled point as the parametric input.------ A gotchya with this operation is that as much as 3/4ths of the orientation loop may lie outside of the 0..1 range that is normally--- sampled. Depending on how the surface is constructed, this may produce unexpected results. The solution is to clamp the--- the problematic parametric inputs at 0 and 1 using 'clampSurface'.------ As a rule, do clamp longitudinal axes that come to a singularity at each end.--- Do not clamp latitudinal axes that are connected at each end.----orientationLoops :: Surface p -> Surface (Curve p)-orientationLoops (Surface s) = Surface $ Curve $ \(uh,u) -> Curve $ \(vh,v) ->- curve $ \t -> f (uh/2,u + uh*(sine $ fromRotations t)) - (vh/2,v + vh*(cosine $ fromRotations t))- where f = fromCurve . fromCurve s---- | Try to determine the normal vector to a curve.-newellCurve :: Curve Point3D -> Maybe Vector3D-newellCurve c = newell $ iterateCurve 16 c---- | Try to determine the normal vectors of a surface using orientation loops. This is usually slower but more successful than 'surfaceNormals3DByPartialDerivatives'.--- This generate a warning message if it cannot determine the normal vector at a sampled point.--- See also 'orientationLoops'.-surfaceNormals3DByOrientationLoops :: Surface Point3D -> Surface SurfaceVertex3D-surfaceNormals3DByOrientationLoops s = SurfaceVertex3D <$> s <*> ((\c -> errmsg c (newellCurve c)) <$> orientationLoops s)- where errmsg c = fromMaybe (trace ("surfaceNormals3DByOrientationLoops: zero normal gave up: " ++ show (iterateCurve 16 c)) (Vector3D 0 0 0))---- | Try to determine the normal vectors of a surface using partial derivatives.-surfaceNormals3DByPartialDerivatives :: Surface Point3D -> Surface (Maybe Vector3D)-surfaceNormals3DByPartialDerivatives s = safeCrossProduct <$> surfaceDerivative s- where x = snd $ boundingCenterRadius $ boundingBox $ concat $ iterateSurface (8,8) s- safeCrossProduct (u_,v_) =- do u <- aLargeVector (x/100) u_- v <- aLargeVector (x/100) v_- return $ vectorNormalize $ crossProduct u v---- | Try to determine the normal vectors of a surface using multiple techniques.-surfaceNormals3D :: Surface Point3D -> Surface SurfaceVertex3D-surfaceNormals3D s = (\p by_pd by_newell -> case by_pd of- Just v -> SurfaceVertex3D p v- Nothing -> by_newell) <$>- s <*> (surfaceNormals3DByPartialDerivatives s) <*> (surfaceNormals3DByOrientationLoops s)---- | An interval of a curve, including the curve, lower and upper bounds of the interval, and an instantaneous sample value for that interval.-data IntervalSample a = IntervalSample (Curve a) RSdouble RSdouble a--intervalSample :: Curve a -> RSdouble -> RSdouble -> IntervalSample a-intervalSample c l h = IntervalSample c l h $ sampleCurve c ((abs $ l - h) / 2) ((l+h) / 2) ---- | Lower and upper bounds of an 'IntervalSample'.-intervalRange :: IntervalSample a -> (RSdouble,RSdouble)-intervalRange (IntervalSample _ l h _) = (l,h)---- | Size of the range of an 'IntervalSample'.-intervalSize :: IntervalSample a -> RSdouble-intervalSize (IntervalSample _ l h _) = abs $ h - l---- | Instantaneous sample value of an 'Interval'.-intervalValue :: IntervalSample a -> a-intervalValue (IntervalSample _ _ _ a) = a---- | Integral of the sample value over the range of the 'IntervalSample'.-intervalSingleIntegral :: (AbstractScale a) => IntervalSample a -> a-intervalSingleIntegral x = scalarMultiply (intervalSize x) $ intervalValue x---- | Split an interval into three equal parts.-splitInterval :: IntervalSample a -> [IntervalSample a]-splitInterval (IntervalSample c l h a) = [intervalSample c l l',IntervalSample c l' h' a,intervalSample c h' h]- where l' = lerp (1/3) (l,h)- h' = lerp (2/3) (l,h)--type SamplingAlgorithm a = Curve a -> [IntervalSample a]---- | Definite integral of a curve.-integrateCurve :: (AbstractAdd p v,AbstractScale v,AbstractZero p) => SamplingAlgorithm v -> Curve v -> p -> p-integrateCurve samplingAlgorithm c initial_value = foldl' add initial_value $ map intervalSingleIntegral $ samplingAlgorithm c---- | Sampling algorithm that takes a fixed count of samples.-linearSamples :: Integer -> SamplingAlgorithm a-linearSamples n c = map (\(l,h) -> intervalSample c l h) $ doubles $ zeroToOne (n+1)---- | Sampling algorithm that takes increasing numbers of samples over intervals where the magnitude of the sample is large.-adaptiveMagnitudeSamples :: (AbstractMagnitude a) => Integer -> SamplingAlgorithm a-adaptiveMagnitudeSamples n c = resampleLoop (\xs -> if genericLength xs > n then Nothing else Just $ newSamples xs) $ linearSamples (max 1 $ n `div` 10) c- where newSamples xs = let a = abstractAverage $ map intervalMagnitude xs- in flip concatMap xs $ \x -> if intervalMagnitude x >= a then splitInterval x else [x]- intervalMagnitude :: (AbstractMagnitude a) => IntervalSample a -> RSdouble- intervalMagnitude (IntervalSample _ l h a) = magnitude a * (abs $ h-l)---- | Loop to keep generating samples until finished.-resampleLoop :: (b -> Maybe b) -> b -> b-resampleLoop nextPass initial_value = f $ initial_value- where f x = maybe x f $ nextPass x
− RSAGL/Math/CurveExtras.lhs
@@ -1,110 +0,0 @@-\section{Specific and Interpolated Curves}--\begin{code}-module RSAGL.Math.CurveExtras- (sphericalCoordinates,- cylindricalCoordinates,- toroidalCoordinates,- circularCoordinates,- polarCoordinates,- transformUnitSquareToUnitCircle,- transformUnitCubeToUnitSphere,- circleXY,- regularPolygon,- linearInterpolation,- loopedLinearInterpolation,- smoothCurve,- loopCurve)- where--import RSAGL.Math.Curve-import RSAGL.Math.Interpolation-import RSAGL.Math.Vector-import RSAGL.Math.Angle-import RSAGL.Auxiliary.Auxiliary-import RSAGL.Math.AbstractVector-import RSAGL.Math.Affine-import Control.Arrow-import RSAGL.Types-\end{code}--\subsection{Alternate Coordinate Systems for Models}--\begin{code}-sphericalCoordinates :: ((Angle,Angle) -> a) -> Surface a-sphericalCoordinates f = transformSurface2 id (clampCurve (0,1)) $ surface $ curry (f . (\(u,v) -> (fromRadians $ u*2*pi,fromRadians $ ((pi/2) - v*pi))))--cylindricalCoordinates :: ((Angle,RSdouble) -> a) -> Surface a-cylindricalCoordinates f = transformSurface2 id (clampCurve (0,1)) $ surface $ curry (f . (\(u,v) -> (fromRadians $ u*2*pi,v)))--toroidalCoordinates :: ((Angle,Angle) -> a) -> Surface a-toroidalCoordinates f = surface $ curry (f . (\(u,v) -> (fromRadians $ u*2*pi,fromRadians $ negate $ v*2*pi)))--circularCoordinates :: ((RSdouble,RSdouble) -> a) -> Surface a-circularCoordinates f = surface $ curry $ (f . second negate . transformUnitSquareToUnitCircle)--polarCoordinates :: ((Angle,RSdouble) -> a) -> Surface a-polarCoordinates f = circularCoordinates (f . cartesianToPolar)-\end{code}--\subsection{Transformations Between Unit Volumes}--\begin{code}-transformUnitSquareToUnitCircle :: (RSdouble,RSdouble) -> (RSdouble,RSdouble)-transformUnitSquareToUnitCircle (u,v) = (x,z)- where (Point3D x _ z) = transformUnitCubeToUnitSphere (Point3D u 0.5 v)--transformUnitCubeToUnitSphere :: Point3D -> Point3D-transformUnitCubeToUnitSphere p =- let p_centered@(Point3D x y z) = scale' 2.0 $ translate (Vector3D (-0.5) (-0.5) (-0.5)) p- p_projected = scale' (minimum [recip $ abs x,recip $ abs y,recip $ abs z]) p_centered- k = recip $ distanceBetween origin_point_3d p_projected- w = maximum $ [abs x, abs y, abs z] -- 'w' could be 1, but this gives a smoother tesselation- in if p_centered == origin_point_3d then origin_point_3d else lerp w (p_centered,scale' k p_centered)-\end{code}--\subsection{Circles}--\begin{code}-circleXY :: Curve Point3D-circleXY = curve $ \u_ -> let u = fromRotations u_ in Point3D (cosine u) (sine u) 0-\end{code}--\subsection{Regular Polygons}--A regular polygon, centered at the origin, in the XY plane.--\begin{code}-regularPolygon :: Integer -> Curve Point3D-regularPolygon n = loopedLinearInterpolation $ map (flip rotateZ (Point3D 0 1 0) . fromRotations) $ zeroToOne n-\end{code}--\subsection{Piecewise Length Normalization}--\begin{code}-normalizePolyline :: (AbstractSubtract p v,AbstractMagnitude v) => [p] -> [(RSdouble,p)]-normalizePolyline pts = zip (map (/ total_dist) accumulated_dists) pts- where dists = map (uncurry abstractDistance) $ doubles pts- total_dist = last accumulated_dists- accumulated_dists = scanl (+) 0 dists-\end{code}--\subsection{Interpolated Curves}--\begin{code}-linearInterpolation :: (AbstractSubtract p v,AbstractAdd p v,AbstractMagnitude v,AbstractScale v) => [p] -> Curve p-linearInterpolation = curve . lerpMap . normalizePolyline--loopedLinearInterpolation :: (AbstractSubtract p v,AbstractAdd p v,AbstractMagnitude v,AbstractScale v) => [p] -> Curve p-loopedLinearInterpolation = loopCurve (0,1) . linearInterpolation . (\a -> last a:a)-\end{code}--\subsection{Smoothing Curves}--\texttt{smoothCurve i h} takes i samples of an h-long piece of a 'Curve' at each point to smooth it. This is not an interpolation function and will tend to shrink shapes-toward their center of gravity.--\begin{code}-smoothCurve :: (AbstractAdd p v,AbstractSubtract p v,AbstractVector v,AbstractZero p) => Integer -> RSdouble -> Curve p -> Curve p-smoothCurve i h c = curve $ \u -> abstractAverage $ iterateCurve i $ controlCurve (u-h/2,u+h/2) (0,1) c-\end{code}
− RSAGL/Math/FMod.hs
@@ -1,24 +0,0 @@-module RSAGL.Math.FMod- (FMod(..))- where--import RSAGL.Types--class FMod f where- fmod :: f -> f -> f--instance FMod Float where- fmod n d = n - fromInteger f * d- where f = floor $ n / d--instance FMod Double where- fmod n d = n - fromInteger f * d- where f = floor $ n / d--instance FMod RSfloat where- fmod n d = n - fromInteger f * d- where f = floor $ n / d--instance FMod RSdouble where- fmod n d = n - fromInteger f * d- where f = floor $ n / d
− RSAGL/Math/Interpolation.lhs
@@ -1,109 +0,0 @@-\section{RSAGL.Interpolation}--\begin{code}-module RSAGL.Math.Interpolation- (lerp,- lerpClamped,- lerpBetween,- lerpBetweenMutated,- lerpBetweenClamped,- lerpBetweenClampedMutated,- lerp_mutator_continuous_1st,- lerpMap)- where--import RSAGL.Math.AbstractVector-import Data.Map as Map-import Data.Maybe-import RSAGL.Types-\end{code}--\subsection{The Lerpable typeclass}--Implements linear interpolation.--\begin{code}-{-# INLINE lerp #-}-lerp :: (AbstractScale v,AbstractSubtract p v,AbstractAdd p v,RealFloat r) => r -> (p,p) -> p-lerp u (a,b) = a `add` scalarMultiply (f2f u) (b `sub` a)-\end{code}--\subsection{Non-linear interpolations}--The mutated versions of the lerp functions takes an arbitrary ``mutator function'' to define non-linear interpolation curves.-The ``between'' versions of the lerp functions allow the u-value to lie between any two numbers, as opposed to between 0 and 1.-The ``clamped'' versions of the lerp functions clamp the u-value to lie between its boundaries. Otherwise, with non-clamped-interpolations, the u-value may lie outside of its boundaries.--\begin{code}-{-# INLINE lerpClamped #-}--lerpClamped :: (AbstractScale v,AbstractSubtract p v,AbstractAdd p v,RealFloat r) => r -> (p,p) -> p-lerpClamped u = lerpBetweenClamped (0,u,1)--{-# INLINE lerpBetween #-}-lerpBetween :: (AbstractScale v,AbstractSubtract p v,AbstractAdd p v,RealFloat r) => (r,r,r) -> (p,p) -> p-lerpBetween = lerpBetweenMutated id--{-# INLINE lerpBetweenMutated #-}-lerpBetweenMutated :: (AbstractScale v,AbstractSubtract p v,AbstractAdd p v,RealFloat r) => (r -> r) -> (r,r,r) -> (p,p) -> p-lerpBetweenMutated _ (l,_,r) | l == r = lerp 0.5-lerpBetweenMutated mutator (l,u,r) = lerp $ mutator $ (u-l) / (r-l)--{-# INLINE lerpBetweenClamped #-}-lerpBetweenClamped :: (AbstractScale v,AbstractSubtract p v,AbstractAdd p v,RealFloat r,Ord r) => (r,r,r) -> (p,p) -> p-lerpBetweenClamped = lerpBetweenClampedMutated id--{-# INLINE lerpBetweenClampedMutated #-}-lerpBetweenClampedMutated :: (AbstractScale v,AbstractSubtract p v,AbstractAdd p v,RealFloat r,Ord r) => (r -> r) -> (r,r,r) -> (p,p) -> p-lerpBetweenClampedMutated mutator (l,u,r) = lerpBetweenMutated (lerp_mutator_clamp . mutator) (l,u,r)-\end{code}--\subsection{Lerp mutators}--\texttt{lerp\_mutator\_clamp} implements clamping between 0 and 1.--\begin{code}-{-# INLINE lerp_mutator_clamp #-}--lerp_mutator_clamp :: (RealFloat r) => r -> r-lerp_mutator_clamp = min 1 . max 0-\end{code}--\texttt{lerp\_mutator\_continuous\_1st} implements clamping between 0 and 1, but such that the 1st derivative of the result is continuous.--\begin{code}-{-# INLINE lerp_mutator_continuous_1st #-}--lerp_mutator_continuous_1st :: (RealFloat r) => r -> r-lerp_mutator_continuous_1st x | x < 0 = 0-lerp_mutator_continuous_1st x | x > 1 = 1-lerp_mutator_continuous_1st x | x <= 0.5 = 2*x^2-lerp_mutator_continuous_1st x = 4*x - 2*x^2 - 1-\end{code}--\subsection{lerpMap}--Given many entities, lerp between the two entities closest to the given point-on either side. For example, if we wanted to lerp between colors on a rainbow,-we might use the map [(0,red),(1,orange),(2,yellow),(3,green),(4,blue),(5,indigo),(6,violet)].-lerpMap 3.5 would result in a blue-green color.--\begin{code}-{-# INLINE lerpMap #-}--lerpMap :: (RealFloat r,AbstractScale v,AbstractSubtract p v,AbstractAdd p v) => [(r,p)] -> r -> p-lerpMap pts = lerpMapSorted $ Map.fromList pts--{-# INLINE lerpMapSorted #-}-lerpMapSorted :: (RealFloat r,AbstractScale v,AbstractSubtract p v,AbstractAdd p v) => Map r p -> r -> p-lerpMapSorted m _ | Map.null m = error "lerpMapSorted: empty map"-lerpMapSorted m u = case () of- () | isJust exactly -> fromJust exactly- () | Map.null lowers -> higher_a- () | Map.null highers -> lower_a- () -> lerpBetween (lower_r,u,higher_r) (lower_a,higher_a)- where (lowers, exactly, highers) = splitLookup u m- (lower_r,lower_a) = findMax lowers- (higher_r,higher_a) = findMin highers-\end{code}
− RSAGL/Math/Matrix.lhs
@@ -1,190 +0,0 @@-\section{RSAGL.Matrix}--\begin{code}--module RSAGL.Math.Matrix- (Matrix,- matrix,- transformHomogenous,- rowMajorForm,- colMajorForm,- rowAt,- matrixAt,- identity_matrix,- translationMatrix,- rotationMatrix,- scaleMatrix,- xyzMatrix,- matrixAdd,- matrixMultiply,- matrixTranspose,- matrixInverse,- determinant,- matrixInversePrim,- matrixTransposePrim,- matrixInverseTransposePrim,- determinantPrim)- where--import Data.List as List-import RSAGL.Math.Angle-import RSAGL.Math.Vector-import Data.Vec as Vec-import RSAGL.Types-\end{code}--A 4-by-4 matrix with cached inverse, transpose, inverse transpose, and determinant.--\begin{code}-data Matrix = Matrix { matrix_data :: !(Mat44 RSdouble),- matrix_inverse :: Matrix,- matrix_transpose :: Matrix,- matrix_determinant :: RSdouble }--instance Eq Matrix where- x == y = matrix_data x == matrix_data y--instance Show Matrix where- show m = show $ rowMajorForm m--rowMajorForm :: Matrix -> [[RSdouble]]-rowMajorForm = matToLists . matrix_data--colMajorForm :: Matrix -> [[RSdouble]]-colMajorForm = List.transpose . rowMajorForm-\end{code}--rowAt answers the nth row of a matrix.--\begin{code}-rowAt :: Matrix -> Int -> [RSdouble]-rowAt m n = (rowMajorForm m) !! n-\end{code}--matrixAt answers the (i'th,j'th) element of a matrix.--\begin{code}-matrixAt :: Matrix -> (Int,Int) -> RSdouble-matrixAt m (i,j) = rowAt m i !! j-\end{code}--\subsection{Constructing matrices}--matrix constructs a matrix from row major list form. (Such a list form can be formatted correctly in -monospaced font and haskell syntax, so that it looks like a matrix as it would be normally written.)--\begin{code}-matrix :: [[RSdouble]] -> Matrix-matrix = uncheckedMatrix . matFromLists---- | Generate a column matrix of length 4, perform an affine transformation on it, and produce the resulting value.-{-# INLINE transformHomogenous #-}-transformHomogenous :: RSdouble -> RSdouble -> RSdouble -> RSdouble -> (RSdouble -> RSdouble -> RSdouble -> a) -> Matrix -> a-transformHomogenous x y z w f m = f x' y' z'- where (x':.y':.z':._) = multmv (matrix_data m) (x:.y:.z:.w:.())--uncheckedMatrix :: Mat44 RSdouble -> Matrix-uncheckedMatrix dats = m- where m_inverse = (matrixInversePrim m) { matrix_inverse = m, matrix_transpose = m_inverse_transpose, matrix_determinant = recip m_det }- m_transpose = (matrixTransposePrim m) { matrix_inverse = m_inverse_transpose, matrix_transpose = m, matrix_determinant = m_det }- m_inverse_transpose = (matrixTransposePrim m_inverse) { matrix_inverse = m_transpose, matrix_transpose = m_inverse, matrix_determinant = recip m_det }- m_det = determinantPrim m- m = Matrix { matrix_data=dats,- matrix_inverse = m_inverse,- matrix_transpose = m_transpose,- matrix_determinant = m_det }-\end{code}--identityMatrix constructs the n by n identity matrix--\begin{code}-identity_matrix :: Matrix-identity_matrix = Matrix {- matrix_data = identity,- matrix_inverse = identity_matrix,- matrix_transpose = identity_matrix,- matrix_determinant = 1 }-\end{code}--\begin{code}-translationMatrix :: Vector3D -> Matrix-translationMatrix (Vector3D x y z) = uncheckedMatrix $ (1:.0:.0:.x:.()) :.- (0:.1:.0:.y:.()) :.- (0:.0:.1:.z:.()) :.- (0:.0:.0:.1:.()) :. ()-\end{code}--\begin{code}-rotationMatrix :: Vector3D -> Angle -> Matrix-rotationMatrix vector angle = let s = sine angle- c = cosine angle- c' = 1 - c- (Vector3D x y z) = vectorNormalize vector- in uncheckedMatrix $ ((c+c'*x*x) :. (c'*y*x - s*z) :. (c'*z*x + s*y) :. 0 :. ()) :.- ((c'*x*y+s*z) :. (c+c'*y*y) :. (c'*z*y - s*x) :. 0 :. ()) :.- ((c'*x*z-s*y) :. (c'*y*z+s*x) :. (c+c'*z*z) :. 0 :. ()) :.- (0 :. 0 :. 0 :. 1 :. ()) :. ()-\end{code}--\begin{code}-scaleMatrix :: Vector3D -> Matrix-scaleMatrix (Vector3D x y z) = uncheckedMatrix $ (x :. 0 :. 0 :. 0) :.- (0 :. y :. 0 :. 0) :.- (0 :. 0 :. z :. 0) :.- (0 :. 0 :. 0 :. 1) :. ()-\end{code}--\texttt{xyzMatrix} constructs the matrix in which the x y and z axis are transformed to point in the direction of the specified-vectors.--\begin{code}-xyzMatrix :: Vector3D -> Vector3D -> Vector3D -> Matrix-xyzMatrix (Vector3D x1 y1 z1) (Vector3D x2 y2 z2) (Vector3D x3 y3 z3) =- uncheckedMatrix $ (x1 :. x2 :. x3 :. 0) :.- (y1 :. y2 :. y3 :. 0) :.- (z1 :. z2 :. z3 :. 0) :.- (0 :. 0 :. 0 :. 1.0) :. ()-\end{code}--\subsection{Matrix arithmetic}--\begin{code}-matrixAdd :: Matrix -> Matrix -> Matrix-matrixAdd m n = uncheckedMatrix $ Vec.zipWith (+) (matrix_data m) (matrix_data n)-\end{code}--\label{howtoUseMatrixMultiplyImpl}--\begin{code}-matrixMultiply :: Matrix -> Matrix -> Matrix-matrixMultiply m n = uncheckedMatrix $ multmm (matrix_data m) (matrix_data n)--matrixTranspose :: Matrix -> Matrix-matrixTranspose = matrix_transpose-\end{code}--\subsection{Inverse and determinant of a matrix}--\begin{code}-matrixInverse :: Matrix -> Matrix-matrixInverse = matrix_inverse-\end{code}--\begin{code}-determinant :: Matrix -> RSdouble-determinant = matrix_determinant-\end{code}--\begin{code}-matrixInverseTransposePrim :: Matrix -> Matrix-matrixInverseTransposePrim = uncheckedMatrix . Vec.transpose . fst . invertAndDet . matrix_data--matrixInversePrim :: Matrix -> Matrix-matrixInversePrim = uncheckedMatrix . fst . invertAndDet . matrix_data--determinantPrim :: Matrix -> RSdouble-determinantPrim = det . matrix_data--matrixTransposePrim :: Matrix -> Matrix-matrixTransposePrim = uncheckedMatrix . Vec.transpose . matrix_data-\end{code}
− RSAGL/Math/Orthagonal.lhs
@@ -1,83 +0,0 @@-\section{Orthagonal Unit-Scaled Coordinate Systems}--It's useful to work with the set of coordinate systems restricted to those that use orthagonal unit-scaled axes, that is, that are subject only to rotation and translation.-This is because these coordinate systems are the only ones that describe rigid objects.--\begin{code}-module RSAGL.Math.Orthagonal- (up,down,left,right,forward,backward,- orthagonalFrame,- modelLookAt,- FUR)- where--import RSAGL.Math.Affine-import RSAGL.Math.Vector-import RSAGL.Math.Matrix-\end{code}--\texttt{FUR} stands for Forward Up Right. It's used to specify arbitrary orthagonal coordinate systems given any combination-of forward up and right vectors. It also accepts down, left, and backward vectors.--\texttt{right} is positive X, \texttt{up} is positive Y, \texttt{forward} is positive Z.--When specifying \texttt{FUR} coordinate systems, the first vector is fixed, while the second vector will be adjusted as little as possible to -guarantee that it is orthagonal to the first. The third vector never needs to be specified, it can be deduced.--\begin{code}-data FURAxis = ForwardAxis | UpAxis | RightAxis | DownAxis | LeftAxis | BackwardAxis--data FUR a = FUR FURAxis a--instance Functor FUR where- fmap f (FUR a x) = FUR a $ f x--up :: a -> FUR a-up = FUR UpAxis--down :: a -> FUR a-down = FUR DownAxis--left :: a -> FUR a-left = FUR LeftAxis--right :: a -> FUR a-right = FUR RightAxis--forward :: a -> FUR a-forward = FUR ForwardAxis--backward :: a -> FUR a-backward = FUR BackwardAxis--orthagonalFrame :: (AffineTransformable a) => FUR Vector3D -> FUR Vector3D -> a -> a-orthagonalFrame (FUR ForwardAxis f) (FUR RightAxis r) = let (r',u') = fixOrtho2 f r in transform (xyzMatrix r' u' (vectorNormalize f))-orthagonalFrame (FUR UpAxis u) (FUR ForwardAxis f) = let (f',r') = fixOrtho2 u f in transform (xyzMatrix r' (vectorNormalize u) f')-orthagonalFrame (FUR RightAxis r) (FUR UpAxis u) = let (u',f') = fixOrtho2 r u in transform (xyzMatrix (vectorNormalize r) u' f')-orthagonalFrame (FUR RightAxis r) (FUR ForwardAxis f) = let (f',u') = fixOrtho2Left r f in transform (xyzMatrix (vectorNormalize r) u' f')-orthagonalFrame (FUR ForwardAxis f) (FUR UpAxis u) = let (u',r') = fixOrtho2Left f u in transform (xyzMatrix r' u' (vectorNormalize f))-orthagonalFrame (FUR UpAxis u) (FUR RightAxis r) = let (r',f') = fixOrtho2Left u r in transform (xyzMatrix r' (vectorNormalize u) f')-orthagonalFrame (FUR ForwardAxis _) (FUR ForwardAxis _) = error "orthagonalFrame: two forward vectors"-orthagonalFrame (FUR UpAxis _) (FUR UpAxis _) = error "orthagonalFrame: two up vectors"-orthagonalFrame (FUR RightAxis _) (FUR RightAxis _) = error "orthagonalFrame: two right vectors"-orthagonalFrame x y = orthagonalFrame (furCorrect x) (furCorrect y)--furCorrect :: FUR Vector3D -> FUR Vector3D-furCorrect (FUR ForwardAxis f) = FUR ForwardAxis f-furCorrect (FUR UpAxis u) = FUR UpAxis u-furCorrect (FUR RightAxis r) = FUR RightAxis r-furCorrect (FUR DownAxis d) = FUR UpAxis $ vectorScale (-1) d-furCorrect (FUR LeftAxis l) = FUR RightAxis $ vectorScale (-1) l-furCorrect (FUR BackwardAxis b) = FUR ForwardAxis $ vectorScale (-1) b-\end{code}--\texttt{modelLookAt} generates the affine transformation needed to aim a model at a given position either at a point or along a vector.-The first parameter is the position of the model. Typically the second parameter will be the position of the target, and the -third parameter will \texttt{(up \$ Vector3D 0 1 0)}.--\begin{code}-modelLookAt :: (AffineTransformable a) => Point3D -> FUR (Either Point3D Vector3D) -> FUR (Either Point3D Vector3D) -> a -> a-modelLookAt pos primaryish secondaryish = RSAGL.Math.Affine.translate (vectorToFrom pos origin_point_3d) . orthagonalFrame primary secondary- where primary = fmap (either (`vectorToFrom` pos) id) primaryish- secondary = fmap (either (`vectorToFrom` pos) id) secondaryish-\end{code}
− RSAGL/Math/RK4.lhs
@@ -1,47 +0,0 @@-\section{Runge-Kutta}--Haskell implementation of RK4.--\begin{code}-module RSAGL.Math.RK4- (rk4,- integrateRK4,- rk4',- integrateRK4')- where--import RSAGL.Math.AbstractVector-import RSAGL.FRP.Time-\end{code}--\begin{code}-genericRK4 :: (AbstractVector v) => (Time -> p -> v -> p) -> (Time -> p -> Rate v) -> p -> Time -> Time -> p-genericRK4 addPV diffF p0 t0 t1 = addPV h p0 $ (scalarMultiply (recip 6) (abstractSum [k1,k2,k2,k3,k3,k4]) `over` h)- where k1 = diffF t0 p0- k2 = diffF tmid (addPV h2 p0 $ k1 `over` h2)- k3 = diffF tmid (addPV h2 p0 $ k2 `over` h2)- k4 = diffF t1 (addPV h p0 $ k3 `over` h)- h = t1 `sub` t0- h2 = scalarMultiply (recip 2) h- tmid = t0 `add` h2--rk4 :: (AbstractVector v) => (p -> v -> p) -> (Time -> p -> Rate v) -> p -> Time -> Time -> p-rk4 addPV = genericRK4 (const addPV)--rk4' :: (AbstractVector v) => (p -> v -> p) -> (Time -> p -> Rate v -> Acceleration v) -> (p,Rate v) -> Time -> Time -> (p,Rate v)-rk4' addPV diffF = genericRK4- (\t (p,old_v) delta_v -> let new_v = old_v `add` delta_v in (addPV p $ (scalarMultiply (recip 2) $ old_v `add` new_v) `over` t,new_v))- (\t (p,v) -> diffF t p v)--genericIntegrate :: (p -> Time -> Time -> p) -> p -> Time -> Time -> Integer -> p-genericIntegrate _ pn _ _ 0 = pn-genericIntegrate f p0 t0 tn n = genericIntegrate f p1 t1 tn (n-1)- where t1 = t0 `add` (scalarMultiply (recip $ fromInteger n) $ tn `sub` t0)- p1 = f p0 t0 t1--integrateRK4 :: (AbstractVector v) => (p -> v -> p) -> (Time -> p -> Rate v) -> p -> Time -> Time -> Integer -> p-integrateRK4 addPV diffF = genericIntegrate $ rk4 addPV diffF--integrateRK4' :: (AbstractVector v) => (p -> v -> p) -> (Time -> p -> Rate v -> Acceleration v) -> (p,Rate v) -> Time -> Time -> Integer -> (p,Rate v)-integrateRK4' addPV diffF = genericIntegrate $ rk4' addPV diffF-\end{code}
− RSAGL/Math/Ray.lhs
@@ -1,42 +0,0 @@-\section{Ray.hs}--\begin{code}-module RSAGL.Math.Ray- (Ray3D(..),- projectRay,- distanceAlong,- angleFrom,- normalizeRay) - where--import RSAGL.Math.Vector-import RSAGL.Math.Angle-import RSAGL.Math.Affine-import RSAGL.Types-\end{code}--\subsection{Rays in 3-space}--A \texttt{Ray3D} has a endpoint and direction.--\begin{code}-data Ray3D = Ray3D { ray_endpoint :: Point3D,- ray_vector :: Vector3D }- deriving (Read,Show)--instance AffineTransformable Ray3D where- transform m (Ray3D p v) = Ray3D (transform m p) (transform m v)--projectRay :: RSdouble -> Ray3D -> Point3D-projectRay t (Ray3D (Point3D x y z) (Vector3D u v w)) = Point3D (x+u*t) (y+v*t) (z+w*t)--distanceAlong :: Ray3D -> Point3D -> RSdouble-distanceAlong (Ray3D p v) p' = dotProduct (vectorToFrom p' p) v / vectorLengthSquared v--angleFrom :: Ray3D -> Point3D -> Angle-angleFrom (Ray3D p v) p' = angleBetween (vectorToFrom p' p) v--normalizeRay :: Ray3D -> Ray3D-normalizeRay (Ray3D p v) = Ray3D p $ vectorNormalize v-\end{code}-
− RSAGL/Math/Vector.lhs
@@ -1,298 +0,0 @@-\section{Points and Vectors: RSAGL.Vector}--\begin{code}-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, FunctionalDependencies, PatternGuards #-}-module RSAGL.Math.Vector- (Point3D(..),- origin_point_3d,- Vector3D(..),- SurfaceVertex3D(..),- zero_vector,- point3d,- points3d,- point2d,- points2d,- vector3d,- dotProduct,- angleBetween,- crossProduct,- distanceBetween,- distanceBetweenSquared,- aNonZeroVector,- aLargeVector,- vectorAdd,- vectorSum,- vectorScale,- vectorScaleTo,- vectorToFrom,- vectorNormalize,- vectorAverage,- vectorLength,- vectorLengthSquared,- newell,- Xyz(..),- XYZ,- vectorString,- randomXYZ,- fixOrtho,- fixOrtho2,- fixOrtho2Left,- orthos)- where--import Control.Parallel.Strategies-import RSAGL.Math.Angle-import RSAGL.Auxiliary.Auxiliary-import System.Random-import RSAGL.Math.AbstractVector-import RSAGL.Types-\end{code}--\subsection{Generic 3-dimensional types and operations}--\begin{code}-type XYZ = (RSdouble,RSdouble,RSdouble)--class Xyz a where- toXYZ :: a -> XYZ- fromXYZ :: XYZ -> a--instance Xyz (RSdouble,RSdouble,RSdouble) where- toXYZ = id- fromXYZ = id--vectorString :: Xyz a => a -> String-vectorString xyz = let (x,y,z) = toXYZ xyz- in (show x) ++ "," ++ (show y) ++ "," ++ (show z)--uncurry3d :: (RSdouble -> RSdouble -> RSdouble -> a) -> XYZ -> a-uncurry3d fn (x,y,z) = fn x y z-\end{code}--\subsection{Points in 3-space}--\begin{code}-data Point3D = Point3D {-# UNPACK #-} !RSdouble {-# UNPACK #-} !RSdouble {-# UNPACK #-} !RSdouble- deriving (Read,Show,Eq)--origin_point_3d :: Point3D-origin_point_3d = Point3D 0 0 0--point3d :: (RSdouble,RSdouble,RSdouble) -> Point3D-point3d = uncurry3d Point3D--point2d :: (RSdouble,RSdouble) -> Point3D-point2d (x,y) = point3d (x,y,0)--points3d :: [(RSdouble,RSdouble,RSdouble)] -> [Point3D]-points3d = map point3d--points2d :: [(RSdouble,RSdouble)] -> [Point3D]-points2d = map point2d--instance Xyz Point3D where- toXYZ (Point3D x y z) = (x,y,z)- fromXYZ (x,y,z) = Point3D x y z--instance AbstractZero Point3D where- zero = origin_point_3d--instance AbstractAdd Point3D Vector3D where- add = displace--instance AbstractSubtract Point3D Vector3D where- sub = vectorToFrom--instance NFData Point3D-\end{code}--\subsection{Vectors in 3-space}--\begin{code}-data Vector3D = Vector3D {-# UNPACK #-} !RSdouble {-# UNPACK #-} !RSdouble {-# UNPACK #-} !RSdouble- deriving (Read,Show,Eq)--zero_vector :: Vector3D-zero_vector = Vector3D 0 0 0--vector3d :: (RSdouble,RSdouble,RSdouble) -> Vector3D-vector3d = uncurry3d Vector3D--instance Xyz Vector3D where- toXYZ (Vector3D x y z) = (x,y,z)- fromXYZ (x,y,z) = Vector3D x y z--instance NFData Vector3D--instance AbstractZero Vector3D where- zero = zero_vector--instance AbstractAdd Vector3D Vector3D where- add = vectorAdd--instance AbstractSubtract Vector3D Vector3D where- sub = vectorToFrom--instance AbstractScale Vector3D where- scalarMultiply = vectorScale--instance AbstractMagnitude Vector3D where- magnitude = vectorLength--instance AbstractVector Vector3D-\end{code}--A \texttt{SurfaceVertex3D} is a a point on an orientable surface, having a position and a normal vector.--\subsection{Surface Vertices in 3-space}--\begin{code}-data SurfaceVertex3D = SurfaceVertex3D { sv3d_position :: Point3D, - sv3d_normal :: Vector3D }- deriving (Read,Show)--instance NFData SurfaceVertex3D where- rnf (SurfaceVertex3D p v) = rnf (p,v)-\end{code}--\subsection{Vector Arithmetic}--\begin{code}-aNonZeroVector :: Vector3D -> Maybe Vector3D-aNonZeroVector v = case vectorLength v of- x | x <= 0 -> Nothing- x | isDenormalized x -> Nothing- x | isNaN x -> Nothing- x | isInfinite x -> Nothing- _ | otherwise -> Just v--aLargeVector :: RSdouble -> Vector3D -> Maybe Vector3D-aLargeVector x v_ =- case aNonZeroVector v_ of- Just v | vectorLength v > x -> Just v- _ | otherwise -> Nothing--dotProduct :: Vector3D -> Vector3D -> RSdouble-dotProduct (Vector3D ax ay az) (Vector3D bx by bz) = - (ax*bx) + (ay*by) + (az*bz)--angleBetween :: Vector3D -> Vector3D -> Angle-angleBetween a b = arcCosine $ dotProduct (vectorNormalize a) (vectorNormalize b)--crossProduct :: Vector3D -> Vector3D -> Vector3D-crossProduct (Vector3D ax ay az) (Vector3D bx by bz) = - Vector3D (ay*bz - az*by) (az*bx - ax*bz) (ax*by - ay*bx)--distanceBetween :: (Xyz xyz) => xyz -> xyz -> RSdouble-distanceBetween a b = vectorLength $ vectorToFrom a b--distanceBetweenSquared :: (Xyz xyz) => xyz -> xyz -> RSdouble-distanceBetweenSquared a b = vectorLengthSquared $ vectorToFrom a b--displace :: (Xyz xyz) => xyz -> Vector3D -> xyz-displace xyz (Vector3D x2 y2 z2) =- let (x1,y1,z1) = toXYZ xyz- in fromXYZ (x1+x2,y1+y2,z1+z2)--vectorAdd :: Vector3D -> Vector3D -> Vector3D-vectorAdd = displace--vectorSum :: [Vector3D] -> Vector3D-vectorSum vectors = foldr vectorAdd zero_vector vectors--vectorToFrom :: (Xyz xyz) => xyz -> xyz -> Vector3D-vectorToFrom a b = - let (ax,ay,az) = toXYZ a- (bx,by,bz) = toXYZ b- in Vector3D (ax - bx) (ay - by) (az - bz)--vectorLength :: Vector3D -> RSdouble-vectorLength = sqrt . vectorLengthSquared--vectorLengthSquared :: Vector3D -> RSdouble-vectorLengthSquared (Vector3D x y z) = (x*x + y*y + z*z)--vectorScale :: RSdouble -> Vector3D -> Vector3D-vectorScale s (Vector3D x y z) = Vector3D (x*s) (y*s) (z*s)-\end{code}--vectorScaleTo forces the length of a vector to a certain value, without changing the vector's direction.--\begin{code}-vectorScaleTo :: RSdouble -> Vector3D -> Vector3D-vectorScaleTo new_length vector = vectorScale new_length $ vectorNormalize vector-\end{code}--vectorNormalize forces the length of a vector to 1, without changing the vector's direction.--\begin{code}-vectorNormalize :: Vector3D -> Vector3D-vectorNormalize v = - let l = vectorLength v- in maybe (Vector3D 0 0 0) (vectorScale (1/l)) $ aNonZeroVector v-\end{code}--vectorAverage takes the average of a list of vectors. The result is a normalized vector-where the length of the element vectors is not reflected in the result.--\begin{code}-vectorAverage :: [Vector3D] -> Vector3D-vectorAverage vects = vectorNormalize $ vectorSum $ map vectorNormalize vects-\end{code}--\subsection{Generating normal vectors}--\texttt{newell} calculates the normal vector of an arbitrary polygon. If the points specified are non-coplanar,-\texttt{newell} often calculates a reasonable result; if they are colinear or singular \texttt{newell} will fail.--The result is a normalized vector.--\begin{code}-newell :: [Point3D] -> Maybe Vector3D-newell points = fmap vectorNormalize $ aNonZeroVector $ vectorSum $ map newell_ $ loopedRSdoubles points- where newell_ (Point3D x0 y0 z0,Point3D x1 y1 z1) =- (Vector3D - ((y0 - y1)*(z0 + z1))- ((z0 - z1)*(x0 + x1))- ((x0 - x1)*(y0 + y1)))-\end{code}--\subsection{Randomly Generated Coordinates}--\texttt{randomXYZ} can generate random coordinates within the cube where x, y, and z are each in the range (lo,hi).--\begin{code}-randomXYZ :: (RandomGen g,Xyz p) => (RSdouble,RSdouble) -> g -> (p,g)-randomXYZ (lo,hi) g = (fromXYZ (f2f x,f2f y,f2f z),g')- where (g_,g') = split g- (x:y:z:_) = randomRs (f2f lo,f2f hi) g_ :: [Double]-\end{code}--\subsection{Orthagonal Vectors}--\texttt{fixOrtho a v} finds the vector, orthagonal to a, that has the least angle to v.--\texttt{fixOrtho2 right up} yields \texttt{(up,forward)}.--\texttt{fixOrtho2Left right up} yields \texttt{(up,backward)}.--\texttt{orthos} finds two arbitrary vectors orthagonal to the parameter.--\begin{code}-fixOrtho :: Vector3D -> Vector3D -> Vector3D-fixOrtho a = fst . fixOrtho2 a--fixOrtho2 :: Vector3D -> Vector3D -> (Vector3D,Vector3D)-fixOrtho2 a v = (vectorNormalize $ crossProduct a $ vectorScale (-1) b,vectorNormalize b)- where b = crossProduct a v--fixOrtho2Left :: Vector3D -> Vector3D -> (Vector3D,Vector3D)-fixOrtho2Left a v = (vectorNormalize $ crossProduct a b,vectorNormalize b)- where b = vectorScale (-1) $ crossProduct a v--orthos :: Vector3D -> (Vector3D,Vector3D)-orthos v@(Vector3D x y z) | abs y >= abs x && abs z >= abs x = fixOrtho2 v (Vector3D (abs x + abs y + abs z) y z)-orthos v@(Vector3D x y z) | abs x >= abs y && abs z >= abs y = fixOrtho2 v (Vector3D x (abs x + abs y + abs z) z)-orthos v@(Vector3D x y z) | abs x >= abs z && abs y >= abs z = fixOrtho2 v (Vector3D x y (abs x + abs y + abs z))-orthos _ = error "orthos: NaN"-\end{code}
− RSAGL/Math/WrappedAffine.hs
@@ -1,24 +0,0 @@-module RSAGL.Math.WrappedAffine- (WrappedAffine(..),- wrapAffine,- unwrapAffine)- where--import RSAGL.Math.Affine-import RSAGL.Scene.CoordinateSystems---- | WrappedAffine stores up affine transformations that are commited only when the entity is unwrapped. In this way we can store affine transformations --- for entities that can not be directly transformed, or for which delaying transformation an optimization.-data WrappedAffine a = WrappedAffine CoordinateSystem a--wrapAffine :: a -> WrappedAffine a-wrapAffine = WrappedAffine root_coordinate_system--unwrapAffine :: (AffineTransformable a) => WrappedAffine a -> a-unwrapAffine (WrappedAffine cs a) = migrateToFrom root_coordinate_system cs a--instance AffineTransformable (WrappedAffine a) where- transform t (WrappedAffine cs a) = WrappedAffine (transform t cs) a--instance Functor WrappedAffine where- fmap f (WrappedAffine m a) = WrappedAffine m $ f a
RSAGL/Modeling.hs view
@@ -1,12 +1,10 @@ module RSAGL.Modeling- (module RSAGL.Modeling.BoundingBox,- module RSAGL.Modeling.Deformation,+ (module RSAGL.Modeling.Deformation, module RSAGL.Modeling.Extrusion, module RSAGL.Modeling.ModelingExtras, module RSAGL.Modeling.Model) where -import RSAGL.Modeling.BoundingBox import RSAGL.Modeling.Deformation import RSAGL.Modeling.Extrusion import RSAGL.Modeling.ModelingExtras
− RSAGL/Modeling/BoundingBox.lhs
@@ -1,78 +0,0 @@-\section{Bounding Boxes}--Implements simple bounding boxes and spheres.--\begin{code}-module RSAGL.Modeling.BoundingBox- (BoundingBox,- Bound3D(..),- boundingCenterRadius,- minimalDistanceToBoundingBox)- where--import RSAGL.Math.Vector-import RSAGL.Math.Interpolation-import RSAGL.Math.Affine-import RSAGL.Types--data BoundingBox = BoundingBox {- bbox_bottom, bbox_top, bbox_left, bbox_right, bbox_far, bbox_near :: !RSdouble }- deriving (Show)--class Bound3D a where- boundingBox :: a -> BoundingBox--instance Bound3D Point3D where- boundingBox (Point3D x y z) = BoundingBox { - bbox_bottom = y,- bbox_top = y,- bbox_right = x,- bbox_left = x,- bbox_near = z,- bbox_far = z }--instance Bound3D SurfaceVertex3D where- boundingBox = boundingBox . sv3d_position--instance (Bound3D a) => Bound3D [a] where- boundingBox [] = error "instance Bound3D [a], boundingBox: can't construct boundingBox []"- boundingBox (x:xs) = foldr combineBoundingBoxes (boundingBox x) $ xs--instance Bound3D BoundingBox where- boundingBox = id--instance AffineTransformable BoundingBox where- transform m = boundingBox . transform m . boundingBoxToPointCloud--combineBoundingBoxes :: (Bound3D a,Bound3D b) => a -> b -> BoundingBox-combineBoundingBoxes x y =- BoundingBox {- bbox_left = min (bbox_left b1) (bbox_left b2),- bbox_right = max (bbox_right b1) (bbox_right b2),- bbox_bottom = min (bbox_bottom b1) (bbox_bottom b2),- bbox_top = max (bbox_top b1) (bbox_top b2),- bbox_near = min (bbox_near b1) (bbox_near b2),- bbox_far = max (bbox_far b1) (bbox_far b2) }- where b1 = boundingBox x- b2 = boundingBox y--boundingBoxToPointCloud :: BoundingBox -> [Point3D]-boundingBoxToPointCloud bbox =- [Point3D (bbox_left bbox) (bbox_bottom bbox) (bbox_near bbox),- Point3D (bbox_right bbox) (bbox_bottom bbox) (bbox_near bbox),- Point3D (bbox_left bbox) (bbox_top bbox) (bbox_near bbox),- Point3D (bbox_right bbox) (bbox_top bbox) (bbox_near bbox),- Point3D (bbox_left bbox) (bbox_bottom bbox) (bbox_far bbox),- Point3D (bbox_right bbox) (bbox_bottom bbox) (bbox_far bbox),- Point3D (bbox_left bbox) (bbox_top bbox) (bbox_far bbox),- Point3D (bbox_right bbox) (bbox_top bbox) (bbox_far bbox)]--boundingCenterRadius :: BoundingBox -> (Point3D,RSdouble)-boundingCenterRadius bbox = (lerp 0.5 (nlb,frt),distanceBetween nlb frt / 2)- where nlb = Point3D (bbox_near bbox) (bbox_left bbox) (bbox_bottom bbox)- frt = Point3D (bbox_far bbox) (bbox_right bbox) (bbox_top bbox)--minimalDistanceToBoundingBox :: Point3D -> BoundingBox -> RSdouble-minimalDistanceToBoundingBox p bbox = distanceBetween p c - r- where (c,r) = boundingCenterRadius bbox-\end{code}
− RSAGL/Modeling/Color.lhs
@@ -1,197 +0,0 @@-\section{Color}--\begin{code}-{-# LANGUAGE MultiParamTypeClasses #-}-module RSAGL.Modeling.Color- (RGB(..),- RGBA(..),- rgba,- rgba256,- gray,- gray256,- brightness,- meanBrightness,- zipRGB3,- maxRGB,- minRGB,- maximizeRGB,- ColorClass(..),- addRGB,- mapRGB,- invertRGB,- filterRGB,- filterRGBLinear,- scaleRGB,- rgbToOpenGL,- rgbaToOpenGL)- where--import Control.Parallel.Strategies-import Graphics.Rendering.OpenGL.GL hiding (RGB,RGBA)-import RSAGL.Math.AbstractVector-import RSAGL.Math.Interpolation-import RSAGL.Types-\end{code}--\texttt{addColor} paints a color on top of another color using the additive color system. For example, \texttt{red `addColor` green == yellow}.--\texttt{filterColor} paints a color on top of another color using the subtractive color system (actually, multiplicative). For example, \texttt{yellow `filterColor` green == green}, but \texttt{red `filterColor` green == black}.--\texttt{rgb256} works for colors specified in hexadecimal. For example, X11 ForestGreen is \texttt{rgb256 0x22 0x8B 0x22}.--\begin{code}-data RGB = RGB { rgb_red, rgb_green, rgb_blue :: !RSdouble }- deriving (Eq,Show)--data RGBA = RGBA { rgba_a :: !RSdouble, rgba_rgb :: !RGB }- deriving (Eq,Show)--instance NFData RGB where--instance NFData RGBA where--class (AbstractVector c) => ColorClass c where- rgb :: RSdouble -> RSdouble -> RSdouble -> c- rgb256 :: (Integral i) => i -> i -> i -> c- alpha :: RSdouble -> c -> RGBA- alpha256 :: (Integral i) => i -> c -> RGBA- clampColor :: c -> c- zipRGB :: (RSdouble -> RSdouble -> RSdouble) -> RGB -> c -> c- zipColor :: (RSdouble -> RSdouble -> RSdouble) -> c -> c -> c- toPremultipliedRGB :: c -> RGB- colorToOpenGL :: c -> Color4 GLdouble- toRGBA :: c -> RGBA- fromRGB :: RGB -> c--instance ColorClass RGB where- rgb = RGB- rgb256 r g b = rgb (i2f256 r) (i2f256 g) (i2f256 b)- alpha = RGBA- alpha256 a = alpha (i2f256 a)- clampColor = mapRGB (min 1 . max 0)- zipRGB = zipColor- zipColor f (RGB r1 g1 b1) (RGB r2 g2 b2) = RGB (f r1 r2) (f g1 g2) (f b1 b2)- toPremultipliedRGB = id- colorToOpenGL = rgbToOpenGL- toRGBA = RGBA 1- fromRGB = id--instance ColorClass RGBA where- rgb = rgba 1.0- rgb256 = rgba256 255- alpha x (RGBA a rgb_color) = RGBA (x*a) rgb_color- alpha256 i (RGBA a rgb_color) = RGBA ((i2f256 i)*a) rgb_color- clampColor (RGBA a rgb_color) = RGBA (min 1 $ max 0 a) $ clampColor rgb_color- zipRGB f x (RGBA a y) = RGBA a $ zipRGB f x y- zipColor f (RGBA a1 c1) (RGBA a2 c2) = RGBA (f a1 a2) (zipColor f c1 c2)- toPremultipliedRGB (RGBA a rgb_color) = scaleRGB a rgb_color- colorToOpenGL = rgbaToOpenGL- toRGBA = id- fromRGB = alpha 1.0--i2f256 :: (Integral i) => i -> RSdouble-i2f256 = (/ 255) . fromIntegral--rgba :: RSdouble -> RSdouble -> RSdouble -> RSdouble -> RGBA-rgba r g b a = alpha a $ (rgb r g b :: RGB)--rgba256 :: (Integral i) => i -> i -> i -> i -> RGBA-rgba256 r g b a = alpha256 a $ (rgb256 r g b :: RGB)--gray :: RSdouble -> RGB-gray x = rgb x x x--gray256 :: (Integral i) => i -> RGB-gray256 x = rgb256 x x x--brightness :: (ColorClass c) => c -> RSdouble-brightness c = 0.2126 * r + 0.7152 * g + 0.0722 * b- where RGB r g b = toPremultipliedRGB c--meanBrightness :: (ColorClass c) => c -> RSdouble-meanBrightness c = (r + g + b) / 3- where RGB r g b = toPremultipliedRGB c--zipRGB3 :: (RSdouble -> RSdouble -> RSdouble -> RSdouble) -> RGB -> RGB -> RGB -> RGB-zipRGB3 f (RGB ar ag ab) (RGB br bg bb) (RGB cr cg cb) = RGB (f ar br cr) (f ag bg cg) (f ab bb cb)--maxRGB :: RGB -> RSdouble-maxRGB (RGB r g b) = max r (max g b)--minRGB :: RGB -> RSdouble-minRGB (RGB r g b) = min r (min g b)--maximizeRGB :: RGB -> RGB-maximizeRGB (RGB r g b) | r <= 0 && g <= 0 && b <= 0 = gray 0-maximizeRGB c = mapRGB (/ maxRGB c) c--addRGB :: RGB -> RGB -> RGB-addRGB = addColor--addColor :: (ColorClass c) => c -> c -> c-addColor = zipColor (+)--subColor :: (ColorClass c) => c -> c -> c-subColor = zipColor (-)--{-# INLINE mapRGB #-}-mapRGB :: (RSdouble -> RSdouble) -> RGB -> RGB-mapRGB f (RGB r g b) = RGB (f r) (f g) (f b)--{-# INLINE filterRGB #-}-filterRGB :: RGB -> RGB -> RGB-filterRGB = zipRGB (*)--{-# INLINE scaleRGB #-}-scaleRGB :: RSdouble -> RGB -> RGB-scaleRGB x = mapRGB (*x)--invertRGB :: RGB -> RGB-invertRGB = mapRGB (1-)-\end{code}--\texttt{filterRGBLinear} maps an RGB color between a black point and a white point. The black point will map to RGB 0 0 0, while-the white point will map to RGB 1 1 1.--\begin{code}-filterRGBLinear :: RGB -> RGB -> RGB -> RGB-filterRGBLinear black_point white_point = zipRGB3 (\b w c -> lerpBetweenClamped (b,c,w) (0,1)) black_point white_point--scaleRGBA :: RSdouble -> RGBA -> RGBA-scaleRGBA x c = c { rgba_a = x * rgba_a c,- rgba_rgb = scaleRGB x (rgba_rgb c) }--rgbToOpenGL :: RGB -> Color4 GLdouble-rgbToOpenGL (RGB r g b) = Color4 (toGLdouble r) (toGLdouble g) (toGLdouble b) 1--rgbaToOpenGL :: RGBA -> Color4 GLdouble-rgbaToOpenGL (RGBA a (RGB r g b)) = Color4 (toGLdouble r) (toGLdouble g) (toGLdouble b) (toGLdouble a)--instance AbstractZero RGB where- zero = rgb 0 0 0--instance AbstractAdd RGB RGB where- add = addColor--instance AbstractSubtract RGB RGB where- sub = subColor--instance AbstractScale RGB where- scalarMultiply d = scaleRGB $ f2f d--instance AbstractVector RGB--instance AbstractZero RGBA where- zero = rgba 0 0 0 0--instance AbstractAdd RGBA RGBA where- add = addColor--instance AbstractSubtract RGBA RGBA where- sub = subColor--instance AbstractScale RGBA where- scalarMultiply d = scaleRGBA $ f2f d--instance AbstractVector RGBA-\end{code}
+ RSAGL/Modeling/Deformation.hs view
@@ -0,0 +1,60 @@+{-# OPTIONS_GHC -fglasgow-exts #-}++module RSAGL.Modeling.Deformation+ (Deformation,DeformationClass(..),constrain)+ where++import RSAGL.Math.Vector+import RSAGL.Math.Matrix+import RSAGL.Math.Affine+import RSAGL.Auxiliary.Auxiliary+import RSAGL.Scene.CoordinateSystems++-- | A deformation of a surface. These come in two types: a deformation that+-- modifies only the shape of a surface, leaving the normal vectors to+-- be recalculated automatically, or a deformation that modified both+-- the shape and the normal vectors explicitly.+--+-- For example, the deformation function of type @(Point3D -> Ponit3D)@+-- depends on automatic differentiation to determine the new surface normals.+--+-- On the other hand, an affine transformation applied as a deformation+-- can quickly and correctly compute the new surface normals.+--+-- Finally, one might want to construct a deformation that modifies+-- the surface normals while leaving the shape intact -- this is+-- perfectly legal.+--+type Deformation = Either (SurfaceVertex3D -> Point3D) (SurfaceVertex3D -> SurfaceVertex3D)++-- | A convenienve class to convert common descriptions of deformations+-- into the canonical representation.+class DeformationClass a where+ deformation :: a -> Deformation++instance (DeformationClass a,DeformationClass b) =>+ DeformationClass (Either a b) where+ deformation = either deformation deformation++instance DeformationClass Matrix where+ deformation m = Right (\s -> transform m s)++instance DeformationClass (Point3D -> Point3D) where+ deformation f = Left (\(SurfaceVertex3D p _) -> f p)++instance DeformationClass (Point3D -> SurfaceVertex3D) where+ deformation f = Right (\(SurfaceVertex3D p _) -> f p)++instance DeformationClass (SurfaceVertex3D -> Point3D) where+ deformation f = Left f++instance DeformationClass (SurfaceVertex3D -> SurfaceVertex3D) where+ deformation f = Right f++instance DeformationClass (Point3D -> Affine) where+ deformation f = Left (\(SurfaceVertex3D p _) ->+ affine_transformation (f p) p)++instance DeformationClass (SurfaceVertex3D -> Affine) where+ deformation f = Left (\s -> affine_transformation (f s) $ sv3d_position s)+
− RSAGL/Modeling/Deformation.lhs
@@ -1,49 +0,0 @@-\section{Non-affine Transformations}--The \texttt{Deformation} typeclass describes any affine or non-affine transformation.--\texttt{Deformation}s fall into two catagories: those that compute their own surface normals and those that don't.--\begin{code}-{-# OPTIONS_GHC -fglasgow-exts #-}--module RSAGL.Modeling.Deformation- (Deformation,DeformationClass(..),constrain)- where--import RSAGL.Math.Vector-import RSAGL.Math.Matrix-import RSAGL.Math.Affine-import RSAGL.Auxiliary.Auxiliary-import RSAGL.Scene.CoordinateSystems--type Deformation = Either (SurfaceVertex3D -> Point3D) (SurfaceVertex3D -> SurfaceVertex3D)--class DeformationClass a where- deformation :: a -> Deformation--instance (DeformationClass a,DeformationClass b) => DeformationClass (Either a b) where- deformation = either deformation deformation--instance DeformationClass Matrix where- deformation m = Right (\s -> transform m s)--instance DeformationClass (Point3D -> Point3D) where- deformation f = Left (\(SurfaceVertex3D p _) -> f p)--instance DeformationClass (Point3D -> SurfaceVertex3D) where- deformation f = Right (\(SurfaceVertex3D p _) -> f p)--instance DeformationClass (SurfaceVertex3D -> Point3D) where- deformation f = Left f--instance DeformationClass (SurfaceVertex3D -> SurfaceVertex3D) where- deformation f = Right f--instance DeformationClass (Point3D -> Affine) where- deformation f = Left (\(SurfaceVertex3D p _) -> affine_transformation (f p) p)--instance DeformationClass (SurfaceVertex3D -> Affine) where- deformation f = Left (\s -> affine_transformation (f s) $ sv3d_position s) -\end{code}-
+ RSAGL/Modeling/Extrusion.hs view
@@ -0,0 +1,56 @@+module RSAGL.Modeling.Extrusion+ (extrude,+ extrudeTube,+ extrudePrism)+ where++import RSAGL.Math.Curve+import RSAGL.Math.CurveExtras+import RSAGL.Math.Vector+import RSAGL.Math.Affine+import Control.Applicative+import RSAGL.Scene.CoordinateSystems+import RSAGL.Math.Orthogonal+import Data.Maybe+import RSAGL.Math.Types++-- | The most general form of an extrusion. Requires first a+-- control curve for orientation, for example the center of+-- a torus or a vector that simply never runs parallel+-- to the spine. Second, the spine of the extrusion,+-- and third the shape to be extruded.+--+-- The +Y axis of the shape will be oriented toward+-- the control curve.+extrude :: Curve (Either Point3D Vector3D) ->+ Curve Point3D ->+ Curve (Curve Point3D) ->+ Surface Point3D+extrude upish spine loop = wrapSurface $+ transformation <$>+ (modelLookAt <$> spine <*>+ (forward <$> Right <$> spine') <*>+ (up <$> upish)) <*>+ loop+ where spine' = curveDerivative spine++-- | A tubular extrusion using taking a radius and a spine.+extrudeTube :: Curve RSdouble -> Curve Point3D -> Surface Point3D+extrudeTube radius spine =+ extrude upish+ spine+ (scale' <$> radius <*> pure circleXY)+ where upish = pure $ Right $ fromMaybe+ (let [a,b] = iterateCurve 2 spine+ in fst $ orthos $ vectorToFrom a b) $+ newellCurve spine++-- | An extrusion whose spine is a straight line, with radii specified+-- at both ends. In this case only the extruded shape needs to be+-- specified as a curve.+extrudePrism :: Vector3D -> (Point3D,RSdouble) -> (Point3D,RSdouble) -> Curve Point3D -> Surface Point3D+extrudePrism upish (a,ra) (b,rb) c =+ extrude (pure $ Right $ upish)+ (linearInterpolation [a,b])+ (flip scale' c <$> linearInterpolation [ra,rb])+
− RSAGL/Modeling/Extrusion.lhs
@@ -1,41 +0,0 @@-\section{Extrusions}--\begin{code}-module RSAGL.Modeling.Extrusion- (extrude,- extrudeTube,- extrudePrism)- where--import RSAGL.Math.Curve-import RSAGL.Math.CurveExtras-import RSAGL.Math.Vector-import RSAGL.Math.Affine-import Control.Applicative-import RSAGL.Scene.CoordinateSystems-import RSAGL.Math.Orthagonal-import Data.Maybe-import RSAGL.Types-\end{code}--\subsection{The General Extrusion}--\texttt{extrude} takes a vector or point indicating an orientation, a curve representing the spine of the extrusion, and-a curve representing the loop in the x-y plane.--\begin{code}-extrude :: Curve (Either Point3D Vector3D) -> Curve Point3D -> Curve (Curve Point3D) -> Surface Point3D-extrude upish spine loop = wrapSurface $ transformation <$> (modelLookAt <$> spine <*> (forward <$> Right <$> spine') <*> (up <$> upish)) <*> loop- where spine' = curveDerivative spine-\end{code}--\subsection{Specific Extrusions}--\begin{code}-extrudeTube :: Curve RSdouble -> Curve Point3D -> Surface Point3D-extrudeTube radius spine = extrude upish spine (scale' <$> radius <*> pure circleXY)- where upish = pure $ Right $ fromMaybe (let [a,b] = iterateCurve 2 spine in fst $ orthos $ vectorToFrom a b) $ newellCurve spine--extrudePrism :: Vector3D -> (Point3D,RSdouble) -> (Point3D,RSdouble) -> Curve Point3D -> Surface Point3D-extrudePrism upish (a,ra) (b,rb) c = extrude (pure $ Right $ upish) (linearInterpolation [a,b]) (flip scale' c <$> linearInterpolation [ra,rb])-\end{code}
RSAGL/Modeling/Material.hs view
@@ -5,8 +5,7 @@ -- as bumpiness. Materials are handled using layers. -- module RSAGL.Modeling.Material- (module RSAGL.Modeling.Color,- MaterialLayer,MaterialSurface,Material,materialIsEmpty,+ (MaterialLayer,MaterialSurface,Material,materialIsEmpty, toLayers,materialLayerSurface,materialLayerRelevant,materialComplexity,materialLayerToOpenGLWrapper, isOpaqueLayer, diffuseLayer,RSAGL.Modeling.Material.specularLayer,transparentLayer,emissiveLayer,filteringLayer)@@ -15,12 +14,13 @@ import Data.Maybe import Data.Monoid import Control.Applicative-import RSAGL.Modeling.Color+import RSAGL.Color import RSAGL.Math.Curve import RSAGL.Auxiliary.ApplicativeWrapper import Control.Parallel.Strategies-import Graphics.Rendering.OpenGL.GL hiding (RGB,RGBA)-import RSAGL.Types+import Graphics.Rendering.OpenGL.GL hiding (RGB,RGBA,Alpha)+import RSAGL.Math.Types+import RSAGL.Math.AbstractVector -- | A 'MaterialSurface' is parameterized either on RGB or RGBA, depending -- on whether or not the 'MaterialLayer' is capable of transparency.@@ -82,10 +82,10 @@ combine2Layers (DiffuseLayer msrgb) (EmissiveLayer emissive_rgb) | isPure emissive_rgb = Just $ CompoundLayer msrgb (RGB 0 0 0) (fromJust $ fromPure $ emissive_rgb) 0 -- emissive + emissive-combine2Layers (EmissiveLayer x) (EmissiveLayer y) = Just $ EmissiveLayer $ addRGB <$> x <*> y+combine2Layers (EmissiveLayer x) (EmissiveLayer y) = Just $ EmissiveLayer $ add <$> x <*> y -- compound + pure emissive combine2Layers (CompoundLayer msrgb specular_rgb emissive_rgb1 shininess) (EmissiveLayer emissive_rgb2) | isPure emissive_rgb2 =- Just $ CompoundLayer msrgb specular_rgb (addRGB emissive_rgb1 (fromJust $ fromPure $ emissive_rgb2)) shininess+ Just $ CompoundLayer msrgb specular_rgb (add emissive_rgb1 (fromJust $ fromPure $ emissive_rgb2)) shininess -- compound + pure specular combine2Layers (CompoundLayer msrgb (RGB 0 0 0) emissive_rgb 0) (SpecularLayer specular_rgb shininess) | isPure specular_rgb = Just $ CompoundLayer msrgb (fromJust $ fromPure $ specular_rgb) emissive_rgb shininess@@ -130,7 +130,7 @@ -- | True if the 'MaterialLayer' is completely opaque. A layer under an opaque layer is not visible. isOpaqueLayer :: MaterialLayer -> Bool isOpaqueLayer (DiffuseLayer _) = True-isOpaqueLayer (TransparentLayer ms) | fmap rgba_a (fromPure ms) == Just 1.0 = True+isOpaqueLayer (TransparentLayer ms) | fmap alpha_alpha (fromPure ms) == Just 1.0 = True isOpaqueLayer (CompoundLayer _ _ _ _) = True isOpaqueLayer _ = False @@ -150,17 +150,17 @@ -- | True if the color is not perfectly transparent. Perfectly transparent materials are invisible, and can therefore -- be eleminated from a model. isTransparentRelevant :: RGBA -> Bool-isTransparentRelevant (RGBA 0 _) = False+isTransparentRelevant (Alpha x _) | x < 0.01 = False isTransparentRelevant _ = True -- | Get the color information for a 'MaterialLayer'. materialLayerSurface :: MaterialLayer -> MaterialSurface RGBA-materialLayerSurface (DiffuseLayer msrgb) = fmap toRGBA msrgb+materialLayerSurface (DiffuseLayer msrgb) = fmap transformColor msrgb materialLayerSurface (TransparentLayer msrgba) = msrgba-materialLayerSurface (EmissiveLayer msrgb) = fmap toRGBA msrgb-materialLayerSurface (SpecularLayer msrgb _) = fmap toRGBA msrgb-materialLayerSurface (CompoundLayer msrgb _ _ _) = fmap toRGBA msrgb-materialLayerSurface (FilterLayer msrgb) = fmap toRGBA msrgb+materialLayerSurface (EmissiveLayer msrgb) = fmap transformColor msrgb+materialLayerSurface (SpecularLayer msrgb _) = fmap transformColor msrgb+materialLayerSurface (CompoundLayer msrgb _ _ _) = fmap transformColor msrgb+materialLayerSurface (FilterLayer msrgb) = fmap transformColor msrgb -- | Get a relevance layer for a surface. Purely irrelevant materials can be removed without changing the -- appearance of a model. Irrelevant triangles can also be selectively culled from a model.@@ -179,7 +179,7 @@ materialEmission FrontAndBack $= Color4 0 0 0 1 materialSpecular FrontAndBack $= Color4 0 0 0 1 colorMaterial $= Just (FrontAndBack,AmbientAndDiffuse)- maybe (return ()) (color . rgbToOpenGL) $ fromPure ms+ maybe (return ()) (color . colorToOpenGL) $ fromPure ms io colorMaterial $= cm materialLayerToOpenGLWrapper (TransparentLayer ms) io = @@ -187,13 +187,13 @@ materialEmission FrontAndBack $= Color4 0 0 0 1 materialSpecular FrontAndBack $= Color4 0 0 0 1 colorMaterial $= Just (FrontAndBack,AmbientAndDiffuse)- maybe (return ()) (color . rgbaToOpenGL) $ fromPure ms+ maybe (return ()) (color . colorToOpenGL) $ fromPure ms alphaBlendWrapper io colorMaterial $= cm materialLayerToOpenGLWrapper (EmissiveLayer ms) io = do l <- get lighting lighting $= Disabled- maybe (return ()) (color . rgbToOpenGL) $ fromPure ms+ maybe (return ()) (color . colorToOpenGL) $ fromPure ms additiveBlendWrapper io lighting $= l materialLayerToOpenGLWrapper (SpecularLayer ms shininess) io = @@ -204,7 +204,7 @@ materialEmission FrontAndBack $= Color4 0 0 0 1 colorMaterial $= Just (FrontAndBack,Specular) lightModelLocalViewer $= Enabled- maybe (return ()) (color . rgbToOpenGL) $ fromPure ms+ maybe (return ()) (color . colorToOpenGL) $ fromPure ms additiveBlendWrapper io colorMaterial $= cm lightModelLocalViewer $= lmlv@@ -216,14 +216,14 @@ materialEmission FrontAndBack $= (\(RGB r g b) -> Color4 (f2f r) (f2f g) (f2f b) 1) emissive_rgb colorMaterial $= Just (FrontAndBack,AmbientAndDiffuse) lightModelLocalViewer $= Enabled- maybe (return ()) (color . rgbToOpenGL) $ fromPure ms+ maybe (return ()) (color . colorToOpenGL) $ fromPure ms io colorMaterial $= cm lightModelLocalViewer $= lmlv materialLayerToOpenGLWrapper (FilterLayer ms) io = do l <- get lighting lighting $= Disabled- maybe (return ()) (color . rgbToOpenGL) $ fromPure ms+ maybe (return ()) (color . colorToOpenGL) $ fromPure ms filterBlendWrapper io lighting $= l
RSAGL/Modeling/Model.lhs view
@@ -66,7 +66,7 @@ import RSAGL.Modeling.Optimization import RSAGL.Scene.CoordinateSystems import RSAGL.Modeling.Extrusion-import RSAGL.Modeling.BoundingBox+import RSAGL.Math.BoundingBox import Data.List as List import Data.Maybe import qualified Control.Monad.State as State@@ -77,7 +77,8 @@ import RSAGL.Modeling.BakedModel hiding (tesselatedElementToOpenGL) import Data.IORef import Control.Monad-import RSAGL.Types+import RSAGL.Math.Types+import RSAGL.Color \end{code} \subsection{Modeling Monad}@@ -439,7 +440,7 @@ instance OpenGLPrimitive SingleMaterialSurfaceVertex3D where getVertex (SingleMaterialSurfaceVertex3D (SurfaceVertex3D (Point3D x y z) _) _) = Vertex3 (f2f x) (f2f y) (f2f z) getNormal (SingleMaterialSurfaceVertex3D (SurfaceVertex3D _ (Vector3D x y z)) _) = Normal3 (f2f x) (f2f y) (f2f z)- getColor (SingleMaterialSurfaceVertex3D _ (MaterialVertex3D c _)) = rgbaToOpenGL c+ getColor (SingleMaterialSurfaceVertex3D _ (MaterialVertex3D c _)) = colorToOpenGL c class ModelType m where toIntermediateModel :: m -> IntermediateModel
RSAGL/Modeling/ModelingExtras.lhs view
@@ -26,15 +26,14 @@ ColorFunction, Pattern, dropRandomElements,- module RSAGL.Modeling.RSAGLColors, module RSAGL.Modeling.Material, module RSAGL.Auxiliary.ApplicativeWrapper, module Control.Applicative) where -import Graphics.Rendering.OpenGL.GL hiding (translate,rotate,scale,specular) import RSAGL.Modeling.Noise-import RSAGL.Modeling.RSAGLColors+import RSAGL.Color+import RSAGL.Color.RSAGLColors import Control.Applicative import RSAGL.Auxiliary.ApplicativeWrapper import RSAGL.Math.Vector@@ -47,7 +46,8 @@ import RSAGL.Auxiliary.Auxiliary import RSAGL.Math.Angle import RSAGL.Math.Ray-import RSAGL.Types+import RSAGL.Math.AbstractVector+import RSAGL.Math.Types \end{code} \subsection{Colors}@@ -115,7 +115,7 @@ type Pattern = SurfaceVertex3D -> RSdouble -pattern :: (ColorClass a) => Pattern -> [(GLfloat,ColorFunction a)] -> ColorFunction a+pattern :: (AbstractVector a) => Pattern -> [(RSfloat,ColorFunction a)] -> ColorFunction a pattern _ [(_,constant_pattern)] = constant_pattern pattern f color_map = wrapApplicative (\sv3d -> toApplicative (lerpMap color_map $ f2f $ f sv3d) $ sv3d) @@ -146,17 +146,19 @@ \begin{code} glass :: RGBFunction -> MaterialM attr ()-glass rgbf = - do transparent $ (alpha 0.05) <$> rgbf- specular 100 $ (\rgb_color -> curry (lerp (brightness rgb_color)) rgb_color white) <$> rgbf+glass rgbf =+ do transparent $ (alpha 0.05 . transformColor) <$> rgbf+ specular 100 $ (\rgb_color ->+ curry (lerp $ linear_value $ viewChannel channel_luminance rgb_color)+ rgb_color white) <$> rgbf plastic :: RGBFunction -> MaterialM attr ()-plastic rgbf = +plastic rgbf = do pigment rgbf specular 50 (pure white) metallic :: RGBFunction -> MaterialM attr ()-metallic rgbf = +metallic rgbf = do pigment rgbf specular 75 rgbf \end{code}
+ RSAGL/Modeling/Noise.hs view
@@ -0,0 +1,83 @@+module RSAGL.Modeling.Noise+ (perlinTurbulence,perlinNoise)+ where++import RSAGL.Math.Interpolation+import RSAGL.Math.Vector+import Data.Array.Unboxed+import Data.Fixed+import RSAGL.Math.Types++-- | Turbulence function. Accepts an amplitude, which determines+-- how intense turbulence will be. 'perlinTurbulence 0 == id'+perlinTurbulence :: RSdouble ->+ Point3D ->+ Point3D+perlinTurbulence s (Point3D x y z) = Point3D (x + s*perlinNoise x') (y + s*perlinNoise y') (z + s*perlinNoise z')+ where x' = Point3D (x+100) y z+ y' = Point3D x (y+100) z+ z' = Point3D x y (z+100)++--+-- Intellectual property note:+--+-- This is based on Perlin's improved noise reference implementation.+-- I'm assuming from the manner in which it is published and the usage+-- of the term "reference implementation" that it was intended to be+-- the basis of derivative code such as this.+--++-- |+-- Generates an arbitrary, smoothly varying value+-- between @-1@ and @1@.+perlinNoise :: Point3D -> RSdouble+perlinNoise (Point3D x0 y0 z0) =+ let (x,x') = divMod' x0 1 :: (Int,RSdouble)+ (y,y') = divMod' y0 1 :: (Int,RSdouble)+ (z,z') = divMod' z0 1 :: (Int,RSdouble)+ (u,v,w) = (fade x',fade y',fade z')+ a = pRandom x + y+ aa = pRandom a + z+ ab = pRandom (a+1) + z+ b = pRandom (x+1) + y+ ba = pRandom b + z+ bb = pRandom (b+1) + z+ f n = let nn = n in nn / (1 + abs nn) -- this function forces the result into the range -1..1+ in f $ lerp w+ (lerp v (lerp u (grad (pRandom aa) x' y' z', grad (pRandom ba) (x'-1) y' z'),+ lerp u (grad (pRandom ab) x' (y'-1) z', grad (pRandom bb) (x'-1) (y'-1) z')),+ lerp v (lerp u (grad (pRandom $ aa + 1) x' y' (z'-1), grad (pRandom $ ba + 1) (x'-1) y' (z'-1)),+ lerp u (grad (pRandom $ ab + 1) x' (y'-1) (z'-1), grad (pRandom $ bb + 1) (x'-1) (y'-1) (z'-1))))+++pRandom :: Int -> Int+pRandom n = ps ! (n `mod` 256)++ps :: UArray Int Int+ps = listArray (0,255) [226,110,184,248,226,248,61,22,185,81,167,22,54,100,244,77,84,86,184,134,88,117,66,3,53,77,172,108,151,115,131,61,142,31,0,135,12,245,73,119,186,+ 203,6,7,39,253,184,133,99,118,230,220,143,113,44,59,249,81,241,125,115,136,58,254,8,193,84,221,83,188,122,76,88,121,246,82,20,142,121,167,27,181,145,73,13,1521,165,100,+ 150,197,87,45,171,151,138,40,14,230,81,162,84,10,138,20,43,70,78,18,77,43,108,177,108,102,135,220,136,11,77,234,62,32,156,190,56,44,168,177,105,143,236,255,181,203,67,+ 137,31,28,199,214,47,177,61,81,205,25,138,215,6,251,53,125,102,177,30,28,210,50,255,18,71,230,215,158,58,137,3,130,105,183,226,0,159,71,75,132,254,211,158,186,196,33,+ 20,72,55,74,241,165,118,67,56,118,70,82,22,159,177,126,242,102,97,213,63,22,69,68,248,247,46,148,202,228,200,242,4,29,251,71,46,222,57,33,179,226,147,203,166,38,29,96,+ 224,246,11,32,94,205,108,128,63,138,252,166,62,24,215,109,165,135,53,166,5,139,185,25,68]++fade :: RSdouble -> RSdouble+fade t = t ^ 3 * (t * (t * 6 - 15) + 10)++grad :: Int -> RSdouble -> RSdouble -> RSdouble -> RSdouble+grad hash x y z = + case hash `mod` 12 of+ 0 -> x + y+ 1 -> (-x) + y+ 2 -> x + (-y)+ 3 -> (-x) + (-y)+ 4 -> z + y+ 5 -> (-z) + y+ 6 -> z + (-y)+ 7 -> (-z) + (-y)+ 8 -> z + x+ 9 -> (-z) + x+ 10 -> z + (-x)+ 11 -> (-z) + (-x)+ _ -> error "grad: impossible case"+
− RSAGL/Modeling/Noise.lhs
@@ -1,83 +0,0 @@-\section{Generating Noise: RSAGL.Noise}-\ref{RSAGLNoise}--\begin{code}-module RSAGL.Modeling.Noise- (perlinTurbulence,perlinNoise)- where--import RSAGL.Math.Interpolation-import RSAGL.Math.Vector-import Data.Array.Unboxed-import Data.Fixed-import RSAGL.Types--perlinTurbulence :: RSdouble -> Point3D -> Point3D-perlinTurbulence s (Point3D x y z) = Point3D (x + s*perlinNoise x') (y + s*perlinNoise y') (z + s*perlinNoise z')- where x' = Point3D (x+100) y z- y' = Point3D x (y+100) z- z' = Point3D x y (z+100)---- |--- Intellectual property note:------ This is based on Perlin's improved noise reference implementation.--- I'm assuming from the manner in which it is published and the usage--- of the term "reference implementation" that it was intended to be--- the basis of derivative code such as this.----perlinNoise :: Point3D -> RSdouble-perlinNoise (Point3D x0 y0 z0) =- let (x,x') = divMod' x0 1 :: (Int,RSdouble)- (y,y') = divMod' y0 1 :: (Int,RSdouble)- (z,z') = divMod' z0 1 :: (Int,RSdouble)- (u,v,w) = (fade x',fade y',fade z')- a = pRandom x + y- aa = pRandom a + z- ab = pRandom (a+1) + z- b = pRandom (x+1) + y- ba = pRandom b + z- bb = pRandom (b+1) + z- f n = let nn = n in nn / (1 + abs nn) -- this function forces the result into the range -1..1- in f $ lerp w- (lerp v (lerp u (grad (pRandom aa) x' y' z', grad (pRandom ba) (x'-1) y' z'),- lerp u (grad (pRandom ab) x' (y'-1) z', grad (pRandom bb) (x'-1) (y'-1) z')),- lerp v (lerp u (grad (pRandom $ aa + 1) x' y' (z'-1), grad (pRandom $ ba + 1) (x'-1) y' (z'-1)),- lerp u (grad (pRandom $ ab + 1) x' (y'-1) (z'-1), grad (pRandom $ bb + 1) (x'-1) (y'-1) (z'-1))))---pRandom :: Int -> Int-pRandom n = ps ! (n `mod` 256)--ps :: UArray Int Int-ps = listArray (0,255) [226,110,184,248,226,248,61,22,185,81,167,22,54,100,244,77,84,86,184,134,88,117,66,3,53,77,172,108,151,115,131,61,142,31,0,135,12,245,73,119,186,- 203,6,7,39,253,184,133,99,118,230,220,143,113,44,59,249,81,241,125,115,136,58,254,8,193,84,221,83,188,122,76,88,121,246,82,20,142,121,167,27,181,145,73,13,1521,165,100,- 150,197,87,45,171,151,138,40,14,230,81,162,84,10,138,20,43,70,78,18,77,43,108,177,108,102,135,220,136,11,77,234,62,32,156,190,56,44,168,177,105,143,236,255,181,203,67,- 137,31,28,199,214,47,177,61,81,205,25,138,215,6,251,53,125,102,177,30,28,210,50,255,18,71,230,215,158,58,137,3,130,105,183,226,0,159,71,75,132,254,211,158,186,196,33,- 20,72,55,74,241,165,118,67,56,118,70,82,22,159,177,126,242,102,97,213,63,22,69,68,248,247,46,148,202,228,200,242,4,29,251,71,46,222,57,33,179,226,147,203,166,38,29,96,- 224,246,11,32,94,205,108,128,63,138,252,166,62,24,215,109,165,135,53,166,5,139,185,25,68]--fade :: RSdouble -> RSdouble-fade t = t ^ 3 * (t * (t * 6 - 15) + 10)--grad :: Int -> RSdouble -> RSdouble -> RSdouble -> RSdouble-grad hash x y z = - case hash `mod` 12 of- 0 -> x + y- 1 -> (-x) + y- 2 -> x + (-y)- 3 -> (-x) + (-y)- 4 -> z + y- 5 -> (-z) + y- 6 -> z + (-y)- 7 -> (-z) + (-y)- 8 -> z + x- 9 -> (-z) + x- 10 -> z + (-x)- 11 -> (-z) + (-x)- _ -> error "grad: impossible case"------- End of the Perlin noise functions derived from the reference implementation.----\end{code}
RSAGL/Modeling/Optimization.lhs view
@@ -11,7 +11,7 @@ import RSAGL.Math.Curve import Data.List as List import RSAGL.Modeling.Tesselation-import RSAGL.Types+import RSAGL.Math.Types \end{code} \subsection{Surface Configurations}
− RSAGL/Modeling/RSAGLColors.hs
@@ -1,229 +0,0 @@-module RSAGL.Modeling.RSAGLColors (amber,amethyst,azure,beige,black,blackbody,blue,brass,bronze,brown,burgundy,burnt_sienna,camouflage_green,cardinal,carnation,carrot,chartreuse,chartreuse_yellow,cobalt,copper,coral,corn,crimson,cyan,dark_brown,emerald,eggplant,fern_green,firebrick,forest_green,fuchsia,gold,goldenrod,green,indigo,jade,lavender,lemon,lilac,magenta,maroon,mauve,midnight_blue,mint_green,mustard,ochre,olive,orange,orchid,pale_brown,pink,puce,purple,red,royal_blue,royal_purple,rust,safety_orange,saffron,sapphire,salmon,sea_green,sepia,shamrock,silver,slate_gray,tan_color,teal,ultramarine,vermillion,violet,viridian,wheat,white,yellow) where--import RSAGL.Modeling.Material--amber :: RGB-amber = rgb256 255 191 1--amethyst :: RGB-amethyst = rgb256 153 102 204--azure :: RGB-azure = rgb256 1 127 255--beige :: RGB-beige = rgb256 245 245 220--black :: RGB-black = rgb256 1 1 1--blackbody :: RGB-blackbody = rgb256 0 0 0--blue :: RGB-blue = rgb256 1 1 255--brass :: RGB-brass = rgb256 181 166 66--bronze :: RGB-bronze = rgb256 205 127 50--brown :: RGB-brown = rgb256 150 75 0--burgundy :: RGB-burgundy = rgb256 128 1 32--burnt_sienna :: RGB-burnt_sienna = rgb256 233 116 81--camouflage_green :: RGB-camouflage_green = rgb256 120 134 107--cardinal :: RGB-cardinal = rgb256 196 30 58--carnation :: RGB-carnation = rgb256 255 166 201--carrot :: RGB-carrot = rgb256 237 145 33--chartreuse :: RGB-chartreuse = rgb256 127 255 1--chartreuse_yellow :: RGB-chartreuse_yellow = rgb256 223 255 1--cobalt :: RGB-cobalt = rgb256 1 71 171--copper :: RGB-copper = rgb256 184 115 51--coral :: RGB-coral = rgb256 255 127 80--corn :: RGB-corn = rgb256 251 236 93--crimson :: RGB-crimson = rgb256 220 20 60--cyan :: RGB-cyan = rgb256 1 255 255--dark_brown :: RGB-dark_brown = rgb256 101 67 33--emerald :: RGB-emerald = rgb256 80 200 120--eggplant :: RGB-eggplant = rgb256 153 1 102--fern_green :: RGB-fern_green = rgb256 79 121 66--firebrick :: RGB-firebrick = rgb256 178 34 34--forest_green :: RGB-forest_green = rgb256 34 139 34--fuchsia :: RGB-fuchsia = rgb256 255 1 255--gold :: RGB-gold = rgb256 255 215 1--goldenrod :: RGB-goldenrod = rgb256 218 165 32--green :: RGB-green = rgb256 1 255 1--indigo :: RGB-indigo = rgb256 1 65 106--jade :: RGB-jade = rgb256 1 168 107--lavender :: RGB-lavender = rgb256 181 126 220--lemon :: RGB-lemon = rgb256 253 233 16--lilac :: RGB-lilac = rgb256 200 162 200--magenta :: RGB-magenta = rgb256 255 1 255--maroon :: RGB-maroon = rgb256 128 1 1--mauve :: RGB-mauve = rgb256 224 176 255--midnight_blue :: RGB-midnight_blue = rgb256 1 51 102--mint_green :: RGB-mint_green = rgb256 152 255 152--mustard :: RGB-mustard = rgb256 255 219 88--ochre :: RGB-ochre = rgb256 204 119 34--olive :: RGB-olive = rgb256 128 128 1--orange :: RGB-orange = rgb256 255 160 1--orchid :: RGB-orchid = rgb256 218 112 214--pale_brown :: RGB-pale_brown = rgb256 152 118 84--pink :: RGB-pink = rgb256 255 192 203--puce :: RGB-puce = rgb256 204 136 153--purple :: RGB-purple = rgb256 160 92 240--red :: RGB-red = rgb256 255 1 1--royal_blue :: RGB-royal_blue = rgb256 65 105 225--royal_purple :: RGB-royal_purple = rgb256 107 63 160--rust :: RGB-rust = rgb256 183 65 14--safety_orange :: RGB-safety_orange = rgb256 255 102 1--saffron :: RGB-saffron = rgb256 244 196 48--sapphire :: RGB-sapphire = rgb256 8 37 103--salmon :: RGB-salmon = rgb256 255 140 105--sea_green :: RGB-sea_green = rgb256 46 139 87--sepia :: RGB-sepia = rgb256 112 66 20--shamrock :: RGB-shamrock = rgb256 1 158 96--silver :: RGB-silver = rgb256 192 192 192--slate_gray :: RGB-slate_gray = rgb256 112 128 144--tan_color :: RGB-tan_color = rgb256 210 180 140--teal :: RGB-teal = rgb256 1 128 128--ultramarine :: RGB-ultramarine = rgb256 18 10 143--vermillion :: RGB-vermillion = rgb256 255 77 1--violet :: RGB-violet = rgb256 139 1 255--viridian :: RGB-viridian = rgb256 64 130 109--wheat :: RGB-wheat = rgb256 245 222 179--white :: RGB-white = rgb256 255 255 255--yellow :: RGB-yellow = rgb256 255 255 1-
RSAGL/Modeling/Tesselation.hs view
@@ -14,7 +14,7 @@ import RSAGL.Math.Curve import RSAGL.Auxiliary.Auxiliary import RSAGL.Math.Affine-import RSAGL.Modeling.BoundingBox+import RSAGL.Math.BoundingBox import Data.List import Control.Parallel.Strategies hiding (r0) import Control.Arrow@@ -24,7 +24,7 @@ import Text.Parsec.String () import Data.Ord import Control.Monad-import RSAGL.Types+import RSAGL.Math.Types type TesselatedSurface a = [TesselatedElement a]
RSAGL/RayTrace/RayTrace.lhs view
@@ -5,7 +5,7 @@ \begin{code} module RSAGL.RayTrace.RayTrace (Geometry(..),- Plane, + Plane, plane, plane3, UnitSphere(..), Sphere,@@ -16,13 +16,13 @@ import RSAGL.Scene.CoordinateSystems import RSAGL.Math.Affine-import RSAGL.Math.WrappedAffine+import RSAGL.Scene.WrappedAffine import RSAGL.Math.Vector import RSAGL.Math.Ray import Data.Ord import Data.List import Data.Maybe-import RSAGL.Types+import RSAGL.Math.Types \end{code} \subsection{Geometry}
RSAGL/RayTrace/Scattering.lhs view
@@ -26,13 +26,14 @@ where import RSAGL.Math.Vector-import RSAGL.Modeling.Color+import RSAGL.Color import RSAGL.Math.Angle import RSAGL.Math.Interpolation+import RSAGL.Math.AbstractVector import RSAGL.Auxiliary.Auxiliary import Data.Monoid import Data.List-import RSAGL.Types+import RSAGL.Math.Types \end{code} \section{Scattering}@@ -51,7 +52,7 @@ adjustDistance :: RSdouble -> Scattering -> Scattering adjustDistance d s = Scattering { scattering_absorb = mapRGB (** (recip d)) $ scattering_absorb s,- scattering_scatter = scaleRGB (recip d) . scattering_scatter s }+ scattering_scatter = scalarMultiply (recip d) . scattering_scatter s } mapAbsorbtion :: (RGB -> RGB) -> Scattering -> Scattering mapAbsorbtion f s = s { scattering_absorb = f $ scattering_absorb s }@@ -66,21 +67,22 @@ \begin{code} achromaticAbsorbtion :: Scattering -> Scattering-achromaticAbsorbtion = mapAbsorbtion (gray . meanBrightness)+achromaticAbsorbtion = mapAbsorbtion+ (grayscale . linear_value . viewChannel channel_brightness) \end{code} \texttt{withoutAbsorbtion} removes all absorbtion from a \texttt{Scattering} media. \begin{code} withoutAbsorbtion :: Scattering -> Scattering-withoutAbsorbtion = mapAbsorbtion (const $ gray 1)+withoutAbsorbtion = mapAbsorbtion (const $ grayscale 1) \end{code} \texttt{withoutScattering} removes all scattering from a \texttt{Scattering} media. \begin{code} withoutScattering :: Scattering -> Scattering-withoutScattering = mapScattering (const $ gray 0)+withoutScattering = mapScattering (const $ grayscale 0) \end{code} \texttt{absorbtionOverDistance} takes a distance and the filter color of the absorbion media@@ -96,7 +98,7 @@ \begin{code} emissionOverDistance :: RSdouble -> RGB -> RGB-emissionOverDistance trace_distance emit_rgb = scaleRGB trace_distance emit_rgb+emissionOverDistance trace_distance emit_rgb = scalarMultiply trace_distance emit_rgb \end{code} \texttt{traceScattering} generates a pair (scattered light color,absorbtion filter color) by taking many samples of a@@ -115,9 +117,9 @@ \begin{code} traceScattering :: (Point3D -> Scattering) -> (Point3D -> (Vector3D,RGB)) -> SamplingAlgorithm (RGB,RGB) -> Point3D -> Point3D -> Samples (RGB,RGB) traceScattering scatteringF lightingF samplingF source destination number_of_samples = - foldl' (\(summed_scattering,summed_absorbtion) (this_scattering,this_absorbtion) -> (addRGB summed_scattering (filterRGB summed_absorbtion this_scattering),+ foldl' (\(summed_scattering,summed_absorbtion) (this_scattering,this_absorbtion) -> (add summed_scattering (filterRGB summed_absorbtion this_scattering), filterRGB summed_absorbtion this_absorbtion))- (gray 0,gray 1) $ sampleScattering scatteringF lightingF samplingF source destination number_of_samples+ (grayscale 0,grayscale 1) $ sampleScattering scatteringF lightingF samplingF source destination number_of_samples sampleScattering :: (Point3D -> Scattering) -> (Point3D -> (Vector3D,RGB)) -> SamplingAlgorithm (RGB,RGB) -> Point3D -> Point3D -> Samples [(RGB,RGB)] sampleScattering scatteringF lightingF sampleF source destination = sampleF (\d p -> (scatteredLightAt d p,absorbedLightAt d p))@@ -138,7 +140,7 @@ \begin{code} traceAbsorbtion :: (Point3D -> Scattering) -> SamplingAlgorithm RGB -> Point3D -> Point3D -> Samples RGB traceAbsorbtion scatteringF samplingF source destination number_of_samples =- foldr filterRGB (gray 1) $ samplingF (\d p -> absorbtionOverDistance d $ scattering_absorb $ scatteringF p) source destination number_of_samples+ foldr filterRGB (grayscale 1) $ samplingF (\d p -> absorbtionOverDistance d $ scattering_absorb $ scatteringF p) source destination number_of_samples \end{code} \subsection{Sampling}@@ -156,7 +158,9 @@ conspicuous = recip . minRGB instance AdaptiveSample (RGB,RGB) where- conspicuous (scattering_color,absorbtion_color) = maxRGB scattering_color / minRGB absorbtion_color+ conspicuous (scattering_color,absorbtion_color) =+ linear_value (viewChannel channel_value scattering_color) /+ minRGB absorbtion_color data Sample a = Sample { sample_conspic :: RSdouble,@@ -215,8 +219,8 @@ \begin{code} dust :: RSdouble -> RGB -> Scattering dust d c = adjustDistance d $ Scattering {- scattering_absorb = gray 0.5,- scattering_scatter = flip scaleRGB c . (*0.5) . (1-) . (*2) . f2f . toRotations_ }+ scattering_absorb = grayscale 0.5,+ scattering_scatter = flip scalarMultiply c . (*0.5) . (1-) . (*2) . f2f . toRotations_ } \end{code} \texttt{fog} is a colored media that scatters and absorbs the same color. \texttt{fog}@@ -240,7 +244,7 @@ rayleigh :: RSdouble -> RGB -> Scattering rayleigh d c = adjustDistance d $ Scattering { scattering_absorb = invertRGB c,- scattering_scatter = \theta -> scaleRGB ((1 + f2f (cosine theta)^2)*0.75 ) c }+ scattering_scatter = \theta -> scalarMultiply ((1 + f2f (cosine theta)^2)*0.75 ) c } \end{code} \texttt{elasticBackScatter} throws light back at the light source within a spcified cone.@@ -252,11 +256,11 @@ elasticBackScatter :: RSdouble -> Angle -> RGB -> Scattering elasticBackScatter d a c_ = adjustDistance d $ Scattering { scattering_absorb = invertRGB c,- scattering_scatter = \theta -> scaleRGB (f2f $ max 0 $ n*(r - (toRadians_ theta)^2)) c }+ scattering_scatter = \theta -> scalarMultiply (f2f $ max 0 $ n*(r - (toRadians_ theta)^2)) c } where r_ = toRadians a r = r_^2 n = recip $ (1 + r/2 - sin(r_)*r_ - cos(r_))- c = scaleRGB (f2f $ (toRotations a * 4)^2) c_+ c = scalarMultiply (f2f $ (toRotations a * 4)^2) c_ \end{code} \texttt{elasticForwardScatter} is the reverse of \texttt{elasticBackScatter}. Use this@@ -283,11 +287,11 @@ \begin{code} instance Monoid Scattering where mempty = Scattering {- scattering_absorb = gray 1.0,- scattering_scatter = const $ gray 0 }+ scattering_absorb = grayscale 1.0,+ scattering_scatter = const $ grayscale 0 } x `mappend` y = Scattering { scattering_absorb = scattering_absorb x `filterRGB` scattering_absorb y,- scattering_scatter = \u -> scattering_scatter x u `addRGB` scattering_scatter y u }+ scattering_scatter = \u -> scattering_scatter x u `add` scattering_scatter y u } mconcat [] = mempty mconcat [x] = x mconcat xs = mconcat a `mappend` mconcat b
RSAGL/Scene/CoordinateSystems.lhs view
@@ -46,7 +46,7 @@ import RSAGL.Math.Matrix import RSAGL.Math.Affine import RSAGL.Math.Vector-import RSAGL.Types+import RSAGL.Math.Types \end{code} \subsection{Coordinate Systems}
RSAGL/Scene/LightSource.hs view
@@ -13,11 +13,12 @@ where import RSAGL.Math.Vector-import RSAGL.Modeling.Color as Color+import RSAGL.Color as Color import RSAGL.Math.Affine+import RSAGL.Math.AbstractVector import RSAGL.Scene.CoordinateSystems-import Graphics.UI.GLUT as GLUT-import RSAGL.Types+import Graphics.Rendering.OpenGL as GL+import RSAGL.Math.Types import Data.List as List import Data.Monoid @@ -43,8 +44,8 @@ skylight :: Vector3D -> Color.RGB -> LightSource skylight v c = DirectionalLight { lightsource_direction = v,- lightsource_color = scaleRGB 0.7208681020859709 c,- lightsource_ambient = scaleRGB 0.27913189791402915 c }+ lightsource_color = scalarMultiply 0.7208681020859709 c,+ lightsource_ambient = scalarMultiply 0.27913189791402915 c } -- | 'True' if a light is 'NoLight'. isNoLight :: LightSource -> Bool@@ -91,8 +92,8 @@ infiniteLightSourceOf (d@(DirectionalLight {})) = d infiniteLightSourceOf (p@PointLight {}) = DirectionalLight { lightsource_direction = vectorToFrom (lightsource_position p) origin_point_3d,- lightsource_color = scaleRGB scale_factor $ lightsource_color p,- lightsource_ambient = scaleRGB scale_factor $ lightsource_ambient p }+ lightsource_color = scalarMultiply scale_factor $ lightsource_color p,+ lightsource_ambient = scalarMultiply scale_factor $ lightsource_ambient p } where scale_factor = f2f $ (distanceSquared $ lightsource_radius p) / (distanceBetweenSquared origin_point_3d (lightsource_position p)) instance AffineTransformable LightSource where@@ -105,7 +106,7 @@ -- | Set OpenGL light sources starting from 0. setLightSourcesToOpenGL :: [LightSource] -> IO () setLightSourcesToOpenGL lss =- do max_lights <- GLUT.get maxLights+ do max_lights <- GL.get maxLights mapM_ setLightSourceToOpenGL $ genericTake max_lights $ zip (map Light [0..]) (lss ++ repeat NoLight) -- | Set one specific OpenGL light source.@@ -116,7 +117,7 @@ do let Vector3D vx vy vz = vectorNormalize $ lightsource_direction dl light l $= Enabled ambient l $= Color4 (f2f ar) (f2f ag) (f2f ab) 1.0- GLUT.specular l $= Color4 (f2f cr) (f2f cg) (f2f cb) 1.0+ GL.specular l $= Color4 (f2f cr) (f2f cg) (f2f cb) 1.0 diffuse l $= Color4 (f2f cr) (f2f cg) (f2f cb) 1.0 position l $= Vertex4 (f2f vx) (f2f vy) (f2f vz) 0 attenuation l $= (1,0,0)@@ -125,7 +126,7 @@ lightsource_ambient = Color.RGB ar ag ab })) = do light l $= Enabled ambient l $= Color4 (f2f ar) (f2f ag) (f2f ab) 1.0- GLUT.specular l $= Color4 (f2f cr) (f2f cg) (f2f cb) 1.0+ GL.specular l $= Color4 (f2f cr) (f2f cg) (f2f cb) 1.0 diffuse l $= Color4 (f2f cr) (f2f cg) (f2f cb) 1.0 position l $= Vertex4 (f2f px) (f2f py) (f2f pz) 1 attenuation l $= (0.01,0,f2f $ recip $ distanceSquared $ lightsource_radius pl)
RSAGL/Scene/Scene.lhs view
@@ -34,7 +34,7 @@ where import Data.Ord-import RSAGL.Modeling.BoundingBox+import RSAGL.Math.BoundingBox import RSAGL.Math.Vector import RSAGL.Math.Affine as Affine import RSAGL.Math.Angle as Angle@@ -44,17 +44,17 @@ import Control.Monad.State as State import Control.Arrow import Control.Arrow.Operations-import Graphics.UI.GLUT as GLUT+import Graphics.Rendering.OpenGL as GL import Data.Maybe-import RSAGL.Math.WrappedAffine-import RSAGL.Math.Orthagonal+import RSAGL.Scene.WrappedAffine+import RSAGL.Math.Orthogonal import RSAGL.Scene.LightSource import qualified Data.Map as Map import qualified Data.Set as Set import Data.Monoid-import RSAGL.Auxiliary.RecombinantState+import RSAGL.FRP.RecombinantState import Data.MemoCombinators-import RSAGL.Types+import RSAGL.Math.Types \end{code} \subsection{Cameras}@@ -219,12 +219,12 @@ render1Layer :: RSdouble -> (RSdouble,RSdouble) -> Scene -> SceneLayer -> IO () render1Layer aspect_ratio nearfar (Scene elems layerToCamera) n =- do save_rescale_normal <- GLUT.get rescaleNormal- save_cull_face <- GLUT.get cullFace- save_depth_func <- GLUT.get depthFunc- save_depth_mask <- GLUT.get depthMask- save_lighting <- GLUT.get lighting- save_light_model_ambient <- GLUT.get lightModelAmbient+ do save_rescale_normal <- GL.get rescaleNormal+ save_cull_face <- GL.get cullFace+ save_depth_func <- GL.get depthFunc+ save_depth_mask <- GL.get depthMask+ save_lighting <- GL.get lighting+ save_light_model_ambient <- GL.get lightModelAmbient rescaleNormal $= Enabled cullFace $= Just Front depthFunc $= Just Lequal@@ -232,7 +232,7 @@ lighting $= Enabled lightModelAmbient $= (Color4 0 0 0 1) clear [DepthBuffer]- preservingMatrix $ + preservingMatrix $ do cameraToOpenGL aspect_ratio nearfar (layerToCamera n) mapM_ render1Element $ fromMaybe [] $ Map.lookup (n,True) elems depthMask $= Disabled
+ RSAGL/Scene/WrappedAffine.hs view
@@ -0,0 +1,26 @@+module RSAGL.Scene.WrappedAffine+ (WrappedAffine(..),+ wrapAffine,+ unwrapAffine)+ where++import RSAGL.Math.Affine+import RSAGL.Scene.CoordinateSystems++-- | WrappedAffine stores up affine transformations that are commited only when+-- the entity is unwrapped. In this way we can store affine transformations+-- for entities that can not be directly transformed, or for which delaying+-- transformation an optimization.+data WrappedAffine a = WrappedAffine CoordinateSystem a++wrapAffine :: a -> WrappedAffine a+wrapAffine = WrappedAffine root_coordinate_system++unwrapAffine :: (AffineTransformable a) => WrappedAffine a -> a+unwrapAffine (WrappedAffine cs a) = migrateToFrom root_coordinate_system cs a++instance AffineTransformable (WrappedAffine a) where+ transform t (WrappedAffine cs a) = WrappedAffine (transform t cs) a++instance Functor WrappedAffine where+ fmap f (WrappedAffine m a) = WrappedAffine m $ f a
− RSAGL/Types.hs
@@ -1,49 +0,0 @@-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-module RSAGL.Types- (RSfloat,RSdouble,toGLfloat,toGLdouble,fromGLfloat,fromGLdouble,f2f,GLUT.GLfloat,GLUT.GLdouble)- where--import Graphics.UI.GLUT as GLUT-import Data.Vec as Vec-import System.Random-import Control.Arrow--newtype RSfloat = RSfloat GLfloat- deriving (Enum,Eq,Floating,Fractional,Num,Ord,Read,Real,RealFloat,RealFrac,Show)-newtype RSdouble = RSdouble GLdouble- deriving (Enum,Eq,Floating,Fractional,Num,Ord,Read,Real,RealFloat,RealFrac,Show)--toGLfloat :: RSfloat -> GLfloat-toGLfloat (RSfloat x) = x--toGLdouble :: RSdouble -> GLdouble-toGLdouble (RSdouble x) = x--fromGLfloat :: GLfloat -> RSfloat-fromGLfloat = RSfloat--fromGLdouble :: GLdouble -> RSdouble-fromGLdouble = RSdouble--{-# RULES-"f2f/id" f2f = id #-}-f2f :: (RealFloat a,RealFloat b) => a -> b-f2f = uncurry encodeFloat . decodeFloat-{-# INLINE f2f #-}--instance NearZero RSfloat where- nearZero x = abs x < 1e-6- {-# INLINE nearZero #-}--instance NearZero RSdouble where- nearZero x = abs x < 1e-14- {-# INLINE nearZero #-}--instance Random RSfloat where- randomR (lo,hi) g = first f2f $ randomR (f2f lo, f2f hi :: Float) g- random g = first (f2f :: Float -> RSfloat) $ random g--instance Random RSdouble where- randomR (lo,hi) g = first f2f $ randomR (f2f lo, f2f hi :: Double) g- random g = first (f2f :: Double -> RSdouble) $ random g-
rsagl.cabal view
@@ -1,11 +1,11 @@ name: rsagl-version: 0.4.0.3+version: 0.6.0.0 license: BSD3 license-file: LICENSE author: Christopher Lane Hinson maintainer: Christopher Lane Hinson <lane@downstairspeople.org> -category: Graphics, FRP+category: Graphics synopsis: The RogueStar Animation and Graphics Library description: RSAGL, the RogueStar Animation and Graphics Library, was specifically designed for a computer game called@@ -13,8 +13,6 @@ to other projects that might benefit from it. It includes mathematical utilities, a 3D modeling language based on parametric surfaces, and an arrow-based FRP framework.- .- The git repository is available at <http://www.downstairspeople.org/git/rsagl.git>. cabal-version: >= 1.2 homepage: http://roguestar.downstairspeople.org/ @@ -22,33 +20,38 @@ tested-with: GHC==6.12.1 Library- exposed-modules: RSAGL.Animation, RSAGL.Modeling, RSAGL.FRP, RSAGL.Scene, RSAGL.Math, RSAGL.Math.FMod,- RSAGL.RayTrace.RayTrace, RSAGL.Math.Ray,- RSAGL.Modeling.Material, RSAGL.Modeling.BoundingBox,- RSAGL.Math.Vector, RSAGL.Animation.KinematicSensors, RSAGL.Modeling.RSAGLColors,- RSAGL.Modeling.Extrusion, RSAGL.Modeling.Color,- RSAGL.FRP.Time, RSAGL.Math.Matrix,+ exposed-modules: RSAGL.Animation, RSAGL.Modeling, RSAGL.Scene,+ RSAGL.RayTrace.RayTrace,+ RSAGL.Modeling.Material,+ RSAGL.Animation.KinematicSensors,+ RSAGL.Color.RSAGLColors, RSAGL.Modeling.Extrusion, RSAGL.Animation.Joint,- RSAGL.Math.Affine, RSAGL.Math.WrappedAffine, RSAGL.Math.CurveExtras,- RSAGL.Scene.Scene, RSAGL.Animation.InverseKinematics, RSAGL.FRP.FRP,- RSAGL.Math.RK4, RSAGL.Animation.AnimationExtras, RSAGL.Math.Interpolation,+ RSAGL.Scene.WrappedAffine,+ RSAGL.Scene.Scene, RSAGL.Animation.InverseKinematics,+ RSAGL.Animation.AnimationExtras, RSAGL.Modeling.Model, RSAGL.Modeling.Deformation, RSAGL.Modeling.Noise, RSAGL.Modeling.Tesselation, RSAGL.Modeling.ModelingExtras, RSAGL.Animation.Animation,- RSAGL.Math.Curve, RSAGL.Math.Angle, RSAGL.Modeling.Optimization,- RSAGL.Scene.CoordinateSystems, RSAGL.Math.Orthagonal,- RSAGL.Math.AbstractVector,+ RSAGL.Modeling.Optimization,+ RSAGL.Scene.CoordinateSystems, RSAGL.Scene.LightSource, RSAGL.RayTrace.Scattering, RSAGL.Extras.Sky, RSAGL.Extras.ColorPhysics,- RSAGL.Modeling.BakedModel, RSAGL.FRP.FactoryArrow, RSAGL.Auxiliary.RecombinantState,- RSAGL.Types, RSAGL.FRP.Accumulation, RSAGL.FRP.FRPModel+ RSAGL.Modeling.BakedModel,+ RSAGL.Color.ColorSpace, RSAGL.Color.RGB, RSAGL.Color.HCL,+ RSAGL.Color.Alpha, RSAGL.Color.OpenGL, RSAGL.Color,+ RSAGL.Color.Channels, RSAGL.Color.Spaces, RSAGL.Color.LinearAdjust - other-modules: RSAGL.Modeling.OpenGLPrimitives, RSAGL.Auxiliary.Auxiliary, RSAGL.Auxiliary.ApplicativeWrapper+ other-modules: RSAGL.Modeling.OpenGLPrimitives,+ RSAGL.Auxiliary.Auxiliary,+ RSAGL.Auxiliary.ApplicativeWrapper,+ RSAGL.Color.Auxiliary ghc-options: -fno-warn-type-defaults -fexcess-precision ghc-prof-options: -prof -auto-all build-depends: base>=4 && <5,+ rsagl-math==0.6.0.0,+ rsagl-frp==0.6.0.0, old-time>= 1.0.0.3 && < 1.1, random>= 1.0.0.2 && < 1.1, array>= 0.3.0.0 && < 0.4,@@ -56,14 +59,11 @@ containers>= 0.3.0.0 && < 0.4, parallel>= 2.2.0.1 && < 2.3, mtl>= 1.1.0.2 && < 1.2,- OpenGL>= 2.2.3.0 && < 2.3,- GLUT>= 2.1.2.1 && < 2.2,+ OpenGL>= 2.4.0.1 && < 2.5,+ OpenGLRaw>= 1.1.0.1 && < 1.2, parsec>=3.1.0 && < 3.2, Vec>=0.9.8 && < 0.10,+ Vec-OpenGLRaw>=0.2.0.0 && < 0.3, stm>= 2.1.1.2 && < 2.2, data-memocombinators>= 0.4.0 && < 0.5--Executable _rsagl_process_colors- main-is: ProcessColors.hs- ghc-options: -fno-warn-type-defaults -fexcess-precision