Stop bullets when they hit walls

src/Geometry/Intersect.hs

@@ -2,9 +2,9 @@
 {-
 Testing for and finding intersection points.
 -}
-module Geometry.Intersect
-    where
+module Geometry.Intersect where
 import Geometry.Data
+import Geometry.Vector
 import Geometry.LHS
 import Control.Applicative
 
@@ -18,10 +18,21 @@ intersectLineLine' (V2 x1 y1) (V2 x2 y2) (V2 x3 y3) (V2 x4 y4)
   where 
     den = (x1-x2)*(y3-y4) - (y1-y2)*(x3-x4)
     t'  = (x1-x3)*(y3-y4) - (y1-y3)*(x3-x4)
+intersectSegSegErrorTest :: Point2 -> Point2 -> Point2 -> Point2 -> Maybe Point2
+{-# INLINE intersectSegSegErrorTest #-}
+intersectSegSegErrorTest a b c d = case intersectSegSeg a b c d of
+    Nothing | intersectSegSegFullTest a b c d -> 
+            error $ "intersectSegSeg did not intersect"++show a ++ show b ++ show c++ show d
+    Just x | not $ intersectSegSegFullTest a b c d -> 
+            error $ "intersectSegSeg did intersect"++show a ++ show b ++ show c++ show d
+                ++ " at " ++ show x
+    m -> m
+
 -- | If two segments intersect, return 'Just' that point.
 intersectSegSeg :: Point2 -> Point2 -> Point2 -> Point2 -> Maybe Point2
 {-# INLINE intersectSegSeg #-}
 intersectSegSeg (V2 x1 y1) (V2 x2 y2) (V2 x3 y3) (V2 x4 y4)
+    | V2 x1 y1 == V2 x2 y2 || V2 x3 y3 == V2 x4 y4 = Nothing
     | den == 0 = Nothing
     | den > 0 && (t' < 0 || u' < 0 || t' > den || u' > den)
         = Nothing
@@ -75,9 +86,23 @@ intersectSegLine (V2 x1 y1) (V2 x2 y2) (V2 x3 y3) (V2 x4 y4)
     den = (x1-x2)*(y3-y4) - (y1-y2)*(x3-x4)
     t'  = (x1-x3)*(y3-y4) - (y1-y3)*(x3-x4)
     --u'  = (y1-y2)*(x1-x3) - (x1-x2)*(y1-y3)
+-- | A test that should align with Just values from intersectSegSeg.
+intersectSegSegFullTest
+    :: Point2
+    -> Point2
+    -> Point2
+    -> Point2
+    -> Bool
+{-# INLINE intersectSegSegFullTest #-}
+intersectSegSegFullTest x y z w
+    = f x y z w && f z w x y && x /= y && z /= w 
+        && normalizeV (x -.- y) /= normalizeV (z -.- w)
+        && normalizeV (y -.- x) /= normalizeV (z -.- w)
+  where
+    f a b c d =  ( not (isRHS a b c) && not (isLHS a b d) ) 
+              || ( not (isLHS a b c) && not (isRHS a b d) )
 -- | It is not always necessary to find a point of intersection, sometimes a
 -- test may suffice.
--- IS THIS CORRECT? -- TODO tests
 intersectSegSegTest
     :: Point2
     -> Point2
@@ -86,7 +111,7 @@ intersectSegSegTest
     -> Bool
 {-# INLINE intersectSegSegTest #-}
 intersectSegSegTest x y z w
-    = f x y z w && f z w x y
+    = f x y z w && f z w x y && x /= y && z /= w
   where
     f a b c d =  ( not (isRHS a b c) && not (isLHS a b d) ) 
               || ( not (isLHS a b c) && not (isRHS a b d) )