{-# LANGUAGE TypeFamilies #-}

module Vector ( Coord
              , Transformable(..)
              , Transform(..)
              , ReversibleTransform(..)
              , Vertex(..)
              , Vector(..)
              , Rotation
              , zeroV
              , (^+^)
              , negateV
              , (><)
              , toAngle
              , fromAngle
              , toVector
              , fromVector
              , diffV
              ) where

import Transformable

import Data.AdditiveGroup
import Data.VectorSpace
import Data.LinearMap

data Vertex = Vertex { vertexX :: Coord, vertexY :: Coord } deriving (Show, Eq)
instance Transformable Vertex where
  transform t (Vertex x y) = Vertex x' y'
    where
      (x', y', _) = t >< (x, y, 1) :: Vector3

data Vector = Vector { vectorX :: Coord, vectorY :: Coord } deriving (Show, Eq)

instance Transformable Vector where
  transform t (Vector x y) = Vector x' y'
    where
      (x', y', _) = t >< (x, y, 0) :: Vector3

instance AdditiveGroup Vector where
  zeroV = Vector 0 0
  Vector x1 y1 ^+^ Vector x2 y2 = Vector (x1+x2) (y1+y2)
  negateV (Vector x y) = Vector (-x) (-y)

instance VectorSpace Vector where
  type Scalar Vector = Coord
  r *^ Vector x y = Vector (r*x) (r*y)

instance InnerSpace Vector where
  Vector x1 y1 <.> Vector x2 y2 = x1*x2 + y1*y2

instance Transform Vector where
  toMap (Vector dx dy) = linear $ \(x, y, w) -> (x+w*dx, y+w*dy, w)

instance ReversibleTransform Vector where
  toMap' = toMap . negateV

data Rotation = Rotation { rotC :: Coord, rotS :: Coord } deriving (Show, Eq)

instance Transformable Rotation where
  transform t (Rotation c s) = Rotation (c'/l) (s'/l)
    where
      (c', s', _) = t >< (c, s, 0) :: Vector3
      l = sqrt $ c'^2 + s'^2

instance AdditiveGroup Rotation where
  zeroV = Rotation 1 0
  Rotation c1 s1 ^+^ Rotation c2 s2 = Rotation (c1*c2 - s1*s2) (s1*c2 + c1*s2)
  negateV (Rotation c s) = Rotation (-c) s

instance Transform Rotation where
  toMap (Rotation c s) = linear $ \(x, y, w) -> (c*x - s*y, s*x + c*y, w)

instance ReversibleTransform Rotation where
  toMap' = toMap . negateV


toAngle :: Rotation -> Coord
toAngle (Rotation c s) = atan2 s c

fromAngle :: Coord -> Rotation
fromAngle a = Rotation (cos a) (sin a)

toVector :: Coord -> Rotation -> Vector
toVector l (Rotation c s) = l *^ Vector c s

fromVector :: Vector -> (Rotation, Coord)
fromVector v = (Rotation x y, magnitude v)
  where
    Vector x y = normalized v

diffV :: Vertex -> Vertex -> Vector
diffV (Vertex x1 y1) (Vertex x2 y2) = Vector (x2-x1) (y2-y1)