2 ( DoublePoint(..), Vector
3 , doublePointX, doublePointY
4 , intPointToDoublePoint
5 , doublePointToIntPoint
10 , subtractDoublePointVector
19 import Graphics.UI.WX(Point, point, pointX, pointY)
23 data DoublePoint = DoublePoint
24 { doublePointX :: !Double
25 , doublePointY :: !Double
27 deriving (Show, Eq, Read)
29 data DoublePoint = DoublePoint !Double !Double
30 deriving (Show, Eq, Read, Ord)
32 instance Parse DoublePoint where
33 parse = do { isWord "DoublePoint"
34 ; return DoublePoint `apply` parse `apply` parse
37 data Vector = Vector !Double !Double
39 doublePointX (DoublePoint x _) = x
40 doublePointY (DoublePoint _ y) = y
43 origin = DoublePoint 0 0
45 -- | Compute distance between two points
46 distancePointPoint :: DoublePoint -> DoublePoint -> Double
47 distancePointPoint (DoublePoint x0 y0) (DoublePoint x1 y1) =
48 sqrt (square (x0 - x1) + square (y0 - y1))
50 square :: Double -> Double
53 -- | Compute distance from a segment (as opposed to a line) to a point
54 -- Formulas taken from
55 -- <http://geometryalgorithms.com/Archive/algorithm_0102/algorithm_0102.htm>
56 distanceSegmentPoint :: DoublePoint -> DoublePoint -> DoublePoint -> Double
57 distanceSegmentPoint p0 p1 p =
58 let v = p1 `subtractDoublePointVector` p0
59 w = p `subtractDoublePointVector` p0
62 in if c1 <= 0 then distancePointPoint p p0
63 else if c2 <= c1 then distancePointPoint p p1
64 else distanceLinePoint p0 p1 p
66 -- | Compute distance from a line to a point
67 distanceLinePoint :: DoublePoint -> DoublePoint -> DoublePoint -> Double
68 distanceLinePoint (DoublePoint x0 y0) (DoublePoint x1 y1) (DoublePoint x y) =
69 abs ( ( (y0 - y1) * x + (x1 - x0) * y + (x0 * y1 - x1 * y0) ) /
70 sqrt (square (x1 - x0) + square (y1 - y0))
73 subtractDoublePointVector :: DoublePoint -> DoublePoint -> Vector
74 subtractDoublePointVector (DoublePoint x0 y0) (DoublePoint x1 y1) =
75 Vector (x0 - x1) (y0 - y1)
77 -- | Translate a point relative to a new origin
78 translate :: DoublePoint -> DoublePoint -> DoublePoint
79 translate (DoublePoint originX originY) (DoublePoint x y) =
80 DoublePoint (x+originX) (y+originY)
82 subtractDoublePoint :: DoublePoint -> DoublePoint -> DoublePoint
83 subtractDoublePoint (DoublePoint x0 y0) (DoublePoint x1 y1) =
84 DoublePoint (x0 - x1) (y0 - y1)
86 dotProduct :: Vector -> Vector -> Double
87 dotProduct (Vector v1 v2) (Vector w1 w2) = v1 * w1 + v2 * w2
89 translatePolar :: Double -> Double -> DoublePoint -> DoublePoint
90 translatePolar angle distance (DoublePoint x y) =
91 DoublePoint (x + cos angle * distance) (y + sin angle * distance)
93 doublePointToIntPoint :: DoublePoint -> Point
94 doublePointToIntPoint (DoublePoint x y) = point (round x) (round y)
96 intPointToDoublePoint :: Point -> DoublePoint
97 intPointToDoublePoint pt =
98 DoublePoint (fromIntegral (pointX pt)) (fromIntegral (pointY pt))
100 vectorAngle :: Vector -> Double
101 vectorAngle (Vector v1 v2) = atan2 v2 v1
103 vectorLength :: Vector -> Double
104 vectorLength (Vector v1 v2) = sqrt (square v1 + square v2)
106 enclosedInRectangle :: DoublePoint -> DoublePoint -> DoublePoint -> Bool
107 enclosedInRectangle (DoublePoint x y) (DoublePoint x0 y0) (DoublePoint x1 y1) =
108 between x x0 x1 && between y y0 y1
110 between i j k | j <= k = j <= i && i <= k
111 | otherwise = k <= i && i <= j
113 scale :: Double -> DoublePoint -> DoublePoint
114 scale f (DoublePoint x y) = DoublePoint (f * x) (f * y)