module Geom2D where
infixl 6 ^+^, ^-^
infixl 7 *^, ^*, ^/
infixr 5 $*
data Point = Point {
pointX :: !Double,
pointY :: !Double}
instance Show Point where
show (Point x y) =
"Point " ++ show x ++ " " ++ show y
data Transform = Transform {
xformA :: !Double,
xformB :: !Double,
xformC :: !Double,
xformD :: !Double,
xformE :: !Double,
xformF :: !Double }
deriving Show
data Line = Line Point Point
data Polygon = Polygon [Point]
class AffineTransform a where
transform :: Transform -> a -> a
instance AffineTransform Transform where
transform (Transform a' b' c' d' e' f') (Transform a b c d e f) =
Transform (a*a'+b'*d) (a'*b + b'*e) (a'*c+b'*f +c')
(d'*a+e'*d) (d'*b+e'*e) (d'*c+e'*f+f')
instance AffineTransform Point where
transform (Transform a b c d e f) (Point x y) =
Point (a*x + b*y + c) (d*x + e*y + f)
instance AffineTransform Polygon where
transform t (Polygon p) = Polygon $ map (transform t) p
($*) :: AffineTransform a => Transform -> a -> a
t $* p = transform t p
inverse :: Transform -> Maybe Transform
inverse (Transform a b c d e f) = case a*e b*d of
0 -> Nothing
det -> Just $! Transform (a/det) (d/det) ((a*c + d*f)/det) (b/det) (e/det)
((b*c + e*f)/det)
lineEquation :: Line -> (Double, Double, Double)
lineEquation (Line (Point x1 y1) (Point x2 y2)) = (a, b, c)
where a = a' / d
b = b' / d
c = (y1*b' + x1*a') / d
a' = y1 y2
b' = x2 x1
d = sqrt(a'*a' + b'*b')
lineDistance :: Line -> Point -> Double
lineDistance l = \(Point x y) -> a*x + b*y + c
where (a, b, c) = lineEquation l
vectorMag :: Point -> Double
vectorMag (Point x y) = sqrt(x*x + y*y)
vectorAngle :: Point -> Double
vectorAngle (Point 0.0 0.0) = 0.0
vectorAngle (Point x y) = atan2 y x
dirVector :: Double -> Point
dirVector angle = Point (cos angle) (sin angle)
normVector :: Point -> Point
normVector p@(Point x y) = Point (x/l) (y/l)
where l = vectorMag p
(*^) :: Double -> Point -> Point
s *^ (Point x y) = Point (s*x) (s*y)
(^/) :: Point -> Double -> Point
(Point x y) ^/ s = Point (x/s) (y/s)
(^*) :: Point -> Double -> Point
p ^* s = s *^ p
(^+^) :: Point -> Point -> Point
(Point x1 y1) ^+^ (Point x2 y2) = Point (x1+x2) (y1+y2)
(^-^) :: Point -> Point -> Point
(Point x1 y1) ^-^ (Point x2 y2) = Point (x1x2) (y1y2)
(^.^) :: Point -> Point -> Double
(Point x1 y1) ^.^ (Point x2 y2) = x1*x2 + y1*y2
vectorCross :: Point -> Point -> Double
vectorCross (Point x1 y1) (Point x2 y2) = x1*y2 y1*x2
vectorDistance :: Point -> Point -> Double
vectorDistance p q = vectorMag (p^-^q)
interpolateVector :: Point -> Point -> Double -> Point
interpolateVector a b t = t*^b ^+^ (1t)*^a
rotateVec :: Point -> Transform
rotateVec v = Transform x (y) 0 y x 0
where Point x y = normVector v
rotate :: Double -> Transform
rotate a = Transform (cos a) (negate $ sin a) 0
(sin a) (cos a) 0
rotate90L :: Transform
rotate90L = rotateVec (Point 0 1)
rotate90R :: Transform
rotate90R = rotateVec (Point 0 (1))
translate :: Point -> Transform
translate (Point x y) = Transform 1 0 x 0 1 y