1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
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)
|
