packages feed

Vec 1.0 → 1.0.1

raw patch · 5 files changed

+356/−251 lines, 5 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

- Data.Vec.Base: instance [overlap ok] (Eq u, ShowVec u, Fractional a, Ord (a :. u), ZipWith a a a (a :. u) (a :. u) (a :. u), Map a a (a :. u) (a :. u), Vec (Succ l) a (a :. u), Show (a :. u)) => Fractional (a :. u)
- Data.Vec.Base: instance [overlap ok] (Eq u, ShowVec u, Num a, Map a a (a :. u) (a :. u), ZipWith a a a (a :. u) (a :. u) (a :. u), Vec (Succ l) a (a :. u)) => Num (a :. u)
- Data.Vec.LinAlg: instance [overlap ok] (Show a, Fractional a, NearZero a) => Pivot1 a ((a :. ()) :. ())
+ Data.Vec.Base: instance [overlap ok] (Fractional a, Ord (a :. u), ZipWith a a a (a :. u) (a :. u) (a :. u), Map a a (a :. u) (a :. u), Vec (Succ l) a (a :. u)) => Fractional (a :. u)
+ Data.Vec.Base: instance [overlap ok] (Num a, Map a a (a :. u) (a :. u), ZipWith a a a (a :. u) (a :. u) (a :. u), Vec (Succ l) a (a :. u)) => Num (a :. u)
+ Data.Vec.LinAlg: instance [overlap ok] (Fractional a, NearZero a) => Pivot1 a ((a :. ()) :. ())
+ Data.Vec.LinAlg: orthogonal :: Fractional a => a -> a -> Vec2 a -> Mat44 a
+ Data.Vec.LinAlg: perspective :: Floating a => a -> a -> a -> a -> Mat44 a
+ Data.Vec.LinAlg: rotationEuler :: Floating a => Vec3 a -> Mat44 a
+ Data.Vec.LinAlg: rotationLookAt :: Floating a => Vec3 a -> Vec3 a -> Vec3 a -> Mat44 a
+ Data.Vec.LinAlg: rotationQuat :: Num a => Vec4 a -> Mat44 a
+ Data.Vec.LinAlg: rotationVec :: Floating a => Vec3 a -> a -> Mat44 a
+ Data.Vec.LinAlg: rotationX :: Floating a => a -> Mat44 a
+ Data.Vec.LinAlg: rotationY :: Floating a => a -> Mat44 a
+ Data.Vec.LinAlg: rotationZ :: Floating a => a -> Mat44 a
+ Data.Vec.LinAlg: scaling :: Num a => Vec3 a -> Mat44 a
+ Data.Vec.LinAlg: translation :: Num a => Vec3 a -> Mat44 a

Files

Data/Vec.hs view
@@ -123,17 +123,10 @@   <http://graphics.cs.ucdavis.edu/~okreylos/ResDev/Geometry/index.html> -} -module Data.Vec -  (module Data.Vec.Base-  ,module Data.Vec.LinAlg-  ,module Data.Vec.Packed-  ,module Data.Vec.Nat-  )-where--import Data.Vec.Base-import Data.Vec.LinAlg-import Data.Vec.Packed-import Data.Vec.Nat+module Data.Vec (module X) where+import Data.Vec.Base as X+import Data.Vec.LinAlg as X+import Data.Vec.Packed as X+import Data.Vec.Nat as X
Data/Vec/Base.hs view
@@ -27,11 +27,11 @@  --for UArray instances import Data.Array.Base  as Array-import GHC.ST		( ST(..), runST )-import GHC.Prim     +import GHC.ST        ( ST(..), runST )+import GHC.Prim import GHC.Base         ( Int(..) )-import GHC.Float	( Float(..), Double(..) )-import GHC.Word		( Word8(..) )+import GHC.Float    ( Float(..), Double(..) )+import GHC.Word        ( Word8(..) )   -- | The vector constructor. @(:.)@ for vectors is like @(:)@ for lists, and@@ -85,7 +85,7 @@   -- | The type constraint @Vec n a v@ infers the vector type @v@ from the--- length @n@, a type-level natural, and underlying component type @a@.  +-- length @n@, a type-level natural, and underlying component type @a@. -- So @x :: Vec N4 a v => v@ declares @x@ to be a 4-vector of @a@s.  class Vec n a v | n a -> v, v -> n a where@@ -118,13 +118,13 @@   -- distinction between this and 'matFromList', as you might accidentally use   -- this when you mean that. Because number literals can be converted to   -- vectors, and matrices are vectors of vectors, the following works-  -- -  -- > fromList [1,2,3,4] :: Mat22 Int +  --+  -- > fromList [1,2,3,4] :: Mat22 Int   -- > > ((1):.(1):.()):.((2):.(2):.()):.()   --   -- even though we meant to do this   ---  -- > matFromList [1,2,3,4] :: Mat22 Int +  -- > matFromList [1,2,3,4] :: Mat22 Int   -- > > ((1):.(2):.()):.((3):.(4):.()):.()   fromList :: [a] -> v @@ -140,7 +140,7 @@   getElem i (a :. _)     | i == 0    = a     | otherwise = error "getElem: index out of bounds"-  setElem i a _ +  setElem i a _     | i == 0    = a :. ()     | otherwise = error "setElem: index out of bounds"   {-# INLINE setElem #-}@@ -162,7 +162,7 @@  -- | get or set a vector element, known at compile --time. Use the Nat types to access vector components. For instance, @get n0@---gets the x component, @set n2 44@ sets the z component to 44. +--gets the x component, @set n2 44@ sets the z component to 44.  class Access n a v | v -> a where   get  :: n -> v -> a@@ -185,20 +185,20 @@  -- | The first element. -class Head v a | v -> a  where +class Head v a | v -> a  where   head :: v -> a -instance Head (a :. as) a where +instance Head (a :. as) a where   head (a :. _) = a   {-# INLINE head #-}  --- | All but the first element. +-- | All but the first element. -class Tail v v_ | v -> v_ where +class Tail v v_ | v -> v_ where   tail :: v -> v_ -instance Tail (a :. as) as where +instance Tail (a :. as) as where   tail (_ :. as) = as   {-# INLINE tail #-} @@ -243,15 +243,15 @@   zipWith f (x:._) (y:._) = f x y :.()   {-# INLINE zipWith #-} -instance -  ZipWith a b c (a':.u) (b':.v) (c':.w) -  => ZipWith a b c (a:.a':.u) (b:.b':.v) (c:.c':.w) +instance+  ZipWith a b c (a':.u) (b':.v) (c':.w)+  => ZipWith a b c (a:.a':.u) (b:.b':.v) (c:.c':.w)     where       zipWith f (x:.u) (y:.v) = f x y :. zipWith f u v       {-# INLINE zipWith #-}  --- | Fold a function over a vector. +-- | Fold a function over a vector.  class Fold v a | v -> a where   fold  :: (a -> a -> a) -> v -> a@@ -259,7 +259,7 @@   foldr :: (a -> b -> b) -> b -> v -> b  instance Fold (a:.()) a where-  fold  _   (a:._) = a +  fold  _   (a:._) = a   foldl f z (a:._) = seq z $ f z a   foldr f z (a:._) = f a z   {-# INLINE fold #-}@@ -274,7 +274,7 @@   {-# INLINE foldl #-}   {-# INLINE foldr #-} --- | Reverse a vector +-- | Reverse a vector reverse ::  (Reverse' () v v') => v -> v' reverse v = reverse' () v {-# INLINE reverse #-}@@ -285,19 +285,19 @@ -- | Reverse helper function : accumulates the reversed list in its first argument class Reverse' p v v' | p v -> v' where   reverse' :: p -> v -> v'-  + instance Reverse' p () p where   reverse' p () = p   {-# INLINE reverse' #-}  instance Reverse' (a:.p) v v' => Reverse' p (a:.v) v' where-  reverse' p (a:.v) = reverse' (a:.p) v +  reverse' p (a:.v) = reverse' (a:.p) v   {-# INLINE reverse' #-}  --- | Append two vectors +-- | Append two vectors -class Append v1 v2 v3 | v1 v2 -> v3, v1 v3 -> v2 where +class Append v1 v2 v3 | v1 v2 -> v3, v1 v3 -> v2 where   append :: v1 -> v2 -> v3  instance Append () v v where@@ -325,7 +325,7 @@   take _ _ = ()   {-# INLINE take #-} -instance Take n v v' +instance Take n v v'          => Take (Succ n) (a:.v) (a:.v') where   take _ (a:.v) = a:.(take (undefined::n) v)   {-# INLINE take #-}@@ -336,12 +336,12 @@  class Drop n v v' | n v -> v' where   drop :: n -> v -> v'- + instance Drop N0 v v where   drop _ = id   {-# INLINE drop #-} -instance (Drop n (a:.v) v') +instance (Drop n (a:.v) v')           => Drop (Succ n) (a:.a:.v) v' where   drop _ (_:.v) = drop (undefined::n) v   {-# INLINE drop #-}@@ -352,7 +352,7 @@ class Last v a | v -> a where   last :: v -> a -instance Last (a:.()) a where +instance Last (a:.()) a where   last (a:._) = a   {-# INLINE last #-} @@ -361,8 +361,8 @@   {-# INLINE last #-}  --- | @snoc v a@ appends the element a to the end of v. -class Snoc v a v' | v a -> v', v' -> v a where +-- | @snoc v a@ appends the element a to the end of v.+class Snoc v a v' | v a -> v', v' -> v a where   snoc :: v -> a -> v'  instance Snoc () a (a:.()) where@@ -406,7 +406,7 @@ {-# INLINE minimum #-}  toList ::  (Fold v a) => v -> [a]-toList = foldr (:) [] +toList = foldr (:) [] {-# INLINE toList #-}  @@ -459,7 +459,7 @@   --- Storable instances. +-- Storable instances.  instance Storable a => Storable (a:.()) where   sizeOf _ = sizeOf (undefined::a)@@ -479,19 +479,19 @@   {-# INLINE pokeByteOff #-}   {-# INLINE pokeElemOff #-} -instance (Vec (Succ (Succ n)) a (a:.a:.v), Storable a, Storable (a:.v)) -  => Storable (a:.a:.v) +instance (Vec (Succ (Succ n)) a (a:.a:.v), Storable a, Storable (a:.v))+  => Storable (a:.a:.v)   where   sizeOf _ = sizeOf (undefined::a) + sizeOf (undefined::(a:.v))   alignment _ = alignment (undefined::a)-  peek p = -    peek (castPtr p) >>= \a -> -    peek (castPtr (p`plusPtr`sizeOf(undefined::a))) >>= \v -> +  peek p =+    peek (castPtr p) >>= \a ->+    peek (castPtr (p`plusPtr`sizeOf(undefined::a))) >>= \v ->     return (a:.v)   peekByteOff p o = peek (p`plusPtr`o)   peekElemOff p i = peek (p`plusPtr`(i*sizeOf(undefined::(a:.a:.v))))-  poke p (a:.v) = -    poke (castPtr p) a >> +  poke p (a:.v) =+    poke (castPtr p) a >>     poke (castPtr (p`plusPtr`sizeOf(undefined::a))) v   pokeByteOff p o x = poke (p`plusPtr`o) x   pokeElemOff p i x = poke (p`plusPtr`(i*sizeOf(undefined::(a:.a:.v)))) x@@ -506,21 +506,21 @@   -- Num and Fractional instances : All arithmetic is done component-wise and--- literals construct uniform vectors and matrices. +-- literals construct uniform vectors and matrices. ----- The rule is : ---    If the method is unary, it's a map.  +-- The rule is :+--    If the method is unary, it's a map. --    If it's binary, it's a zipWith.  instance-    (Eq u, ShowVec u, Num a-    ,Map a a (a:.u) (a:.u) +    (Num a+    ,Map a a (a:.u) (a:.u)     ,ZipWith a a a (a:.u) (a:.u) (a:.u)     ,Vec (Succ l) a (a:.u)     )-    => Num (a:.u) +    => Num (a:.u)   where-    (+) u v = zipWith (+) u v +    (+) u v = zipWith (+) u v     (-) u v = zipWith (-) u v     (*) u v = zipWith (*) u v     abs u = map abs u@@ -534,15 +534,14 @@     {-# INLINE fromInteger #-}  -instance -    (Eq u, ShowVec u, Fractional a+instance+    (Fractional a     ,Ord (a:.u)     ,ZipWith a a a (a:.u) (a:.u) (a:.u)     ,Map a a (a:.u) (a:.u)-    ,Vec (Succ l) a (a:.u)-    ,Show (a:.u)-    ) -    => Fractional (a:.u) +    ,Vec (Succ l) a (a:.u)    +    )+    => Fractional (a:.u)   where     (/) u v = zipWith (/) u v     recip u = map recip u@@ -566,15 +565,15 @@     vaWrite#  :: MutableByteArray# s# -> Int# -> v -> State# s# -> State# s#     vaIndex#  :: ByteArray# -> Int# -> v     vaSizeOf# :: v -> Int# --the size of a vector in bytes-    vaLength# :: v -> Int# --the length of a vector +    vaLength# :: v -> Int# --the length of a vector     init#     :: v         --the default item when newArray_ is used   instance VecArrayRW (Int:.()) where     vaRead# arr# i# s1# =-        case readIntArray# arr# i# s1# of -          (# s2#, x# #) -> (# s2#, ((I# x#):.()) #) -    vaWrite# arr# i# ((I# x#):._) s1# = +        case readIntArray# arr# i# s1# of+          (# s2#, x# #) -> (# s2#, ((I# x#):.()) #)+    vaWrite# arr# i# ((I# x#):._) s1# =         case writeIntArray# arr# i# x# s1# of { s2# -> s2# }     vaIndex# arr# i# = I# (indexIntArray# arr# i#) :. ()     vaSizeOf# _ = sizeOf# (undefined::Int)@@ -588,18 +587,18 @@     {-# INLINE init# #-}  instance (VecArrayRW (Int:.v)) => VecArrayRW (Int:.Int:.v) where-    vaRead# arr# i# s1# = -        case readIntArray# arr# i# s1# of { (# s2#, x# #) -> -        case vaRead# arr# (i# +# 1#) s2# of { (# s3#, v  #) -> +    vaRead# arr# i# s1# =+        case readIntArray# arr# i# s1# of { (# s2#, x# #) ->+        case vaRead# arr# (i# +# 1#) s2# of { (# s3#, v  #) ->         (# s3#, ((I# x#):.v) #) }}-    vaWrite# arr# i# ((I# x#):.v) s1# = -        case writeIntArray# arr# i# x# s1# of { s2# -> +    vaWrite# arr# i# ((I# x#):.v) s1# =+        case writeIntArray# arr# i# x# s1# of { s2# ->         case vaWrite# arr# (i# +# 1#) v s2# of { s3# -> s3# }}-    vaIndex# arr# i# = I# (indexIntArray# arr# i#) :. +    vaIndex# arr# i# = I# (indexIntArray# arr# i#) :.                        vaIndex# arr# (i# +# 1#)     vaSizeOf# _ = sizeOf# (undefined::Int) +# vaSizeOf# (undefined::Int:.v)     vaLength# _ = 1# +# vaLength# (undefined::Int:.v)-    init# = 0 :. init# +    init# = 0 :. init#     {-# INLINE vaRead# #-}     {-# INLINE vaWrite# #-}     {-# INLINE vaIndex# #-}@@ -609,9 +608,9 @@  instance VecArrayRW (Double:.()) where     vaRead# arr# i# s1# =-        case readDoubleArray# arr# i# s1# of -          (# s2#, x# #) -> (# s2#, ((D# x#):.()) #) -    vaWrite# arr# i# ((D# x#):._) s1# = +        case readDoubleArray# arr# i# s1# of+          (# s2#, x# #) -> (# s2#, ((D# x#):.()) #)+    vaWrite# arr# i# ((D# x#):._) s1# =         case writeDoubleArray# arr# i# x# s1# of { s2# -> s2# }     vaIndex# arr# i# = D# (indexDoubleArray# arr# i#) :. ()     vaSizeOf# _ = sizeOf# (undefined::Double)@@ -625,18 +624,18 @@     {-# INLINE init# #-}  instance (VecArrayRW (Double:.v)) => VecArrayRW (Double:.Double:.v) where-    vaRead# arr# i# s1# = -        case readDoubleArray# arr# i# s1# of { (# s2#, x# #) -> -        case vaRead# arr# (i# +# 1#) s2# of { (# s3#, v  #) -> +    vaRead# arr# i# s1# =+        case readDoubleArray# arr# i# s1# of { (# s2#, x# #) ->+        case vaRead# arr# (i# +# 1#) s2# of { (# s3#, v  #) ->         (# s3#, ((D# x#):.v) #) }}-    vaWrite# arr# i# ((D# x#):.v) s1# = -        case writeDoubleArray# arr# i# x# s1# of { s2# -> +    vaWrite# arr# i# ((D# x#):.v) s1# =+        case writeDoubleArray# arr# i# x# s1# of { s2# ->         case vaWrite# arr# (i# +# 1#) v s2# of { s3# -> s3# }}-    vaIndex# arr# i# = D# (indexDoubleArray# arr# i#) :. +    vaIndex# arr# i# = D# (indexDoubleArray# arr# i#) :.                        vaIndex# arr# (i# +# 1#)     vaSizeOf# _ = sizeOf# (undefined::Double) +# vaSizeOf# (undefined::Double:.v)     vaLength# _ = 1# +# vaLength# (undefined::Double:.v)-    init# = 0 :. init# +    init# = 0 :. init#     {-# INLINE vaRead# #-}     {-# INLINE vaWrite# #-}     {-# INLINE vaIndex# #-}@@ -647,9 +646,9 @@  instance VecArrayRW (Float:.()) where     vaRead# arr# i# s1# =-        case readFloatArray# arr# i# s1# of -          (# s2#, x# #) -> (# s2#, ((F# x#):.()) #) -    vaWrite# arr# i# ((F# x#):._) s1# = +        case readFloatArray# arr# i# s1# of+          (# s2#, x# #) -> (# s2#, ((F# x#):.()) #)+    vaWrite# arr# i# ((F# x#):._) s1# =         case writeFloatArray# arr# i# x# s1# of { s2# -> s2# }     vaIndex# arr# i# = F# (indexFloatArray# arr# i#) :. ()     vaSizeOf# _ = sizeOf# (undefined::Float)@@ -663,18 +662,18 @@     {-# INLINE init# #-}  instance (VecArrayRW (Float:.v)) => VecArrayRW (Float:.Float:.v) where-    vaRead# arr# i# s1# = -        case readFloatArray# arr# i# s1# of { (# s2#, x# #) -> -        case vaRead# arr# (i# +# 1#) s2# of { (# s3#, v  #) -> +    vaRead# arr# i# s1# =+        case readFloatArray# arr# i# s1# of { (# s2#, x# #) ->+        case vaRead# arr# (i# +# 1#) s2# of { (# s3#, v  #) ->         (# s3#, ((F# x#):.v) #) }}-    vaWrite# arr# i# ((F# x#):.v) s1# = -        case writeFloatArray# arr# i# x# s1# of { s2# -> +    vaWrite# arr# i# ((F# x#):.v) s1# =+        case writeFloatArray# arr# i# x# s1# of { s2# ->         case vaWrite# arr# (i# +# 1#) v s2# of { s3# -> s3# }}-    vaIndex# arr# i# = F# (indexFloatArray# arr# i#) :. +    vaIndex# arr# i# = F# (indexFloatArray# arr# i#) :.                        vaIndex# arr# (i# +# 1#)     vaSizeOf# _ = sizeOf# (undefined::Float) +# vaSizeOf# (undefined::Float:.v)     vaLength# _ = 1# +# vaLength# (undefined::Float:.v)-    init# = 0 :. init# +    init# = 0 :. init#     {-# INLINE vaRead# #-}     {-# INLINE vaWrite# #-}     {-# INLINE vaIndex# #-}@@ -685,9 +684,9 @@  instance VecArrayRW (Word8:.()) where     vaRead# arr# i# s1# =-        case readWord8Array# arr# i# s1# of -          (# s2#, x# #) -> (# s2#, ((W8# x#):.()) #) -    vaWrite# arr# i# ((W8# x#):._) s1# = +        case readWord8Array# arr# i# s1# of+          (# s2#, x# #) -> (# s2#, ((W8# x#):.()) #)+    vaWrite# arr# i# ((W8# x#):._) s1# =         case writeWord8Array# arr# i# x# s1# of { s2# -> s2# }     vaIndex# arr# i# = W8# (indexWord8Array# arr# i#) :. ()     vaSizeOf# _ = sizeOf# (undefined::Word8)@@ -701,18 +700,18 @@     {-# INLINE init# #-}  instance (VecArrayRW (Word8:.v)) => VecArrayRW (Word8:.Word8:.v) where-    vaRead# arr# i# s1# = -        case readWord8Array# arr# i# s1# of { (# s2#, x# #) -> -        case vaRead# arr# (i# +# 1#) s2# of { (# s3#, v  #) -> +    vaRead# arr# i# s1# =+        case readWord8Array# arr# i# s1# of { (# s2#, x# #) ->+        case vaRead# arr# (i# +# 1#) s2# of { (# s3#, v  #) ->         (# s3#, ((W8# x#):.v) #) }}-    vaWrite# arr# i# ((W8# x#):.v) s1# = -        case writeWord8Array# arr# i# x# s1# of { s2# -> +    vaWrite# arr# i# ((W8# x#):.v) s1# =+        case writeWord8Array# arr# i# x# s1# of { s2# ->         case vaWrite# arr# (i# +# 1#) v s2# of { s3# -> s3# }}-    vaIndex# arr# i# = W8# (indexWord8Array# arr# i#) :. +    vaIndex# arr# i# = W8# (indexWord8Array# arr# i#) :.                        vaIndex# arr# (i# +# 1#)     vaSizeOf# _ = sizeOf# (undefined::Word8) +# vaSizeOf# (undefined::Word8:.v)     vaLength# _ = 1# +# vaLength# (undefined::Word8:.v)-    init# = 0 :. init# +    init# = 0 :. init#     {-# INLINE vaRead# #-}     {-# INLINE vaWrite# #-}     {-# INLINE vaIndex# #-}@@ -730,16 +729,16 @@     {-# INLINE getNumElements #-}     getNumElements (STUArray _ _ n _) = return n     {-# INLINE unsafeNewArray_ #-}-    unsafeNewArray_ (l,u) = +    unsafeNewArray_ (l,u) =         unsafeNewArraySTUArray_ (l,u) (\x# -> x# *# vaSizeOf# (undefined::a:.v) )     {-# INLINE newArray_ #-}     newArray_ arrBounds = Array.newArray arrBounds init#     {-# INLINE unsafeRead #-}-    unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# -> -        vaRead# marr# (vaLength# (undefined::a:.v) *# i#) s1# +    unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# ->+        vaRead# marr# (vaLength# (undefined::a:.v) *# i#) s1#     {-# INLINE unsafeWrite #-}     unsafeWrite (STUArray _ _ _ marr#) (I# i#) v = ST $ \s1# ->-        case vaWrite# marr# (vaLength# (undefined::a:.v) *# i#) v s1# of s2# -> (# s2#, () #) +        case vaWrite# marr# (vaLength# (undefined::a:.v) *# i#) v s1# of s2# -> (# s2#, () #)  instance VecArrayRW (a:.v) => IArray UArray (a:.v) where     {-# INLINE bounds #-}@@ -749,13 +748,13 @@     {-# INLINE unsafeArray #-}     unsafeArray lu ies = runST (unsafeArrayUArray lu ies init# )     {-# INLINE unsafeAt #-}-    unsafeAt (UArray _ _ _ arr#) (I# i#) = +    unsafeAt (UArray _ _ _ arr#) (I# i#) =         vaIndex# arr# (vaLength# (undefined::a:.v) *# i#)     {-# INLINE unsafeReplace #-}     unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)     {-# INLINE unsafeAccum #-}     unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)     {-# INLINE unsafeAccumArray #-}-    unsafeAccumArray f initialValue lu ies = +    unsafeAccumArray f initialValue lu ies =         runST (unsafeAccumArrayUArray f initialValue lu ies)
Data/Vec/LinAlg.hs view
@@ -1,6 +1,5 @@ {- Copyright (c) 2008, Scott E. Dillard. All rights reserved. -} -{-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-}@@ -14,7 +13,7 @@  {-# OPTIONS_HADDOCK ignore-exports,prune #-} -module Data.Vec.LinAlg +module Data.Vec.LinAlg   (dot   ,normSq   ,norm@@ -44,6 +43,17 @@   ,invert   ,invertAndDet   ,solve+  ,translation+  ,rotationX+  ,rotationY+  ,rotationZ+  ,rotationVec+  ,rotationEuler+  ,rotationQuat+  ,rotationLookAt+  ,scaling+  ,perspective+  ,orthogonal     ) where  import Prelude hiding (map,zipWith,foldl,foldr,reverse,take,drop,@@ -73,7 +83,7 @@ -- | @normalize v@ is a unit vector in the direction of @v@. @v@ is assumed -- non-null. normalize :: (Floating a, Num v, Fold v a, Map a a v v) => v -> v-normalize v = map (/(norm v)) v+normalize v = map (/ norm v) v {-# INLINE normalize #-}  -- | 3d cross product.@@ -94,7 +104,7 @@  -- | project a vector from homogenous coordinates. Last vector element is -- assumed non-zero.-project :: +project ::   ( Reverse' () t1 v'   , Fractional t1   , Vec a t t1@@ -105,7 +115,7 @@   -- | row vector * matrix-multvm :: +multvm ::   ( Transpose m mt   , Map v a mt v'   , Fold v a@@ -116,7 +126,7 @@ {-# INLINE multvm #-}  -- | matrix * column vector-multmv :: +multmv ::   ( Map v a m v'   , Num v   , Fold v a@@ -125,8 +135,8 @@ multmv m v = map (dot v) m {-# INLINE multmv #-} --- | matrix * matrix -multmm :: +-- | matrix * matrix+multmm ::   (Map v v' m1 m3   ,Map v a b v'   ,Transpose m2 b@@ -138,7 +148,7 @@ {-# INLINE multmm #-}  -- | apply a translation to a projective transformation matrix-translate :: +translate ::   (Transpose m mt   ,Reverse' () mt (v' :. t)   ,Reverse' (v' :. ()) t v'1@@ -147,19 +157,19 @@   ,Num a   ,Snoc v a v'   ) => v -> m -> m-translate v m = +translate v m =   case reverse (transpose m) of-    (h:.t) -> transpose (reverse (((homVec v) + h) :. t))+    (h:.t) -> transpose (reverse ((homVec v + h) :. t)) {-# INLINE translate #-}  -- | get the @n@-th column as a vector. @n@ is a type-level natural. column ::  (Transpose m mt, Access n v mt) => n -> m -> v-column n = get n . transpose +column n = get n . transpose {-# INLINE row #-}  -- | get the @n@-th row as a vector. @n@ is a type-level natural. row ::  (Access n a v) => n -> v -> a-row n = get n+row = get {-# INLINE column #-}  @@ -167,13 +177,13 @@ -- because Transpose` can't do it, the fundeps there can't be bijective  -- | matrix transposition-class Transpose a b | a -> b, b -> a where +class Transpose a b | a -> b, b -> a where   transpose :: a -> b  instance Transpose () () where   transpose = id -instance +instance     (Vec (Succ n) s (s:.ra)  --(s:ra) is an n-vector of s'es (row of a)     ,Vec (Succ m) (s:.ra) ((s:.ra):.a)  --a is an m-vector of ra's     ,Vec (Succ m) s (s:.rb)  --rb is an m-vector of s'es (row of b)@@ -190,11 +200,11 @@ class Transpose' a b | a->b   where transpose' :: a -> b -instance Transpose' () () where +instance Transpose' () () where   transpose' = id   {-# INLINE transpose' #-} -instance +instance     (Transpose' vs vs') => Transpose' ( () :. vs ) vs'   where     transpose' (():.vs) = transpose' vs@@ -203,17 +213,17 @@ instance Transpose' ((x:.()):.()) ((x:.()):.()) where   transpose' = id -instance +instance     (Head xss_h xss_hh     ,Map xss_h xss_hh (xss_h:.xss_t) xs'     ,Tail xss_h xss_ht     ,Map xss_h xss_ht (xss_h:.xss_t) xss_     ,Transpose' (xs :. xss_) xss'     )-    => Transpose' ((x:.xs):.(xss_h:.xss_t)) ((x:.xs'):.xss') +    => Transpose' ((x:.xs):.(xss_h:.xss_t)) ((x:.xs'):.xss')   where     transpose' ((x:.xs):.xss) =-      (x :. (map head xss)) :. (transpose' (xs :. (map tail xss) :: (xs:.xss_)))+      (x :. map head xss) :. transpose' (xs :. map tail xss :: (xs :. xss_))     {-# INLINE transpose' #-}  @@ -225,7 +235,7 @@   setDiagonal :: v -> m -> m  instance (Vec n a v, Vec n r m, SetDiagonal' N0 v m) => SetDiagonal v m where-  setDiagonal v m = setDiagonal' (undefined::N0) v m+  setDiagonal = setDiagonal' (undefined :: N0)   {-# INLINE setDiagonal #-}  class SetDiagonal' n v m  where@@ -235,13 +245,13 @@   setDiagonal' _ _ m = m   {-# INLINE setDiagonal' #-} -instance +instance     ( SetDiagonal' (Succ n) v m     , Access n a r-    ) => SetDiagonal' n (a:.v) (r:.m) +    ) => SetDiagonal' n (a:.v) (r:.m)   where-    setDiagonal' _ (a:.v) (r:.m) = -       (set (undefined::n) a r) :. (setDiagonal' (undefined::Succ n) v m)+    setDiagonal' _ (a:.v) (r:.m) =+       set (undefined :: n) a r :. setDiagonal' (undefined :: Succ n) v m     {-# INLINE setDiagonal' #-}  @@ -251,43 +261,43 @@   getDiagonal :: m -> v  instance (Vec n a v, Vec n v m, GetDiagonal' N0 () m v) => GetDiagonal m v where-  getDiagonal m = getDiagonal' (undefined::N0) () m+  getDiagonal = getDiagonal' (undefined :: N0) ()   {-# INLINE getDiagonal #-}  class GetDiagonal' n p m v where   getDiagonal' :: n -> p -> m -> v -instance +instance     (Access n a r     ,Append p (a:.()) (a:.p)-    ) => GetDiagonal' n p (r:.()) (a:.p) +    ) => GetDiagonal' n p (r:.()) (a:.p)   where-    getDiagonal' _ p (r:.()) = append p ((get (undefined::n) r) :. ())+    getDiagonal' _ p (r:.()) = append p (get (undefined :: n) r :. ())     {-# INLINE getDiagonal' #-} -instance +instance     (Access n a r     ,Append p (a:.()) p'     ,GetDiagonal' (Succ n) p' (r:.m) v-    ) +    )     => GetDiagonal' n p (r:.r:.m) v   where-    getDiagonal' _ p (r:.m) = -      getDiagonal' (undefined::Succ n) (append p ((get (undefined::n) r):.())) m+    getDiagonal' _ p (r:.m) =+      getDiagonal' (undefined::Succ n) (append p (get (undefined :: n) r :. ())) m     {-# INLINE getDiagonal' #-}   -- | @scale v m@ multiplies the diagonal of matrix @m@ by the vector @s@, component-wise. So -- @scale 5 m@ multiplies the diagonal by 5, whereas @scale 2:.1 m@ -- only scales the x component.-scale :: +scale ::   ( GetDiagonal' N0 () m r   , Num r   , Vec n a r   , Vec n r m   , SetDiagonal' N0 r m   ) => r -> m -> m-scale s m = setDiagonal (s * (getDiagonal m)) m+scale s m = setDiagonal (s * getDiagonal m) m {-# INLINE scale #-}  @@ -300,7 +310,7 @@  -- | identity matrix (square) identity :: (Vec n a v, Vec n v m, Num v, Num m, SetDiagonal v m) => m-identity = diagonal 1 +identity = diagonal 1 {-# INLINE identity #-}  @@ -320,7 +330,7 @@   --- The Determinant of a square matrix, by minor expansion. +-- The Determinant of a square matrix, by minor expansion. class Det' m a | m -> a where   det' :: m -> a @@ -330,7 +340,7 @@   -instance +instance   ( (a:.a:.v) ~ r                  -- a row of the matrix, an n-vector   , ((a:.a:.v):.(a:.a:.v):.vs) ~ m -- an n*n matrix, n >= 2   , ((a:.v):.(a:.v):.vs_) ~ m_     -- an n*(n-1) matrix@@ -347,20 +357,20 @@   ) => Det' ((a:.a:.v):.(a:.a:.v):.vs) a                    -- et voila   where   det' m =-    sum $ (negateOdds $ map head m) * map det' (dropConsec $ map tail m)+    sum $ negateOdds (map head m) * map det' (dropConsec $ map tail m)   -- DropConsec: Drop consecutive elements, collecting the results. Given an -- n-vector v, drop each element from v, one at a time in sequence, and collect -- the resulting (n-1)-vectors into an n-vector (ie an n-by-(n-1) matrix). -- This is used for determinants.--- +-- -- dropConsec [1,2,3,4] = [[2,3,4],[1,3,4],[1,2,4],[1,2,3]] -- class DropConsec v vv | v -> vv where   dropConsec :: v -> vv -instance +instance   (Vec n a v   ,Pred n n_   ,Vec n_ a v_@@ -368,25 +378,25 @@   ,DropConsec' () v vv   ) => DropConsec v vv   where-    dropConsec v = dropConsec' () v +    dropConsec = dropConsec' ()     {-# INLINE dropConsec #-}  class DropConsec' p v vv  where   dropConsec' :: p -> v -> vv-    + instance DropConsec' p (a:.()) (p:.()) where-  dropConsec' p (a:.()) = (p:.())+  dropConsec' p (a:.()) = p :. ()   {-# INLINE dropConsec' #-} -instance +instance     (Append p (a:.v) x     ,Append p (a:.()) y     ,DropConsec' y (a:.v) z-    ) +    )     => DropConsec' p (a:.a:.v) (x:.z)   where-    dropConsec' p (a:.v) = -      (append p v) :. (dropConsec' (append p (a:.())) v)+    dropConsec' p (a:.v) =+      append p v :. dropConsec' (append p (a :. ())) v     {-# INLINE dropConsec' #-}  @@ -395,16 +405,16 @@ -- Used for determinants.  class NegateOdds v where-  negateOdds :: v -> v +  negateOdds :: v -> v  class NegateEvens v where-  negateEvens :: v -> v +  negateEvens :: v -> v -instance NegateOdds  () where -  negateOdds  () = () +instance NegateOdds  () where+  negateOdds  () = ()   {-# INLINE negateOdds #-}-instance NegateEvens () where -  negateEvens () = () +instance NegateEvens () where+  negateEvens () = ()   {-# INLINE negateEvens #-}  instance (Num a, NegateEvens v) => NegateOdds (a:.v) where@@ -427,7 +437,7 @@ class ReplConsec a v vv | v->a, v->vv, vv->v, vv->a where   replConsec :: a -> v -> vv -instance +instance   (Vec n a v   ,Vec n v vv   ,ReplConsec' a () v vv@@ -443,15 +453,15 @@   replConsec' _ _ () = ()   {-# INLINE replConsec' #-} -instance +instance     (Append p (a:.v) x     ,Append p (a:.()) y     ,ReplConsec' a y v z-    ) +    )     => ReplConsec' a p (a:.v) (x:.z)   where-    replConsec' r p (a:.v) = -      (append p (r:.v)) :. (replConsec' r (append p (a :. ())) v)+    replConsec' r p (a:.v) =+      append p (r :. v) :. replConsec' r (append p (a :. ())) v     {-# INLINE replConsec' #-}  @@ -463,7 +473,7 @@ -- expression, with no branches or allocations (other than the result). You may -- need to increase the unfolding threshold to see this. -cramer'sRule :: +cramer'sRule ::   (Map a a1 b1 v   ,Transpose w b1   ,ZipWith a2 b vv v m w@@ -475,9 +485,9 @@   ,Det' a a1   ) => m -> v -> v cramer'sRule m b =-  case map (\m' -> (det' m')/(det' m)) -           (transpose (zipWith replConsec b m)) -    of b' -> b' `asTypeOf` b +  case map (\m' -> det' m' / det' m)+           (transpose (zipWith replConsec b m))+    of b' -> b' `asTypeOf` b {-# INLINE cramer'sRule #-}  @@ -489,13 +499,10 @@ {-# INLINE mapFst #-}  -class (Eq a, Num a) => NearZero a where+class Num a => NearZero a where   -- | @nearZero x@ should be true when x is close enough to 0 to cause-  -- significant error in division. +  -- significant error in division.   nearZero :: a -> Bool-  nearZero 0 = True-  nearZero _ = False-  {-# INLINE nearZero #-}  instance NearZero Float where   nearZero x = abs x < 1e-6@@ -505,55 +512,58 @@   nearZero x = abs x < 1e-14   {-# INLINE nearZero #-} -instance NearZero Rational +instance NearZero Rational where+  nearZero 0 = True+  nearZero _ = False+  {-# INLINE nearZero #-}    -- Pivot1 : find a non-zero pivot column and put a 1 there. Second return -- argument tracks value of determinant. Returns nothing if no pivot in the -- first row. Does not try to find the 'best' pivot, only an acceptable one:--- matrices are assumed small, roundoff error should be negligible. +-- matrices are assumed small, roundoff error should be negligible. -class Pivot1 a m where +class Pivot1 a m where   pivot1 :: m -> Maybe (m,a) ---this instance prevents a fundep inferring type of a from m. +--this instance prevents a fundep inferring type of a from m. instance Pivot1 a () where   pivot1 _ = Nothing -instance -    ( Show a, Fractional a, NearZero a-    ) => Pivot1 a ((a:.()):.()) +instance+    ( Fractional a, NearZero a+    ) => Pivot1 a ((a:.()):.())   where-    pivot1 ((p:._):._) +    pivot1 ((p:._):._)       | nearZero p = Nothing       | otherwise  = Just (1,p)     {-# INLINE pivot1 #-} -instance -    ( Fractional a, NearZero a +instance+    ( Fractional a, NearZero a     , Map a a (a:.r) (a:.r)-    ) => Pivot1 a ((a:.(a:.r)):.()) +    ) => Pivot1 a ((a:.(a:.r)):.())   where-    pivot1 ((p:.r):._) +    pivot1 ((p:.r):._)       | nearZero p = Nothing-      | otherwise  = Just ((1 :. (map (/p) r)):.(), p)+      | otherwise  = Just ((1 :. map (/ p) r):.(), p)     {-# INLINE pivot1 #-} -instance +instance     ( Fractional a, NearZero a     , Map a a (a:.r) (a:.r)-    , ZipWith a a a (a:.r) (a:.r) (a:.r) +    , ZipWith a a a (a:.r) (a:.r) (a:.r)     , Map (a:.r) (a:.r) ((a:.r):.rs) ((a:.r):.rs)-    , Pivot1 a ((a:.r):.rs) -    ) => Pivot1 a ((a:.r):.(a:.r):.rs) +    , Pivot1 a ((a:.r):.rs)+    ) => Pivot1 a ((a:.r):.(a:.r):.rs)   where-    pivot1 (row@(p:._):.rows) +    pivot1 (row@(p:._):.rows)       | nearZero p = pivot1 rows >>= \(r:.rs,p)-> Just(r:.row:.rs,p)-      | otherwise  = Just ( first:.(map add rows) , p)+      | otherwise  = Just ( first :. map add rows , p)           where first        = map (/p) row-                add r@(x:._) = zipWith (-) r . map (*x) $ first +                add r@(x:._) = zipWith (-) r . map (*x) $ first     {-# INLINE pivot1 #-}  @@ -567,20 +577,20 @@   pivot _ = Nothing   {-# INLINE pivot #-} -instance +instance     ( Fractional a     , NearZero a-    , Pivot1 a rs +    , Pivot1 a rs     , Tail (a:.r) r-    , Map (a:.r) r ((a:.r):.rs) (r:.rs') +    , Map (a:.r) r ((a:.r):.rs) (r:.rs')     , Map r (a:.r) (r:.rs') ((a:.r):.rs)     , Pivot1 a ((a:.r):.rs)     , Pivot a (r:.rs')-    ) => Pivot a ((a:.r):.rs) +    ) => Pivot a ((a:.r):.rs)   where-    pivot m = -      mplus (pivot1 m) -            (pivot (map tail m) >>= return . mapFst (map (0:.)) )+    pivot m =+      mplus (pivot1 m)+            (liftM (mapFst (map (0 :.))) (pivot (map tail m)) )     {-# INLINE pivot #-}  @@ -595,19 +605,19 @@ class GaussElim a m | m -> a where   -- | @gaussElim m@ returns a pair @(m',d)@ where @m'@ is @m@ in row echelon   -- form and @d@ is the determinant of @m@. The determinant of @m'@ is 1 or 0,-  -- i.e., the leading coefficient of each non-zero row is 1.  -   +  -- i.e., the leading coefficient of each non-zero row is 1.+   gaussElim :: m -> (m,a)  instance (Num a, Pivot a (r:.())) => GaussElim a (r:.())   where-    gaussElim m = fromMaybe (m,1) (pivot m) +    gaussElim m = fromMaybe (m,1) (pivot m)     {-# INLINE gaussElim #-} -instance +instance     ( Fractional a     , Map (a:.r) r ((a:.r):.rs) rs_-    , Map r (a:.r) rs_ ((a:.r):.rs) +    , Map r (a:.r) rs_ ((a:.r):.rs)     , Pivot a ((a:.r):.(a:.r):.rs)     , GaussElim a rs_     ) => GaussElim a ((a:.r):.(a:.r):.rs)@@ -615,26 +625,26 @@     gaussElim m =       flip (maybe (m,1)) (pivot m) $ \(row:.rows,p) ->         case gaussElim (map tail rows)-          of (rows',p') -> ( row:.(map (0:.) rows') , p*p')+          of (rows',p') -> ( row :. map (0 :.) rows' , p*p')     {-# INLINE gaussElim #-}    class BackSubstitute m where   -- | backSubstitute takes a full rank matrix from row echelon form to reduced-  -- row echelon form. Returns @Nothing@ if the matrix is rank deficient. -  backSubstitute :: m -> Maybe m +  -- row echelon form. Returns @Nothing@ if the matrix is rank deficient.+  backSubstitute :: m -> Maybe m  instance NearZero a => BackSubstitute ((a:.r):.()) where-  backSubstitute r@((a:._):._) +  backSubstitute r@((a:._):._)     | nearZero (1-a) = Just r     | otherwise = Nothing   {-# INLINE backSubstitute #-} -instance +instance     ( Map (a:.r) r ((a:.r):.rs) rs_ --map tail     , Map r (a:.r) rs_ ((a:.r):.rs) --map cons-    , Fold aas (a,a:.r) +    , Fold aas (a,a:.r)     , ZipWith a a a (a:.r) (a:.r) (a:.r)     , Map a a (a:.r) (a:.r)     , ZipWith a (a:.r) (a,a:.r) r ((a:.r):.rs) aas@@ -642,11 +652,10 @@     , BackSubstitute rs_     ) => BackSubstitute ((a:.r):.(a:.r):.rs)   where-    backSubstitute m@(r@(rh:.rt):.rs) -      | nearZero (1-rh) = -          liftM (map (0:.)) (backSubstitute . map tail $ rs) >>= \rs' -> -            return . (:.rs') . foldl (\v (a,w) -> sub v a w) r $ -              zipWith (,) rt rs'+    backSubstitute m@(r@(rh:.rt):.rs)+      | nearZero (1-rh) =+          liftM (map (0:.)) (backSubstitute . map tail $ rs) >>= \rs' ->+            return . (:. rs') . foldl (\ v (a, w) -> sub v a w) r $ zipWith (,) rt rs'       | otherwise = Nothing -- rank deficient           where sub v a = zipWith (-) v . map (*a)     {-# INLINE backSubstitute #-}@@ -657,16 +666,16 @@ class BackSubstitute' m where   -- | backSubstitute' takes a full rank matrix from row echelon form to reduced   -- row echelon form. Returns garbage is matrix is rank deficient.-  backSubstitute' :: m -> m +  backSubstitute' :: m -> m  instance BackSubstitute' ((a:.r):.()) where   backSubstitute' = id   {-# INLINE backSubstitute' #-} -instance +instance     ( Map (a:.r) r ((a:.r):.rs) rs_ --map tail     , Map r (a:.r) rs_ ((a:.r):.rs) --map cons-    , Fold aas (a,a:.r) +    , Fold aas (a,a:.r)     , ZipWith a a a (a:.r) (a:.r) (a:.r)     , Map a a (a:.r) (a:.r)     , ZipWith a (a:.r) (a,a:.r) r ((a:.r):.rs) aas@@ -674,16 +683,15 @@     , BackSubstitute' rs_     ) => BackSubstitute' ((a:.r):.(a:.r):.rs)   where-    backSubstitute' (r@(_:.rt):.rs) = -      case map (0:.) (backSubstitute' . map tail $ rs) -        of rs' -> (:.rs') $ foldl (\ v (a,w) -> sub v a w) r -                              (zipWith (,) rt rs')+    backSubstitute' (r@(_:.rt):.rs) =+      case map (0:.) (backSubstitute' . map tail $ rs)+        of rs' -> (:.rs') $ foldl (\ v (a,w) -> sub v a w) r (zipWith (,) rt rs')       where sub v a = zipWith (-) v . map (*a)     {-# INLINE backSubstitute' #-}   -- | @invert m@ returns @Just@ the inverse of @m@ or @Nothing@ if @m@ is singular.-invert :: forall n a r m r' m'. +invert :: forall n a r m r' m'.   ( Num r, Num m   , Vec n a r     -- r is row type   , Vec n r m     -- m is matrix type@@ -695,15 +703,15 @@   , GaussElim a m'   , BackSubstitute m'   ) => m -> Maybe m-invert m = -  return i >>= backSubstitute . fst . gaussElim . zipWith append m -           >>= return . map dropn+invert m =+  liftM (map dropn)+  ((backSubstitute . fst . gaussElim . zipWith append m) i)   where dropn = drop (undefined::n)         i = identity :: m {-# INLINE invert #-}  -- | inverse and determinant. If det = 0, inverted matrix is garbage.-invertAndDet :: forall n a r m r' m'. +invertAndDet :: forall n a r m r' m'.   ( Num a, Num r, Num m   , Vec n a r     -- r is row type   , Vec n r m     -- m is matrix type@@ -715,19 +723,19 @@   , GaussElim a m'   , BackSubstitute m'   ) => m -> (m,a)-invertAndDet m = +invertAndDet m =   case backSubstitute rref of     Nothing -> (m,0)     Just m' -> ( map dropn m' , d )-  where +  where     (rref,d) = gaussElim . zipWith append m $ i     dropn = drop (undefined::n)     i = identity :: m {-# INLINE invertAndDet #-}  -- | Solution of linear system by Gaussian elimination. Returns @Nothing@--- if no solution. -solve :: forall n a v r m r' m'. +-- if no solution.+solve :: forall n a v r m r' m'.   ( Num r, Num m   , Vec n a r     -- r is row type   , Vec n r m     -- m is matrix type@@ -738,13 +746,118 @@   , GaussElim a m'   , BackSubstitute m'   ) => m -> r -> Maybe r-solve m v = -  return v >>= backSubstitute . fst . gaussElim . zipWith snoc m -           >>= return . map (head . drop (undefined::n)) +solve m v =+  liftM (map (head . drop (undefined :: n)))+  ((backSubstitute . fst . gaussElim . zipWith snoc m) v) {-# INLINE solve #-}   ++-- | A 4x4 translation matrix+translation :: Num a => Vec3 a -> Mat44 a+translation = flip translate identity++-- | A 4x4 rotation matrix for a rotation around the X axis+rotationX :: Floating a+          => a -- ^ The angle in radians+          -> Mat44 a+rotationX a  = matFromList [1, 0, 0, 0,+                            0, cos a, -sin a, 0,+                            0, sin a, cos a, 0,+                            0, 0, 0, 1]++-- | A 4x4 rotation matrix for a rotation around the Y axis+rotationY :: Floating a+          => a -- ^ The angle in radians+          -> Mat44 a+rotationY a  = matFromList [cos a, 0, sin a, 0,+                            0, 1, 0, 0,+                            -sin a, 0, cos a, 0,+                            0, 0, 0, 1]++-- | A 4x4 rotation matrix for a rotation around the Z axis+rotationZ :: Floating a+          => a -- ^ The angle in radians+          -> Mat44 a+rotationZ a  = matFromList [cos a, -sin a, 0, 0,+                            sin a, cos a, 0, 0,+                            0, 0, 1, 0,+                            0, 0, 0, 1]++-- | A 4x4 rotation matrix for a rotation around an arbitrary normalized vector+rotationVec :: Floating a+            => Vec3 a  -- ^ The normalized vector around which the rotation goes+            -> a  -- ^ The angle in radians+            -> Mat44 a+rotationVec (x:.y:.z:.()) a =+    matFromList [x^2+(1-x^2)*c, x*y*(1-c)-z*s, x*z*(1-c)+y*s, 0,+                 x*y*(1-c)+z*s, y^2+(1-y^2)*c, y*z*(1-c)-x*s, 0,+                 x*z*(1-c)-y*s, y*z*(1-c)+x*s, z^2+(1-z^2)*c, 0,+                 0, 0, 0, 1]+    where c = cos a+          s = sin a++-- | A 4x4 rotation matrix from the euler angles yaw pitch and roll. Could be useful in e.g.+--   first person shooter games,+rotationEuler :: Floating a+              => Vec3 a -- rotation around x, y and z respectively+              -> Mat44 a+rotationEuler (x:.y:.z:.()) = rotationZ z `multmm` rotationY y `multmm` rotationX x++-- | A 4x4 rotation matrix from a normalized quaternion. Useful for most free flying rotations, such as airplanes.+rotationQuat :: Num a+             => Vec4 a -- ^ The quaternion with the real part (w) last+             ->  Mat44 a+rotationQuat (x:.y:.z:.w:.()) =+    matFromList [1-2*y^2-2*z^2, 2*(x*y-z*w), 2*(x*z+y*w), 0,+                 2*(x*y+z*w), 1-2*x^2-2*z^2, 2*(y*z-x*w), 0,+                 2*(x*z-y*w), 2*(x*w+y*z), 1-2*x^2-2*y^2, 0,+                 0, 0, 0, 1]++-- | A 4x4 rotation matrix for turning toward a point. Useful for targeting a camera to a specific point.+rotationLookAt :: Floating a+               => Vec3 a -- ^ The up direction, not necessary unit length or perpendicular to the view vector+               -> Vec3 a -- ^ The viewers position+               -> Vec3 a -- ^ The point to look at+               -> Mat44 a+rotationLookAt up' pos target = transpose $ homVec left :. homVec up :. homVec forward :. homPoint 0 :. ()+    where+        forward = normalize $ pos - target+        left = normalize $ up' `cross` forward+        up = forward `cross`left++-- | A 4x4 scaling matrix+scaling :: Num a => Vec3 a -> Mat44 a+scaling = diagonal . homPoint++-- | A perspective projection matrix for a right handed coordinate system looking down negative z. This will project far plane to @z = +1@ and near plane to @z = -1@, i.e. into a left handed system.+perspective :: Floating a+            => a -- ^ Near plane clipping distance (always positive)+            -> a -- ^ Far plane clipping distance (always positive)+            -> a -- ^ Field of view of the y axis, in radians+            -> a -- ^ Aspect ratio, i.e. screen's width\/height+            -> Mat44 a+perspective n f fovy aspect = matFromList [2*n/(r-l), 0, -(r+l)/(r-l), 0,+                                           0, 2*n/(t-b), (t+b)/(t-b), 0,+                                           0, 0, -(f+n)/(f-n), -2*f*n/(f-n),+                                           0,0,-1,0]+    where+        t = n*tan(fovy/2)+        b = -t+        r = aspect*t+        l = -r++-- | An orthogonal projection matrix for a right handed coordinate system looking down negative z. This will project far plane to @z = +1@ and near plane to @z = -1@, i.e. into a left handed system.+orthogonal :: Fractional a+           => a -- ^ Near plane clipping distance+           -> a -- ^ Far plane clipping distance+           -> Vec2 a -- ^ The size of the view (center aligned around origo)+           -> Mat44 a+orthogonal n f (w:.h:.()) = matFromList [2/w, 0, 0, 0,+                                         0, 2/h, 0, 0,+                                         0, 0, 2/(f-n), -(f+n)/(f-n),+                                         0, 0, 0, 1]
Data/Vec/Packed.hs view
@@ -60,13 +60,13 @@ import Foreign  import Data.Array.Base  as Array-import GHC.ST		( ST(..), runST )+import GHC.ST        ( ST(..), runST ) import GHC.Prim import GHC.Base         ( Int(..) )-import GHC.Word		( Word(..) )-import GHC.Float	( Float(..), Double(..) )-import GHC.Int		( Int8(..),  Int16(..),  Int32(..),  Int64(..) )-import GHC.Word		( Word8(..), Word16(..), Word32(..), Word64(..) )+import GHC.Word        ( Word(..) )+import GHC.Float    ( Float(..), Double(..) )+import GHC.Int        ( Int8(..),  Int16(..),  Int32(..),  Int64(..) )+import GHC.Word        ( Word8(..), Word16(..), Word32(..), Word64(..) )   -- | PackedVec class : relates a vector type to its space-optimized@@ -89,21 +89,21 @@   instance PackedVec (Vec2 Bool) where-  data Packed (Vec2 Bool) = Vec2B {-#UNPACK#-} !Bool {-#UNPACK#-} !Bool+  data Packed (Vec2 Bool) = Vec2B !Bool !Bool   pack (a:.b:.()) = Vec2B a b   unpack (Vec2B a b) = a:.b:.()   {-# INLINE pack #-}   {-# INLINE unpack #-}  instance PackedVec (Vec3 Bool) where-  data Packed (Vec3 Bool) = Vec3B {-#UNPACK#-} !Bool {-#UNPACK#-} !Bool {-#UNPACK#-} !Bool+  data Packed (Vec3 Bool) = Vec3B !Bool !Bool !Bool   pack (a:.b:.c:.()) = Vec3B a b c   unpack (Vec3B a b c) = a:.b:.c:.()   {-# INLINE pack #-}   {-# INLINE unpack #-}  instance PackedVec (Vec4 Bool) where-  data Packed (Vec4 Bool) = Vec4B {-#UNPACK#-} !Bool {-#UNPACK#-} !Bool {-#UNPACK#-} !Bool {-#UNPACK#-} !Bool+  data Packed (Vec4 Bool) = Vec4B !Bool !Bool !Bool !Bool   pack (a:.b:.c:.d:.()) = Vec4B a b c d   unpack (Vec4B a b c d) = a:.b:.c:.d:.()   {-# INLINE pack #-}
Vec.cabal view
@@ -1,5 +1,5 @@ Name:                Vec-Version:             1.0+Version:             1.0.1 License:             BSD3 License-file:        LICENSE Author:              Scott E. Dillard