```{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, FlexibleContexts
, UndecidableInstances, TypeOperators
, TypeFamilies, TypeSynonymInstances
#-}
{-# OPTIONS_GHC -Wall -fno-warn-orphans #-}
----------------------------------------------------------------------
-- |
-- Module      :  Vector3
-- Copyright   :  (c) Conal Elliott and Andy J Gill 2008
-- License     :  BSD3
--
-- Maintainer  :  conal@conal.net, andygill@ku.edu
-- Stability   :  experimental
--
-- Vectors in 3D.  Uses the OpenGL 'Vector3' type, for convenience and
-- efficiency.
----------------------------------------------------------------------

module Graphics.FieldTrip.Vector3
(
Vector3(..)
, xVector3, yVector3, zVector3
, vector3x, vector3y, vector3z
, vector3Spherical
, vector3SphericalCoords
, vector3D, unvector3D, cross3
) where

import Control.Applicative

import Graphics.Rendering.OpenGL (Vector3(..))

import Data.VectorSpace
import Data.MemoTrie
import Data.Basis
import Data.Derivative
import Data.Cross

import Graphics.FieldTrip.Vector2

-- type V3 = Vector3 Double

-- | The unit vector in the positive X direction.
xVector3 :: Num s => Vector3 s
xVector3 = Vector3 1 0 0

-- | The unit vector in the positive Y direction.
yVector3 :: Num s => Vector3 s
yVector3 = Vector3 0 1 0

-- | The unit vector in the positive Z direction.
zVector3 :: Num s => Vector3 s
zVector3 = Vector3 0 0 1

vector3x, vector3y, vector3z :: Vector3 s -> s
vector3x (Vector3 x _ _) = x
vector3y (Vector3 _ y _) = y
vector3z (Vector3 _ _ z) = z

-- vector3RectCoords :: Vector3 -> (R,R,R)
-- vector3RectCoords (Vector3 x y z) = (x,y,z)

-- | Vector from spherical coordinates.  See also 'vector2SphericalCoords'.
vector3Spherical :: Floating s => s -> s -> s -> Vector3 s
vector3Spherical rho theta phi =
Vector3 (rho * sinPhi * cosTheta)
(rho * sinPhi * sinTheta)
(rho * cosPhi)
where
cosTheta = cos theta; cosPhi = cos phi
sinTheta = sin theta; sinPhi = sin phi

-- | Spherical coordinates of a vector.  See also 'vector2Spherical'.
vector3SphericalCoords :: (InnerSpace s s, Floating s) => Vector3 s -> (s,s,s)
vector3SphericalCoords v@(Vector3 x y z) = (rho, theta, phi)
where
rho   = magnitude v
theta = atan (y/x)  -- in case (==) is not defined, as in (a:>b)
-- if x == 0 then 0 else atan (y/x)
phi   = acos (z / rho)

instance Functor Vector3 where
fmap f (Vector3 x y z) = Vector3 (f x) (f y) (f z)

instance Applicative Vector3 where
pure x = Vector3 x x x
Vector3 f g h <*> Vector3 x y z = Vector3 (f x) (g y) (h z)

instance AdditiveGroup u => AdditiveGroup (Vector3 u) where
zeroV                   = Vector3 zeroV zeroV zeroV
Vector3 u v w ^+^ Vector3 u' v' w'
= Vector3 (u^+^u') (v^+^v') (w^+^w')
negateV (Vector3 u v w) = Vector3 (negateV u) (negateV v) (negateV w)

instance VectorSpace u s => VectorSpace (Vector3 u) s where
s *^ Vector3 u v w    = Vector3 (s*^u) (s*^v) (s*^w)

instance (InnerSpace u s, AdditiveGroup s)
=> InnerSpace (Vector3 u) s where
Vector3 u v w <.> Vector3 u' v' w' = u<.>u' ^+^ v<.>v' ^+^ w<.>w'

instance HasBasis u s => HasBasis (Vector3 u) s where
type Basis (Vector3 u) = Basis (u,u,u)
basisValue             = toV3 . basisValue
decompose              = decompose  . fromV3
decompose'             = decompose' . fromV3

toV3 :: (u,u,u) -> Vector3 u
toV3 (u,v,w) = Vector3 u v w

fromV3 :: Vector3 u -> (u,u,u)
fromV3 (Vector3 u v w) = (u,v,w)

instance ( Num s, VectorSpace s s
, HasBasis s s, HasTrie (Basis s), Basis s ~ () )
=> HasNormal (Vector2 s :> Vector3 s) where
normalVec v = d (Left ()) `cross3` d (Right ())
where
d = untrie (derivative v)

-- Above doesn't seem to work in ghc 6.8.  So use explicit instances for
-- 'Float' & 'Double'.  Revisit.

-- instance HasNormal (Vector2 Float :> Vector3 Float) where
--   normalVec v = d (Left ()) `cross3` d (Right ())
--    where
--      d = untrie (derivative v)

-- instance HasNormal (Vector2 Double :> Vector3 Double) where
--   normalVec v = d (Left ()) `cross3` d (Right ())
--    where
--      d = untrie (derivative v)

instance Num s => HasCross3 (Vector3 s) where
Vector3 ax ay az `cross3` Vector3 bx by bz =
Vector3 (ay * bz - az * by)
(az * bx - ax * bz)
(ax * by - ay * bx)

-- instance (Num s, VectorSpace s s) => HasCross (Vector3 (Vector2 s :> s)) where
--   cross = unvector3F . cross . vector3F

-- vector3F :: (Applicative f) => Vector3 (f s) -> f (Vector3 s)
-- vector3F (Vector3 u v w) = liftA3 Vector3 u v w

-- unvector3F :: (Functor f) => f (Vector3 s) -> Vector3 (f s)
-- unvector3F d = Vector3 (vector3x <\$> d) (vector3y <\$> d) (vector3z <\$> d)

-- instance (Num s, LMapDom s s) => HasNormal (Three (Vector2 s :> s)) where
--   normalVec = unvector3D . normalVec . vector3D

-- instance ( Num s, VectorSpace s s, HasBasis s s, HasTrie (Basis s)
--          , HasNormal (Vector2 s :> Vector3 s)
--          , HasBasis (Vector2 s) s, HasTrie (Basis (Vector2 s)))
--          => HasNormal (Vector3 (Vector2 s :> s)) where
--   normalVec v = d (Left ()) `cross3` d (Right ())
--    where
--      d = untrie (derivative v)

-- instance (Num s, VectorSpace s s, HasBasis s s, HasTrie (Basis s)) =>
--          HasNormal (Three (Vector2 s :> s)) where
--   normalVec = unvector3D . normalVec . vector3D

-- sigh.  try the instance above when we're on ghc-6.9

instance HasNormal (Three (Vector2 Float :> Float)) where
normalVec = unvector3D . normalVec . vector3D

instance HasNormal (Three (Vector2 Double :> Double)) where
normalVec = unvector3D . normalVec . vector3D

vector3D :: (VectorSpace s s, HasTrie (Basis a)) =>
Three (a :> s) -> a :> (Vector3 s)
vector3D (u,v,w) = liftD3 Vector3 u v w

unvector3D :: (VectorSpace s s, HasTrie (Basis a)) =>
a :> (Vector3 s) -> Three (a :> s)
unvector3D d = (vector3x <\$>> d, vector3y <\$>> d, vector3z <\$>> d)
```