1 files changed, 94 insertions, 56 deletions

diff --git a/Spear/Math/Vector/Vector3.hs b/Spear/Math/Vector/Vector3.hs
index 82deba2..9d44c8b 100644
--- a/Spear/Math/Vector/Vector3.hs
+++ b/Spear/Math/Vector/Vector3.hs
@@ -1,3 +1,7 @@
+{-# LANGUAGE MultiParamTypeClasses #-}

+{-# LANGUAGE NoImplicitPrelude     #-}

+{-# LANGUAGE TypeFamilies          #-}

+

 module Spear.Math.Vector.Vector3

 (

     Vector3(..)

@@ -5,6 +9,7 @@ module Spear.Math.Vector.Vector3
 ,   Up3

 ,   Forward3

 ,   Position3

+,   sizeVector3

     -- * Construction

 ,   unitx3

 ,   unity3

@@ -17,15 +22,17 @@ module Spear.Math.Vector.Vector3
 )

 where

 

-

+import           Spear.Math.Algebra

 import           Spear.Math.Vector.Vector

+import           Spear.Prelude

 

 import           Foreign.C.Types          (CFloat)

 import           Foreign.Storable

+import qualified Prelude                  as P

 

-type Right3 = Vector3

-type Up3 = Vector3

-type Forward3 = Vector3

+type Right3    = Vector3

+type Up3       = Vector3

+type Forward3  = Vector3

 type Position3 = Vector3

 

 

@@ -36,17 +43,58 @@ data Vector3 = Vector3
     {-# UNPACK #-} !Float

     deriving (Eq, Show)

 

-instance Num Vector3 where

+

+sizeVector3 = (3::Int) * sizeOf (undefined :: CFloat)

+

+

+instance Addition Vector3 Vector3 where

+    {-# INLINABLE (+) #-}

     Vector3 ax ay az + Vector3 bx by bz = Vector3 (ax + bx) (ay + by) (az + bz)

+

+

+instance Subtraction Vector3 Vector3 where

+    {-# INLINABLE (-) #-}

     Vector3 ax ay az - Vector3 bx by bz = Vector3 (ax - bx) (ay - by) (az - bz)

+

+

+instance Product Vector3 Vector3 Vector3 where

+    {-# INLINABLE (*) #-}

     Vector3 ax ay az * Vector3 bx by bz = Vector3 (ax * bx) (ay * by) (az * bz)

+

+

+instance Quotient Vector3 Vector3 where

+    {-# INLINABLE (/) #-}

+    Vector3 ax ay az / Vector3 bx by bz = Vector3 (ax / bx) (ay / by) (az / bz)

+

+

+-- Scalar product.

+instance Product Vector3 Float Vector3 where

+    {-# INLINABLE (*) #-}

+    (Vector3 x y z) * s = Vector3 (s * x) (s * y) (s * z)

+

+

+instance Product Float Vector3 Vector3 where

+    {-# INLINABLE (*) #-}

+    s * (Vector3 x y z) = Vector3 (s * x) (s * y) (s * z)

+

+

+-- Scalar division.

+instance Quotient Vector3 Float where

+    {-# INLINABLE (/) #-}

+    (Vector3 x y z) / s = Vector3 (x / s) (y / s) (y / s)

+

+

+instance Num Vector3 where

+    (+) = add

+    (-) = sub

+    (*) = mul

     abs (Vector3 ax ay az) = Vector3 (abs ax) (abs ay) (abs az)

     signum (Vector3 ax ay az) = Vector3 (signum ax) (signum ay) (signum az)

     fromInteger i = Vector3 i' i' i' where i' = fromInteger i

 

 

 instance Fractional Vector3 where

-    Vector3 ax ay az / Vector3 bx by bz = Vector3 (ax / bx) (ay / by) (az / bz)

+    (/) = Spear.Math.Algebra.div

     fromRational r = Vector3 r' r' r' where r' = fromRational r

 

 

@@ -71,91 +119,85 @@ instance Ord Vector3 where
         || (ax == bx && ay > by)

         || (ax == bx && ay == by && az > bz)

 

-    max (Vector3 ax ay az) (Vector3 bx by bz) = Vector3 (Prelude.max ax bx) (Prelude.max ay by) (Prelude.max az bz)

+    max (Vector3 ax ay az) (Vector3 bx by bz) =

+        Vector3 (max ax bx) (max ay by) (max az bz)

 

-    min (Vector3 ax ay az) (Vector3 bx by bz) = Vector3 (Prelude.min ax bx) (Prelude.min ay by) (Prelude.min az bz)

+    min (Vector3 ax ay az) (Vector3 bx by bz) =

+        Vector3 (min ax bx) (min ay by) (min az bz)

 

 

 instance Vector Vector3 where

-         {-# INLINABLE fromList #-}

-         fromList (ax:ay:az:_) = Vector3 ax ay az

-

-         {-# INLINABLE x #-}

-         x (Vector3 ax _  _ ) = ax

+    {-# INLINABLE fromList #-}

+    fromList (ax:ay:az:_) = Vector3 ax ay az

 

-         {-# INLINABLE y #-}

-         y (Vector3 _  ay _ ) = ay

+    {-# INLINABLE x #-}

+    x (Vector3 ax _  _ ) = ax

 

-         {-# INLINABLE z #-}

-         z (Vector3 _  _  az) = az

+    {-# INLINABLE y #-}

+    y (Vector3 _  ay _ ) = ay

 

-         {-# INLINABLE (!) #-}

-         (Vector3 ax _ _) ! 0 = ax

-         (Vector3 _ ay _) ! 1 = ay

-         (Vector3 _ _ az) ! 2 = az

-         _                ! _ = 0

+    {-# INLINABLE z #-}

+    z (Vector3 _  _  az) = az

 

-         {-# INLINABLE dot #-}

-         Vector3 ax ay az `dot` Vector3 bx by bz = ax*bx + ay*by + az*bz

+    {-# INLINABLE (!) #-}

+    (Vector3 ax _ _) ! 0 = ax

+    (Vector3 _ ay _) ! 1 = ay

+    (Vector3 _ _ az) ! 2 = az

+    _                ! _ = 0

 

-         {-# INLINABLE normSq #-}

-         normSq (Vector3 ax ay az) = ax*ax + ay*ay + az*az

+    {-# INLINABLE dot #-}

+    Vector3 ax ay az `dot` Vector3 bx by bz = ax*bx + ay*by + az*bz

 

-         {-# INLINABLE norm #-}

-         norm = sqrt . normSq

+    {-# INLINABLE normSq #-}

+    normSq (Vector3 ax ay az) = ax*ax + ay*ay + az*az

 

-         {-# INLINABLE scale #-}

-         scale s (Vector3 ax ay az) = Vector3 (s*ax) (s*ay) (s*az)

+    {-# INLINABLE norm #-}

+    norm = sqrt . normSq

 

-         {-# INLINABLE neg #-}

-         neg (Vector3 ax ay az) = Vector3 (-ax) (-ay) (-az)

+    {-# INLINABLE neg #-}

+    neg (Vector3 ax ay az) = Vector3 (-ax) (-ay) (-az)

 

-         {-# INLINABLE normalise #-}

-         normalise v =

-                   let n' = norm v

-                       n = if n' == 0 then 1 else n'

-                   in scale (1.0 / n) v

+    {-# INLINABLE normalise #-}

+    normalise v =

+            let n' = norm v

+                n = if n' == 0 then 1 else n'

+            in ((1.0::Float) / n) * v

 

 

 sizeFloat = sizeOf (undefined :: CFloat)

 

 

 instance Storable Vector3 where

-    sizeOf _    = 3*sizeFloat

+    sizeOf _    = (3::Int) * sizeFloat

     alignment _ = alignment (undefined :: CFloat)

 

     peek ptr = do

         ax <- peekByteOff ptr 0

-        ay <- peekByteOff ptr $ 1*sizeFloat

-        az <- peekByteOff ptr $ 2*sizeFloat

+        ay <- peekByteOff ptr $ (1::Int) * sizeFloat

+        az <- peekByteOff ptr $ (2::Int) * sizeFloat

         return (Vector3 ax ay az)

 

     poke ptr (Vector3 ax ay az) = do

         pokeByteOff ptr 0 ax

-        pokeByteOff ptr (1*sizeFloat) ay

-        pokeByteOff ptr (2*sizeFloat) az

+        pokeByteOff ptr ((1::Int) * sizeFloat) ay

+        pokeByteOff ptr ((2::Int) * sizeFloat) az

 

 

 -- | Unit vector along the X axis.

 unitx3 = Vector3 1 0 0

 

-

 -- | Unit vector along the Y axis.

 unity3 = Vector3 0 1 0

 

-

 -- | Unit vector along the Z axis.

 unitz3 = Vector3 0 0 1

 

-

 -- | Zero vector.

 zero3 = Vector3 0 0 0

 

-

 -- | Create a 3D vector from the given values.

 vec3 :: Float -> Float -> Float -> Vector3

-vec3 ax ay az = Vector3 ax ay az

-

+vec3 = Vector3

 

 -- | Create a 3D vector as a point on a sphere.

 orbit :: Vector3 -- ^ Sphere center.

@@ -163,21 +205,17 @@ orbit :: Vector3 -- ^ Sphere center.
       -> Float -- ^ Azimuth angle.

       -> Float -- ^ Zenith angle.

       -> Vector3

-

 orbit center radius anglex angley =

-    let ax = anglex * pi / 180

-        ay = angley * pi / 180

-        sx = sin ax

-        sy = sin ay

-        cx = cos ax

-        cy = cos ay

+    let sx = sin anglex

+        sy = sin angley

+        cx = cos anglex

+        cy = cos angley

         px = x center + radius*cy*sx

         py = y center + radius*sy

         pz = z center + radius*cx*cy

     in

         vec3 px py pz

 

-

 -- | Compute the given vectors' cross product.

 cross :: Vector3 -> Vector3 -> Vector3

 (Vector3 ax ay az) `cross` (Vector3 bx by bz) =