This repository has been archived on 2025-03-03. You can view files and clone it, but cannot push or open issues or pull requests.
htanks/src/Vector.hs

59 lines
1.6 KiB
Haskell

{-# 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)