geometry/Queries.hs

58 lines
1.5 KiB
Haskell

module Queries where
import Test.QuickCheck.Arbitrary
data Point a = Point
{ xCoord :: a
, yCoord :: a
}
deriving(Eq, Ord, Show)
instance Arbitrary a => Arbitrary (Point a) where
arbitrary = Point <$> arbitrary <*> arbitrary
makesRightTurn :: (Ord a, Num a) => Point a -> Point a -> Point a -> Bool
makesRightTurn (Point x1 y1) (Point x2 y2) (Point x3 y3) =
let crossProduct = (x2 - x1)*(y3-y1) - (x3 - x1)*(y2 - y1)
in crossProduct > 0
squaredDistance :: Num a => Point a -> Point a -> a
squaredDistance (Point x1 y1) (Point x2 y2) = (x2 - x1)*(x2 - x1) + (y2 - y1)*(y2 - y1)
data Line a = Line
{ p1 :: Point a
, p2 :: Point a
}
deriving(Eq, Show)
data OpenCircle a = OpenCircle
{ center :: Point a
, radius :: a
}
deriving(Eq, Show)
pointInCircle :: (Ord a, Num a) => Point a -> OpenCircle a -> Bool
pointInCircle p (OpenCircle c r) = (squaredDistance p c) < (r * r)
lineCircleIntersect :: (Ord a, Num a) => OpenCircle a -> Line a -> Bool
lineCircleIntersect c (Line p1 p2) =
pointInCircle p1 c || pointInCircle p2 c
type Path a = [Line a]
pathToLines :: [Point a] -> [Line a]
pathToLines [] = []
pathToLines [_] = []
pathToLines (p1:p2:ps) = Line p1 p2 : pathToLines (p2:ps)
pathFromPoints :: [Point a] -> Path a
pathFromPoints = pathToLines
removeCircleFromPath :: (Ord a, Num a) => OpenCircle a -> Path a -> Path a
removeCircleFromPath c lines = filter (not . lineCircleIntersect c) lines