93 lines
2.5 KiB
Haskell
93 lines
2.5 KiB
Haskell
{-# 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)
|