never executed always true always false
1 module Reanimate.Math.Common
2 ( -- * Ring
3 Ring(..)
4 , ringSize -- :: Ring a -> Int
5 , ringAccess -- :: Ring a -> Int -> V2 a
6 , ringClamp -- :: Ring a -> Int -> Int
7 , ringUnpack -- :: Ring a -> Vector (V2 a)
8 , ringPack -- :: Vector (V2 a) -> Ring a
9 , ringMap -- :: (V2 a -> V2 b) -> Ring a -> Ring b
10 , ringRayIntersect -- :: Ring Rational -> (Int, Int) -> (Int,Int) -> Maybe (V2 Rational)
11 -- * Math
12 , area -- :: Fractional a => V2 a -> V2 a -> V2 a -> a
13 , area2X -- :: Fractional a => V2 a -> V2 a -> V2 a -> a
14 , epsilon -- :: Fractional a => a
15 , epsEq -- :: (Ord a, Fractional a) => a -> a -> Bool
16 , isLeftTurn -- :: (Num a, Ord a) => V2 a -> V2 a -> V2 a -> Bool
17 , isLeftTurnOrLinear -- :: (Num a, Ord a) => V2 a -> V2 a -> V2 a -> Bool
18 , isRightTurn -- :: (Num a, Ord a) => V2 a -> V2 a -> V2 a -> Bool
19 , isRightTurnOrLinear -- :: (Num a, Ord a) => V2 a -> V2 a -> V2 a -> Bool
20 , direction -- :: Num a => V2 a -> V2 a -> V2 a -> a
21 , isInside -- :: (Fractional a, Ord a) => V2 a -> V2 a -> V2 a -> V2 a -> Bool
22 , isInsideStrict -- :: (Fractional a, Ord a) => V2 a -> V2 a -> V2 a -> V2 a -> Bool
23 , barycentricCoords -- :: Fractional a => V2 a -> V2 a -> V2 a -> V2 a -> (a, a, a)
24 , rayIntersect -- :: (Fractional a, Ord a) => (V2 a,V2 a) -> (V2 a,V2 a) -> Maybe (V2 a)
25 , isBetween -- :: (Ord a, Fractional a) => V2 a -> (V2 a, V2 a) -> Bool
26 , lineIntersect -- :: (Ord a, Fractional a) => (V2 a, V2 a) -> (V2 a, V2 a) -> Maybe (V2 a)
27 , distSquared -- :: (Fractional a) => V2 a -> V2 a -> a
28 , approxDist -- :: (Real a, Fractional a) => V2 a -> V2 a -> a
29 , distance' -- :: (Real a, Fractional a) => V2 a -> V2 a -> Double
30 , triangleAngles -- :: V2 Double -> V2 Double -> V2 Double -> (Double, Double, Double)
31 ) where
32
33 import Data.Vector (Vector)
34 import qualified Data.Vector as V
35 import Linear.Matrix (det33)
36 import Linear.Metric
37 import Linear.V2
38 import Linear.V3
39 import Linear.Vector
40
41 newtype Ring a = Ring (Vector (V2 a))
42
43 ringSize :: Ring a -> Int
44 ringSize (Ring v) = length v
45
46 ringAccess :: Ring a -> Int -> V2 a
47 ringAccess (Ring v) i = v V.! mod i (length v)
48
49 ringClamp :: Ring a -> Int -> Int
50 ringClamp (Ring v) i = mod i (length v)
51
52 ringUnpack :: Ring a -> Vector (V2 a)
53 ringUnpack (Ring v) = v
54
55 ringPack :: Vector (V2 a) -> Ring a
56 ringPack = Ring
57
58 ringMap :: (V2 a -> V2 b) -> Ring a -> Ring b
59 ringMap fn (Ring v) = Ring (V.map fn v)
60
61 ringRayIntersect :: Ring Rational -> (Int, Int) -> (Int,Int) -> Maybe (V2 Rational)
62 ringRayIntersect p (a,b) (c,d) =
63 rayIntersect (ringAccess p a, ringAccess p b) (ringAccess p c, ringAccess p d)
64
65
66 area :: Fractional a => V2 a -> V2 a -> V2 a -> a
67 area a b c = 1/2 * area2X a b c
68
69 area2X :: Fractional a => V2 a -> V2 a -> V2 a -> a
70 area2X (V2 a1 a2) (V2 b1 b2) (V2 c1 c2) =
71 det33 (V3 (V3 a1 a2 1)
72 (V3 b1 b2 1)
73 (V3 c1 c2 1))
74
75 epsilon :: Fractional a => a
76 epsilon = 1e-13
77
78 epsEq :: (Ord a, Fractional a) => a -> a -> Bool
79 epsEq a b = abs (a-b) < epsilon
80
81 compareEpsZero :: (Ord a, Fractional a) => a -> Ordering
82 compareEpsZero val
83 | abs val < epsilon = EQ
84 | otherwise = compare val 0
85
86 {-# INLINE isLeftTurn #-}
87 -- Left turn.
88 isLeftTurn :: (Fractional a, Ord a) => V2 a -> V2 a -> V2 a -> Bool
89 isLeftTurn p1 p2 p3 =
90 case compareEpsZero (direction p1 p2 p3) of
91 LT -> True
92 EQ -> False -- colinear
93 GT -> False
94
95 {-# INLINE isLeftTurnOrLinear #-}
96 isLeftTurnOrLinear :: (Fractional a, Ord a) => V2 a -> V2 a -> V2 a -> Bool
97 isLeftTurnOrLinear p1 p2 p3 =
98 case compareEpsZero (direction p1 p2 p3) of
99 LT -> True
100 EQ -> True -- colinear
101 GT -> False
102
103 {-# INLINE isRightTurn #-}
104 isRightTurn :: (Fractional a, Ord a) => V2 a -> V2 a -> V2 a -> Bool
105 isRightTurn a b c = not (isLeftTurnOrLinear a b c)
106
107 {-# INLINE isRightTurnOrLinear #-}
108 isRightTurnOrLinear :: (Fractional a, Ord a) => V2 a -> V2 a -> V2 a -> Bool
109 isRightTurnOrLinear a b c = not (isLeftTurn a b c)
110
111 {-# INLINE direction #-}
112 direction :: Num a => V2 a -> V2 a -> V2 a -> a
113 direction p1 p2 p3 = crossZ (p3-p1) (p2-p1)
114
115 {-# INLINE isInside #-}
116 isInside :: (Fractional a, Ord a) => V2 a -> V2 a -> V2 a -> V2 a -> Bool
117 isInside a b c d =
118 s >= 0 && s <= 1 && t >= 0 && t <= 1 && i >= 0 && i <= 1
119 where
120 (s, t, i) = barycentricCoords a b c d
121
122 {-# INLINE isInsideStrict #-}
123 isInsideStrict :: (Fractional a, Ord a) => V2 a -> V2 a -> V2 a -> V2 a -> Bool
124 isInsideStrict a b c d =
125 s > 0 && s < 1 && t > 0 && t < 1 && i > 0 && i < 1
126 where
127 (s, t, i) = barycentricCoords a b c d
128
129 {-# INLINE barycentricCoords #-}
130 barycentricCoords :: Fractional a => V2 a -> V2 a -> V2 a -> V2 a -> (a, a, a)
131 barycentricCoords (V2 x1 y1) (V2 x2 y2) (V2 x3 y3) (V2 x y) =
132 (lam1, lam2, lam3)
133 where
134 lam1 = ((y2-y3)*(x-x3) + (x3 - x2)*(y-y3)) /
135 ((y2-y3)*(x1-x3) + (x3-x2)*(y1-y3))
136 lam2 = ((y3-y1)*(x-x3) + (x1-x3)*(y-y3)) /
137 ((y2-y3)*(x1-x3) + (x3-x2)*(y1-y3))
138 lam3 = 1 - lam1 - lam2
139
140
141 {-# INLINE rayIntersect #-}
142 rayIntersect :: (Fractional a, Ord a) => (V2 a,V2 a) -> (V2 a,V2 a) -> Maybe (V2 a)
143 rayIntersect (V2 x1 y1,V2 x2 y2) (V2 x3 y3, V2 x4 y4)
144 | yBot == 0 = Nothing
145 | otherwise = Just $
146 V2 (xTop/xBot) (yTop/yBot)
147 where
148 xTop = (x1*y2 - y1*x2)*(x3-x4) - (x1 - x2)*(x3*y4-y3*x4)
149 xBot = (x1-x2)*(y3-y4)-(y1-y2)*(x3-x4)
150 yTop = (x1*y2 - y1*x2)*(y3-y4) - (y1-y2)*(x3*y4-y3*x4)
151 yBot = (x1-x2)*(y3-y4) - (y1-y2)*(x3-x4)
152
153 {-# INLINE isBetween #-}
154 isBetween :: (Ord a, Fractional a) => V2 a -> (V2 a, V2 a) -> Bool
155 isBetween (V2 x y) (V2 x1 y1, V2 x2 y2) =
156 ((y1 > y) /= (y2 > y) || y == y1 || y == y2) && -- y is between y1 and y2
157 ((x1 > x) /= (x2 > x) || x == x1 || x == x2)
158
159 {-# INLINE lineIntersect #-}
160 lineIntersect :: (Ord a, Fractional a) => (V2 a, V2 a) -> (V2 a, V2 a) -> Maybe (V2 a)
161 lineIntersect a b =
162 case rayIntersect a b of
163 Just u
164 | isBetween u a && isBetween u b -> Just u
165 _ -> Nothing
166
167 -- circleIntersect :: (Ord a, Fractional a) => (V2 a, V2 a) -> (V2 a, V2 a) -> [V2 a]
168
169 distSquared :: (Num a) => V2 a -> V2 a -> a
170 distSquared a b = quadrance (a ^-^ b)
171
172 approxDist :: (Real a, Fractional a) => V2 a -> V2 a -> a
173 approxDist a b = realToFrac (sqrt (realToFrac (distSquared a b) :: Double))
174
175 distance' :: (Real a, Fractional a) => V2 a -> V2 a -> Double
176 distance' a b = sqrt (realToFrac (distSquared a b))
177
178 -- sum of angles is always pi.
179 triangleAngles :: V2 Double -> V2 Double -> V2 Double -> (Double, Double, Double)
180 triangleAngles a b c =
181 (findAngle (b-a) (c-a)
182 ,findAngle (c-b) (a-b)
183 ,findAngle (a-c) (b-c))
184 where
185 findAngle v1 v2 = abs (atan2 (crossZ v1 v2) (dot v1 v2))
186 -- findAngle v1 v2 = acos (dot v1 v2 / (norm v1 * norm v2))