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