{-# LANGUAGE TypeFamilies #-}

module Vector ( Vertex(..)
              , Vector(..)
              , toAngle
              , translateV
              , translateV'
              , rotateV
              , rotateV'
              , 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
  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
  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
  s *^ Vector x y = Vector (s*x) (s*y)

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

toAngle :: Vector -> Coord
toAngle (Vector x y) = atan2 y x

translateV :: Vector -> Transform
translateV (Vector x y) = translate x y

translateV' :: Vector -> Transform
translateV' = translateV . negateV

rotateV :: Vector -> Transform
rotateV (Vector c s) = linear $ \(x, y, w) -> (c*x - s*y, s*x + c*y, w)

rotateV' :: Vector -> Transform
rotateV' (Vector c s) = rotateV $ Vector c (-s)

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