Add various capabilities for generating graphs, fixes to lasgun

src/Dodge/Item/Weapon/LaserPath.hs

@@ -11,27 +11,29 @@ import Geometry
 --import Data.List
 import Data.Bifunctor
 import Data.Tuple
-import Streaming
-import qualified Streaming.Prelude as S
+--import Streaming
+--import qualified Streaming.Prelude as S
 
 -- not sure why we need to keep a list of seen walls, but seems to loop
 -- infinitely when removed
 -- this needs to be tested with both reflections and refractions
-reflectLaserAlong :: Float -> [Wall] -> Point2 -> Point2 -> World 
+-- the distance of the laser should be limited
+reflectLaserAlong :: Float -> Point2 -> Point2 -> World 
     -> (Maybe (Point2,Either Creature Wall),[Point2])
-reflectLaserAlong phasev seenWl sp ep w = case runIdentity . S.head_ . S.dropWhile (notseen seenWl) 
-        $ thingsHitExceptCr Nothing sp ep w of
+reflectLaserAlong phasev sp ep w = case thingHit sp ep w of
     Just (p,Right wl) 
-        | _wlReflect wl -> second (p:) $ reflectLaserAlong phasev (wl:seenWl) p 
-            (p +.+ 800 *.* unitVectorAtAngle (reflDirWall sp p wl)) w
-        | wlIsSeeThrough wl -> second (p:) $ reflectLaserAlong phasev (wl:seenWl) p 
-            (refract sp ep wl p) w
+        | _wlReflect wl -> second (p:) $ reflectLaserAlong phasev 
+            (p +.+ unitVectorAtAngle (reflDirWall sp p wl))
+            (p +.+ (dist p ep) *.* unitVectorAtAngle (reflDirWall sp p wl)) 
+            w
+        | wlIsSeeThrough wl && _wlSeen wl -> second (p:) $ reflectLaserAlong phasev 
+            (p +.+ normalizeV (refract sp ep wl p))
+            (refract sp ep wl p) 
+            w
         | otherwise -> (Just (p,Right wl), [p])
     Just (p,obj) -> (Just (p,obj), [p])
     Nothing -> (Nothing, [ep])
   where
-    notseen ws (_,Right wl) = not $ any (\w' -> _wlID w' == _wlID wl) ws
-    notseen _ _ = True
     refract x y wl p 
         | isEntering = p +.+ rotateV angleRef  (normalDist wlNormal)
         | otherwise  = p +.+ rotateV angleRef' (normalDist wlNormal')