Vector2.hs

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

module Graphics.FieldTrip.Vector2 
  (
   Vector2(..), vector2x, vector2y
  , xVector2, yVector2
  , vector2Polar
  , vector2PolarCoords
  , vector2D, unvector2D
  ) where

import Control.Applicative

import Graphics.Rendering.OpenGL.GL.CoordTrans (Vector2(..))

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

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

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

vector2x, vector2y :: Vector2 s -> s
vector2x (Vector2 x _) = x
vector2y (Vector2 _ y) = y

-- | Vector from polar coordinates.  See also 'vector2PolarCoords'.
vector2Polar :: Floating s => s -> s -> Vector2 s
vector2Polar rho theta = Vector2 (rho * cos theta) (rho * sin theta)

-- | Polar coordinates of a vector.  See also 'vector2Polar'.
vector2PolarCoords :: (InnerSpace s s, Floating s) => Vector2 s -> (s,s)
vector2PolarCoords v@(Vector2 x y) = (rho, theta)
 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)


instance Functor Vector2 where
  fmap f (Vector2 x y)          = Vector2 (f x) (f y)

instance Applicative Vector2 where
  pure x                        = Vector2 x x
  Vector2 f g <*> Vector2 x y   = Vector2 (f x) (g y)


-- TODO: is UndecidableInstances still necessary?

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

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

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

instance HasBasis u s => HasBasis (Vector2 u) s where
  type Basis (Vector2 u) = Basis (u,u)
  basisValue             = toV2 . basisValue
  decompose              = decompose  . fromV2
  decompose'             = decompose' . fromV2

toV2 :: (u,u) -> Vector2 u
toV2 (u,v) = Vector2 u v

fromV2 :: Vector2 u -> (u,u)
fromV2 (Vector2 u v) = (u,v)


instance Num s => HasCross2 (Vector2 s) where
  cross2 (Vector2 x y) = Vector2 (-y) x  -- or @Vector2 (-y) x@?


-- instance (Num s, LMapDom s s) => HasNormal (s :> Vector2 s) where
--   normalVec v = cross2 (derivativeAt v 1)

instance HasNormal (Float :> Vector2 Float) where
  normalVec v = cross2 (derivative v `untrie` ())

-- instance HasNormal (One Double :> Two Double) where
--   normalVec v = cross2 (derivative v `untrie` ())



vector2D :: (HasBasis a s, HasTrie (Basis a), VectorSpace s s) =>
            Two (a :> s) -> a :> (Vector2 s)
vector2D (u,v) = liftD2 Vector2 u v

unvector2D :: (HasBasis a s, HasTrie (Basis a), VectorSpace s s) =>
              a :> (Vector2 s) -> Two (a :> s)
unvector2D d = (vector2x <$>> d, vector2y <$>> d)