{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeSynonymInstances #-}
module Data.Vec3.Class
( Vec3(..)
, TVec3
)
where
import Prelude hiding (zipWith)
import Test.QuickCheck (Arbitrary(..))
class Vec3 v where
data Matrix v
origin :: v
origin = fromXYZ (0, 0, 0)
{-# INLINE origin #-}
fromXYZ :: (Double, Double, Double) -> v
toXYZ :: v -> (Double, Double, Double)
zipWith :: (Double -> Double -> Double) -> v -> v -> v
zipWith f v1 v2 = fromXYZ (f x1 x2, f y1 y2, f z1 z2)
where
(x1, y1, z1) = toXYZ v1
(x2, y2, z2) = toXYZ v2
{-# INLINE zipWith #-}
(<+>) :: v -> v -> v
(<+>) = zipWith (+)
{-# INLINE (<+>) #-}
(<->) :: v -> v -> v
(<->) = zipWith (-)
{-# INLINE (<->) #-}
(><) :: v -> v -> v
(><) v1 v2 = fromXYZ (y1 * z2 - y2 * z1,
x2 * z1 - x1 * z2,
x1 * y2 - x2 * y1)
where
(x1, y1, z1) = toXYZ v1
(x2, y2, z2) = toXYZ v2
(.^) :: v -> Double -> v
(.^) v s = fromXYZ (x * s, y * s, z * s)
where
(x, y, z) = toXYZ v
(.*) :: v -> v -> Double
(.*) v1 v2 = x + y + z
where
(x, y, z) = toXYZ $ zipWith (*) v1 v2
norm :: v -> Double
norm v = sqrt (v .* v)
{-# INLINE norm #-}
normalize :: v -> v
normalize v = v .^ (1 / norm v)
{-# INLINE normalize #-}
distance :: v -> v -> Double
distance v1 v2 = norm (v1 <-> v2)
{-# INLINE distance #-}
invert :: v -> v
invert v = origin <-> v
{-# INLINE invert #-}
fromRows :: (v, v, v) -> Matrix v
toRows :: Matrix v -> (v, v, v)
dotM :: v -> v -> Matrix v -> Double
dotM v1 v2 m = v1 .* (m `mxv` v2)
{-# INLINE dotM #-}
mxv :: Matrix v -> v -> v
mxv m v = fromXYZ (r1 .* v, r2 .* v, r3 .* v)
where
(r1, r2, r3) = toRows m
{-# INLINE mxv #-}
diag :: Double -> Matrix v
diag d = fromRows
(fromXYZ (d, 0, 0),
fromXYZ (0, d, 0),
fromXYZ (0, 0, d))
{-# INLINE diag #-}
vxv :: v -> v -> Matrix v
vxv v1 v2 = fromRows (v2 .^ v11, v2 .^ v12, v2 .^ v13)
where
(v11, v12, v13) = toXYZ v1
{-# INLINE vxv #-}
addM :: Matrix v -> Matrix v -> Matrix v
addM m1 m2 = fromRows (r11 <+> r21,
r12 <+> r22,
r13 <+> r23)
where
(r11, r12, r13) = toRows m1
(r21, r22, r23) = toRows m2
{-# INLINE addM #-}
type TVec3 = (Double, Double, Double)
instance Vec3 TVec3 where
newtype Matrix TVec3 = TMatrix { unTMatrix :: (TVec3, TVec3, TVec3) }
deriving (Arbitrary, Eq, Show)
fromXYZ = id
toXYZ = id
fromRows = TMatrix
toRows = unTMatrix