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