never executed always true always false
1 {-# LANGUAGE FlexibleInstances #-}
2 {-# OPTIONS_GHC -Wno-orphans #-}
3 {-|
4 Module : Reanimate.Math.Common
5 Copyright : Written by David Himmelstrup
6 License : Unlicense
7 Maintainer : lemmih@gmail.com
8 Stability : experimental
9 Portability : POSIX
10
11 Low-level primitives related to computational geometry.
12
13 -}
14 module Reanimate.Math.Common
15 ( -- * Ring
16 Ring(..)
17 , ringSize -- :: Ring a -> Int
18 , ringAccess -- :: Ring a -> Int -> V2 a
19 , ringClamp -- :: Ring a -> Int -> Int
20 , ringUnpack -- :: Ring a -> Vector (V2 a)
21 , ringPack -- :: Vector (V2 a) -> Ring a
22 , ringMap -- :: (V2 a -> V2 b) -> Ring a -> Ring b
23 , ringRayIntersect -- :: Ring Rational -> (Int, Int) -> (Int,Int) -> Maybe (V2 Rational)
24 -- * Math
25 , area -- :: Fractional a => V2 a -> V2 a -> V2 a -> a
26 , area2X -- :: Fractional a => V2 a -> V2 a -> V2 a -> a
27 , isLeftTurn -- :: (Num a, Ord a) => V2 a -> V2 a -> V2 a -> Bool
28 , isLeftTurnOrLinear -- :: (Num a, Ord a) => V2 a -> V2 a -> V2 a -> Bool
29 , isRightTurn -- :: (Num a, Ord a) => V2 a -> V2 a -> V2 a -> Bool
30 , isRightTurnOrLinear -- :: (Num a, Ord a) => V2 a -> V2 a -> V2 a -> Bool
31 , direction -- :: Num a => V2 a -> V2 a -> V2 a -> a
32 , isInside -- :: (Fractional a, Ord a) => V2 a -> V2 a -> V2 a -> V2 a -> Bool
33 , isInsideStrict -- :: (Fractional a, Ord a) => V2 a -> V2 a -> V2 a -> V2 a -> Bool
34 , barycentricCoords -- :: Fractional a => V2 a -> V2 a -> V2 a -> V2 a -> (a, a, a)
35 , rayIntersect -- :: (Fractional a, Ord a) => (V2 a,V2 a) -> (V2 a,V2 a) -> Maybe (V2 a)
36 , isBetween -- :: (Ord a, Fractional a) => V2 a -> (V2 a, V2 a) -> Bool
37 , lineIntersect -- :: (Ord a, Fractional a) => (V2 a, V2 a) -> (V2 a, V2 a) -> Maybe (V2 a)
38 , distSquared -- :: (Fractional a) => V2 a -> V2 a -> a
39 , approxDist -- :: (Real a, Fractional a) => V2 a -> V2 a -> a
40 , distance' -- :: (Real a, Fractional a) => V2 a -> V2 a -> Double
41 , triangleAngles -- :: V2 Double -> V2 Double -> V2 Double -> (Double, Double, Double)
42 , Epsilon(..)
43 ) where
44
45 import Data.Vector (Vector)
46 import qualified Data.Vector as V
47 import Linear.Matrix (det33)
48 import Linear.Metric
49 import Linear.V2
50 import Linear.V3
51 import Linear.Vector
52 import Linear.Epsilon
53
54 instance Epsilon Rational where
55 nearZero r = r==0
56
57 -- | Circular collection of pairs.
58 newtype Ring a = Ring (Vector (V2 a))
59
60 -- | Number of elements in the ring.
61 ringSize :: Ring a -> Int
62 ringSize (Ring v) = length v
63
64 -- | Safe method for accessing elements in the ring.
65 ringAccess :: Ring a -> Int -> V2 a
66 ringAccess (Ring v) i = v V.! mod i (length v)
67
68 -- | Clamp index to within the usable range for the ring.
69 ringClamp :: Ring a -> Int -> Int
70 ringClamp (Ring v) i = mod i (length v)
71
72 -- | Convert ring to a vector.
73 ringUnpack :: Ring a -> Vector (V2 a)
74 ringUnpack (Ring v) = v
75
76 -- | Convert vector to a ring.
77 ringPack :: Vector (V2 a) -> Ring a
78 ringPack = Ring
79
80 -- | Map each element of a ring.
81 ringMap :: (V2 a -> V2 b) -> Ring a -> Ring b
82 ringMap fn (Ring v) = Ring (V.map fn v)
83
84 -- | Compute the intersection of two pairs of nodes in the ring.
85 ringRayIntersect :: Ring Rational -> (Int, Int) -> (Int,Int) -> Maybe (V2 Rational)
86 ringRayIntersect p (a,b) (c,d) =
87 rayIntersect (ringAccess p a, ringAccess p b) (ringAccess p c, ringAccess p d)
88
89 -- | Compute area of triangle.
90 area :: Fractional a => V2 a -> V2 a -> V2 a -> a
91 area a b c = 1/2 * area2X a b c
92
93 -- | Compute 2x area of triangle. This avoids a division.
94 area2X :: Fractional a => V2 a -> V2 a -> V2 a -> a
95 area2X (V2 a1 a2) (V2 b1 b2) (V2 c1 c2) =
96 det33 (V3 (V3 a1 a2 1)
97 (V3 b1 b2 1)
98 (V3 c1 c2 1))
99
100 compareEpsZero :: (Ord a, Fractional a, Epsilon a) => a -> Ordering
101 compareEpsZero val
102 | nearZero val = EQ
103 | otherwise = compare val 0
104
105 {-# INLINE isLeftTurn #-}
106 -- | Return @True@ iff the line from @p1@ to @p2@ makes a left-turn to @p3@.
107 isLeftTurn :: (Fractional a, Ord a, Epsilon a) => V2 a -> V2 a -> V2 a -> Bool
108 isLeftTurn p1 p2 p3 =
109 case compareEpsZero (direction p1 p2 p3) of
110 LT -> True
111 EQ -> False -- colinear
112 GT -> False
113
114 {-# INLINE isLeftTurnOrLinear #-}
115 -- | Return @True@ iff the line from @p1@ to @p2@ does not make a right-turn to @p3@.
116 isLeftTurnOrLinear :: (Fractional a, Ord a, Epsilon a) => V2 a -> V2 a -> V2 a -> Bool
117 isLeftTurnOrLinear p1 p2 p3 =
118 case compareEpsZero (direction p1 p2 p3) of
119 LT -> True
120 EQ -> True -- colinear
121 GT -> False
122
123 {-# INLINE isRightTurn #-}
124 -- | Return @True@ iff the line from @p1@ to @p2@ makes a right-turn to @p3@.
125 isRightTurn :: (Fractional a, Ord a, Epsilon a) => V2 a -> V2 a -> V2 a -> Bool
126 isRightTurn a b c = not (isLeftTurnOrLinear a b c)
127
128 {-# INLINE isRightTurnOrLinear #-}
129 -- | Return @True@ iff the line from @p1@ to @p2@ does not make a left-turn to @p3@.
130 isRightTurnOrLinear :: (Fractional a, Ord a, Epsilon a) => V2 a -> V2 a -> V2 a -> Bool
131 isRightTurnOrLinear a b c = not (isLeftTurn a b c)
132
133 {-# INLINE direction #-}
134 -- | Compute the change in direction in a line between the three points.
135 direction :: Num a => V2 a -> V2 a -> V2 a -> a
136 direction p1 p2 p3 = crossZ (p3-p1) (p2-p1)
137
138 {-# INLINE isInside #-}
139 -- | Returns @True@ if the fourth argument is inside the triangle or
140 -- on the border.
141 isInside :: (Fractional a, Ord a) => V2 a -> V2 a -> V2 a -> V2 a -> Bool
142 isInside a b c d =
143 s >= 0 && s <= 1 && t >= 0 && t <= 1 && i >= 0 && i <= 1
144 where
145 (s, t, i) = barycentricCoords a b c d
146
147 {-# INLINE isInsideStrict #-}
148 -- | Returns @True@ iff the fourth argument is inside the triangle.
149 isInsideStrict :: (Fractional a, Ord a) => V2 a -> V2 a -> V2 a -> V2 a -> Bool
150 isInsideStrict a b c d =
151 s > 0 && s < 1 && t > 0 && t < 1 && i > 0 && i < 1
152 where
153 (s, t, i) = barycentricCoords a b c d
154
155 {-# INLINE barycentricCoords #-}
156 -- | Compute relative coordinates inside the triangle. Invariant: @a+b+c=1@
157 barycentricCoords :: Fractional a => V2 a -> V2 a -> V2 a -> V2 a -> (a, a, a)
158 barycentricCoords (V2 x1 y1) (V2 x2 y2) (V2 x3 y3) (V2 x y) =
159 (lam1, lam2, lam3)
160 where
161 lam1 = ((y2-y3)*(x-x3) + (x3 - x2)*(y-y3)) /
162 ((y2-y3)*(x1-x3) + (x3-x2)*(y1-y3))
163 lam2 = ((y3-y1)*(x-x3) + (x1-x3)*(y-y3)) /
164 ((y2-y3)*(x1-x3) + (x3-x2)*(y1-y3))
165 lam3 = 1 - lam1 - lam2
166
167
168 {-# INLINE rayIntersect #-}
169 -- | Compute intersection of two infinite lines.
170 rayIntersect :: (Fractional a, Ord a) => (V2 a,V2 a) -> (V2 a,V2 a) -> Maybe (V2 a)
171 rayIntersect (V2 x1 y1,V2 x2 y2) (V2 x3 y3, V2 x4 y4)
172 | yBot == 0 = Nothing
173 | otherwise = Just $
174 V2 (xTop/xBot) (yTop/yBot)
175 where
176 xTop = (x1*y2 - y1*x2)*(x3-x4) - (x1 - x2)*(x3*y4-y3*x4)
177 xBot = (x1-x2)*(y3-y4)-(y1-y2)*(x3-x4)
178 yTop = (x1*y2 - y1*x2)*(y3-y4) - (y1-y2)*(x3*y4-y3*x4)
179 yBot = (x1-x2)*(y3-y4) - (y1-y2)*(x3-x4)
180
181 {-# INLINE isBetween #-}
182 -- | Returns @True@ iff a point is on a line segment.
183 isBetween :: (Ord a, Fractional a) => V2 a -> (V2 a, V2 a) -> Bool
184 isBetween (V2 x y) (V2 x1 y1, V2 x2 y2) =
185 ((y1 > y) /= (y2 > y) || y == y1 || y == y2) && -- y is between y1 and y2
186 ((x1 > x) /= (x2 > x) || x == x1 || x == x2)
187
188 {-# INLINE lineIntersect #-}
189 -- | Compute intersection of two line segments.
190 lineIntersect :: (Ord a, Fractional a) => (V2 a, V2 a) -> (V2 a, V2 a) -> Maybe (V2 a)
191 lineIntersect a b =
192 case rayIntersect a b of
193 Just u
194 | isBetween u a && isBetween u b -> Just u
195 _ -> Nothing
196
197 -- circleIntersect :: (Ord a, Fractional a) => (V2 a, V2 a) -> (V2 a, V2 a) -> [V2 a]
198
199 -- | Compute the square of the distance between two points.
200 distSquared :: (Num a) => V2 a -> V2 a -> a
201 distSquared a b = quadrance (a ^-^ b)
202
203 -- | Approximate the distance between two points.
204 approxDist :: (Real a, Fractional a) => V2 a -> V2 a -> a
205 approxDist a b = realToFrac (sqrt (realToFrac (distSquared a b) :: Double))
206
207 -- | Approximate the distance between two points.
208 distance' :: (Real a, Fractional a) => V2 a -> V2 a -> Double
209 distance' a b = sqrt (realToFrac (distSquared a b))
210
211 -- sum of angles is always pi.
212 -- | Approximate the angles of a triangle.
213 triangleAngles :: V2 Double -> V2 Double -> V2 Double -> (Double, Double, Double)
214 triangleAngles a b c =
215 (findAngle (b-a) (c-a)
216 ,findAngle (c-b) (a-b)
217 ,findAngle (a-c) (b-c))
218 where
219 findAngle v1 v2 = abs (atan2 (crossZ v1 v2) (dot v1 v2))
220 -- findAngle v1 v2 = acos (dot v1 v2 / (norm v1 * norm v2))