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
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
|
{-# 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)
|
