{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

{- |

Module      :  Data.VectorSpace.OpenGL
Copyright   :  (c) Adam C. Foltzer 2011
License     :  BSD3

Maintainer  :  acfoltzer@gmail.com
Stability   :  experimental
Portability :  portable

Instances of 'AdditiveGroup', 'VectorSpace', 'InnerSpace',
'HasCross2', 'HasCross3', and 'AffineSpace' from
<http://hackage.haskell.org/package/vector-space> for a selection of
the 'Graphics.Rendering.OpenGL' types.

-}

module Data.VectorSpace.OpenGL where

import Control.Applicative
import qualified Data.Foldable as F

import Data.AffineSpace
import Data.Cross
import Data.VectorSpace

import Graphics.Rendering.OpenGL

--------------------------------------------------------------------------------
-- Vector instances

-- Vector1

instance (AdditiveGroup a) => AdditiveGroup (Vector1 a) where
  zeroV = pure zeroV
  x ^+^ y = (^+^) <$> x <*> y
  negateV = (negateV <$>)

instance (VectorSpace a) => VectorSpace (Vector1 a) where
  type Scalar (Vector1 a) = Scalar a
  s *^ x = (s *^) <$> x

instance (InnerSpace a, AdditiveGroup (Scalar a)) => InnerSpace (Vector1 a) where
  x <.> y = F.foldl1 (^+^) ((<.>) <$> x <*> y)

instance (AffineSpace a) => AffineSpace (Vector1 a) where
  type Diff (Vector1 a) = Vector1 (Diff a)
  x .-. y = (.-.) <$> x <*> y
  x .+^ y = (.+^) <$> x <*> y

-- Vector2

instance (AdditiveGroup a) => AdditiveGroup (Vector2 a) where
  zeroV = pure zeroV
  x ^+^ y = (^+^) <$> x <*> y
  negateV = (negateV <$>)

instance (VectorSpace a) => VectorSpace (Vector2 a) where
  type Scalar (Vector2 a) = Scalar a
  s *^ x = (s *^) <$> x

instance (InnerSpace a, AdditiveGroup (Scalar a))
    => InnerSpace (Vector2 a) where
  x <.> y = F.foldl1 (^+^) ((<.>) <$> x <*> y)

instance (AdditiveGroup a) => HasCross2 (Vector2 a) where
  cross2 (Vector2 x y) = Vector2 (negateV y) x

instance (AffineSpace a) => AffineSpace (Vector2 a) where
  type Diff (Vector2 a) = Vector2 (Diff a)
  x .-. y = (.-.) <$> x <*> y
  x .+^ y = (.+^) <$> x <*> y

-- Vector3

instance (AdditiveGroup a) => AdditiveGroup (Vector3 a) where
  zeroV = pure zeroV
  x ^+^ y = (^+^) <$> x <*> y
  negateV = (negateV <$>)

instance (VectorSpace a) => VectorSpace (Vector3 a) where
  type Scalar (Vector3 a) = Scalar a
  s *^ x = (s *^) <$> x

instance (InnerSpace a, AdditiveGroup (Scalar a))
    => InnerSpace (Vector3 a) where
  x <.> y = F.foldl1 (^+^) ((<.>) <$> x <*> y)

instance (Num a) => HasCross3 (Vector3 a) where
  (Vector3 x y z) `cross3` (Vector3 x' y' z') = Vector3 (y * z' - z * y')
                                                        (z * x' - x * z')
                                                        (x * y' - y * x')

instance (AffineSpace a) => AffineSpace (Vector3 a) where
  type Diff (Vector3 a) = Vector3 (Diff a)
  x .-. y = (.-.) <$> x <*> y
  x .+^ y = (.+^) <$> x <*> y

-- Vector4

instance (AdditiveGroup a) => AdditiveGroup (Vector4 a) where
  zeroV = pure zeroV
  x ^+^ y = (^+^) <$> x <*> y
  negateV = (negateV <$>)

instance (VectorSpace a) => VectorSpace (Vector4 a) where
  type Scalar (Vector4 a) = Scalar a
  s *^ x = (s *^) <$> x

instance (InnerSpace a, AdditiveGroup (Scalar a))
    => InnerSpace (Vector4 a) where
  x <.> y = F.foldl1 (^+^) ((<.>) <$> x <*> y)

instance (AffineSpace a) => AffineSpace (Vector4 a) where
  type Diff (Vector4 a) = Vector4 (Diff a)
  x .-. y = (.-.) <$> x <*> y
  x .+^ y = (.+^) <$> x <*> y

--------------------------------------------------------------------------------
-- Vertex instances

-- Vertex1

instance (AdditiveGroup a) => AdditiveGroup (Vertex1 a) where
  zeroV = pure zeroV
  x ^+^ y = (^+^) <$> x <*> y
  negateV = (negateV <$>)

instance (VectorSpace a) => VectorSpace (Vertex1 a) where
  type Scalar (Vertex1 a) = Scalar a
  s *^ x = (s *^) <$> x

instance (InnerSpace a, AdditiveGroup (Scalar a)) => InnerSpace (Vertex1 a) where
  x <.> y = F.foldl1 (^+^) ((<.>) <$> x <*> y)

instance (AffineSpace a) => AffineSpace (Vertex1 a) where
  type Diff (Vertex1 a) = Vertex1 (Diff a)
  x .-. y = (.-.) <$> x <*> y
  x .+^ y = (.+^) <$> x <*> y

-- Vertex2

instance (AdditiveGroup a) => AdditiveGroup (Vertex2 a) where
  zeroV = pure zeroV
  x ^+^ y = (^+^) <$> x <*> y
  negateV = (negateV <$>)

instance (VectorSpace a) => VectorSpace (Vertex2 a) where
  type Scalar (Vertex2 a) = Scalar a
  s *^ x = (s *^) <$> x

instance (InnerSpace a, AdditiveGroup (Scalar a))
    => InnerSpace (Vertex2 a) where
  x <.> y = F.foldl1 (^+^) ((<.>) <$> x <*> y)

instance (AdditiveGroup a) => HasCross2 (Vertex2 a) where
  cross2 (Vertex2 x y) = Vertex2 (negateV y) x

instance (AffineSpace a) => AffineSpace (Vertex2 a) where
  type Diff (Vertex2 a) = Vertex2 (Diff a)
  x .-. y = (.-.) <$> x <*> y
  x .+^ y = (.+^) <$> x <*> y

-- Vertex3

instance (AdditiveGroup a) => AdditiveGroup (Vertex3 a) where
  zeroV = pure zeroV
  x ^+^ y = (^+^) <$> x <*> y
  negateV = (negateV <$>)

instance (VectorSpace a) => VectorSpace (Vertex3 a) where
  type Scalar (Vertex3 a) = Scalar a
  s *^ x = (s *^) <$> x

instance (InnerSpace a, AdditiveGroup (Scalar a))
    => InnerSpace (Vertex3 a) where
  x <.> y = F.foldl1 (^+^) ((<.>) <$> x <*> y)

instance (Num a) => HasCross3 (Vertex3 a) where
  (Vertex3 x y z) `cross3` (Vertex3 x' y' z') = Vertex3 (y * z' - z * y')
                                                        (z * x' - x * z')
                                                        (x * y' - y * x')

instance (AffineSpace a) => AffineSpace (Vertex3 a) where
  type Diff (Vertex3 a) = Vertex3 (Diff a)
  x .-. y = (.-.) <$> x <*> y
  x .+^ y = (.+^) <$> x <*> y

-- Vertex4

instance (AdditiveGroup a) => AdditiveGroup (Vertex4 a) where
  zeroV = pure zeroV
  x ^+^ y = (^+^) <$> x <*> y
  negateV = (negateV <$>)

instance (VectorSpace a) => VectorSpace (Vertex4 a) where
  type Scalar (Vertex4 a) = Scalar a
  s *^ x = (s *^) <$> x

instance (InnerSpace a, AdditiveGroup (Scalar a))
    => InnerSpace (Vertex4 a) where
  x <.> y = F.foldl1 (^+^) ((<.>) <$> x <*> y)

instance (AffineSpace a) => AffineSpace (Vertex4 a) where
  type Diff (Vertex4 a) = Vertex4 (Diff a)
  x .-. y = (.-.) <$> x <*> y
  x .+^ y = (.+^) <$> x <*> y

--------------------------------------------------------------------------------
-- Color instances

-- Color3

instance (AdditiveGroup a) => AdditiveGroup (Color3 a) where
  zeroV = pure zeroV
  x ^+^ y = (^+^) <$> x <*> y
  negateV = (negateV <$>)

instance (VectorSpace a) => VectorSpace (Color3 a) where
  type Scalar (Color3 a) = Scalar a
  s *^ x = (s *^) <$> x

instance (InnerSpace a, AdditiveGroup (Scalar a))
    => InnerSpace (Color3 a) where
  x <.> y = F.foldl1 (^+^) ((<.>) <$> x <*> y)

instance (Num a) => HasCross3 (Color3 a) where
  (Color3 x y z) `cross3` (Color3 x' y' z') = Color3 (y * z' - z * y')
                                                        (z * x' - x * z')
                                                        (x * y' - y * x')

instance (AffineSpace a) => AffineSpace (Color3 a) where
  type Diff (Color3 a) = Color3 (Diff a)
  x .-. y = (.-.) <$> x <*> y
  x .+^ y = (.+^) <$> x <*> y

-- Color4

instance (AdditiveGroup a) => AdditiveGroup (Color4 a) where
  zeroV = pure zeroV
  x ^+^ y = (^+^) <$> x <*> y
  negateV = (negateV <$>)

instance (VectorSpace a) => VectorSpace (Color4 a) where
  type Scalar (Color4 a) = Scalar a
  s *^ x = (s *^) <$> x

instance (InnerSpace a, AdditiveGroup (Scalar a))
    => InnerSpace (Color4 a) where
  x <.> y = F.foldl1 (^+^) ((<.>) <$> x <*> y)

instance (AffineSpace a) => AffineSpace (Color4 a) where
  type Diff (Color4 a) = Color4 (Diff a)
  x .-. y = (.-.) <$> x <*> y
  x .+^ y = (.+^) <$> x <*> y

--------------------------------------------------------------------------------
-- TexCoord instances

-- TexCoord1

instance (AdditiveGroup a) => AdditiveGroup (TexCoord1 a) where
  zeroV = pure zeroV
  x ^+^ y = (^+^) <$> x <*> y
  negateV = (negateV <$>)

instance (VectorSpace a) => VectorSpace (TexCoord1 a) where
  type Scalar (TexCoord1 a) = Scalar a
  s *^ x = (s *^) <$> x

instance (InnerSpace a, AdditiveGroup (Scalar a)) => InnerSpace (TexCoord1 a) where
  x <.> y = F.foldl1 (^+^) ((<.>) <$> x <*> y)

instance (AffineSpace a) => AffineSpace (TexCoord1 a) where
  type Diff (TexCoord1 a) = TexCoord1 (Diff a)
  x .-. y = (.-.) <$> x <*> y
  x .+^ y = (.+^) <$> x <*> y

-- TexCoord2

instance (AdditiveGroup a) => AdditiveGroup (TexCoord2 a) where
  zeroV = pure zeroV
  x ^+^ y = (^+^) <$> x <*> y
  negateV = (negateV <$>)

instance (VectorSpace a) => VectorSpace (TexCoord2 a) where
  type Scalar (TexCoord2 a) = Scalar a
  s *^ x = (s *^) <$> x

instance (InnerSpace a, AdditiveGroup (Scalar a))
    => InnerSpace (TexCoord2 a) where
  x <.> y = F.foldl1 (^+^) ((<.>) <$> x <*> y)

instance (AdditiveGroup a) => HasCross2 (TexCoord2 a) where
  cross2 (TexCoord2 x y) = TexCoord2 (negateV y) x

instance (AffineSpace a) => AffineSpace (TexCoord2 a) where
  type Diff (TexCoord2 a) = TexCoord2 (Diff a)
  x .-. y = (.-.) <$> x <*> y
  x .+^ y = (.+^) <$> x <*> y

-- TexCoord3

instance (AdditiveGroup a) => AdditiveGroup (TexCoord3 a) where
  zeroV = pure zeroV
  x ^+^ y = (^+^) <$> x <*> y
  negateV = (negateV <$>)

instance (VectorSpace a) => VectorSpace (TexCoord3 a) where
  type Scalar (TexCoord3 a) = Scalar a
  s *^ x = (s *^) <$> x

instance (InnerSpace a, AdditiveGroup (Scalar a))
    => InnerSpace (TexCoord3 a) where
  x <.> y = F.foldl1 (^+^) ((<.>) <$> x <*> y)

instance (Num a) => HasCross3 (TexCoord3 a) where
  (TexCoord3 x y z) `cross3` (TexCoord3 x' y' z') = TexCoord3 (y * z' - z * y')
                                                        (z * x' - x * z')
                                                        (x * y' - y * x')

instance (AffineSpace a) => AffineSpace (TexCoord3 a) where
  type Diff (TexCoord3 a) = TexCoord3 (Diff a)
  x .-. y = (.-.) <$> x <*> y
  x .+^ y = (.+^) <$> x <*> y

-- TexCoord4

instance (AdditiveGroup a) => AdditiveGroup (TexCoord4 a) where
  zeroV = pure zeroV
  x ^+^ y = (^+^) <$> x <*> y
  negateV = (negateV <$>)

instance (VectorSpace a) => VectorSpace (TexCoord4 a) where
  type Scalar (TexCoord4 a) = Scalar a
  s *^ x = (s *^) <$> x

instance (InnerSpace a, AdditiveGroup (Scalar a))
    => InnerSpace (TexCoord4 a) where
  x <.> y = F.foldl1 (^+^) ((<.>) <$> x <*> y)

instance (AffineSpace a) => AffineSpace (TexCoord4 a) where
  type Diff (TexCoord4 a) = TexCoord4 (Diff a)
  x .-. y = (.-.) <$> x <*> y
  x .+^ y = (.+^) <$> x <*> y

--------------------------------------------------------------------------------
-- Normal3 instance

instance (AdditiveGroup a) => AdditiveGroup (Normal3 a) where
  zeroV = pure zeroV
  x ^+^ y = (^+^) <$> x <*> y
  negateV = (negateV <$>)

instance (VectorSpace a) => VectorSpace (Normal3 a) where
  type Scalar (Normal3 a) = Scalar a
  s *^ x = (s *^) <$> x

instance (InnerSpace a, AdditiveGroup (Scalar a))
    => InnerSpace (Normal3 a) where
  x <.> y = F.foldl1 (^+^) ((<.>) <$> x <*> y)

instance (Num a) => HasCross3 (Normal3 a) where
  (Normal3 x y z) `cross3` (Normal3 x' y' z') = Normal3 (y * z' - z * y')
                                                        (z * x' - x * z')
                                                        (x * y' - y * x')

instance (AffineSpace a) => AffineSpace (Normal3 a) where
  type Diff (Normal3 a) = Normal3 (Diff a)
  x .-. y = (.-.) <$> x <*> y
  x .+^ y = (.+^) <$> x <*> y