1 files changed, 59 insertions, 0 deletions
diff --git a/src/Vector.hs b/src/Vector.hs
new file mode 100644
index 0000000..847be58
--- /dev/null
+++ b/src/Vector.hs
@@ -0,0 +1,59 @@
+{-# 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)