Commit on return after gap

src/Dodge/Tesla.hs

@@ -1,11 +1,10 @@
 module Dodge.Tesla (
     makeTeslaArc,
---    updateTeslaArc,
+    --    updateTeslaArc,
 ) where
 
-import Dodge.Movement.Turn
+import Control.Applicative
 import Control.Monad
-import Dodge.WorldEvent.ThingsHit
 --import Control.Applicative
 --import Data.Foldable
 --import Data.List (uncons) --(sortOn)
@@ -15,6 +14,8 @@ import Data.Maybe
 import Dodge.Data.ArcStep
 import Dodge.Data.CrWlID
 import Dodge.Data.World
+import Dodge.Movement.Turn
+import Dodge.WorldEvent.ThingsHit
 --import Dodge.Spark
 import Geometry
 --import qualified IntMapHelp as IM
@@ -22,6 +23,7 @@ import LensHelp
 --import MonadHelp
 import Picture
 import RandomHelp
+
 --import Shape
 
 makeTeslaArc :: ItemParams -> Point2 -> Float -> World -> (World, ItemParams)
@@ -40,36 +42,58 @@ makeTeslaArc ip pos dir w =
     newarc = updateArc ip w pos dir & evalState $ _randGen w
 
 updateArc :: ItemParams -> World -> Point2 -> Float -> State StdGen [ArcStep]
-updateArc ip w p dir = take 10 <$> zipArcs dir w (ArcStep p dir NothingID) carc
+updateArc ip w p dir = take 10 <$> zipArcs endarc w (ArcStep p dir NothingID) carc
   where
+    endarc = snd <$> unsnoc (_currentArc ip)
     carc = case _currentArc ip of
         (_ : xs) -> xs
         [] -> []
 
-zipArcs :: Float -> World -> ArcStep -> [ArcStep] -> State StdGen [ArcStep]
-zipArcs d w x ys = (x:) <$> do
-    let mys = uncons ys
-    na <- nextArc d w x (fmap fst mys)
-    case na of
-        Just a -> zipArcs d w a (join $ maybeToList (fmap snd mys))
-        Nothing -> return []
+zipArcs :: Maybe ArcStep -> World -> ArcStep -> [ArcStep] -> State StdGen [ArcStep]
+zipArcs d w x ys =
+    (x :) <$> do
+        let mys = uncons ys
+        na <- nextArc d w x (fmap fst mys)
+        case na of
+            Just a -> zipArcs d w a (join $ maybeToList (fmap snd mys))
+            Nothing -> return []
 
-nextArc :: Float -> World -> ArcStep -> Maybe ArcStep -> State StdGen (Maybe ArcStep)
-nextArc _ w lastarc mx
+nextArc ::
+    Maybe ArcStep ->
+    World ->
+    ArcStep ->
+    Maybe ArcStep ->
+    State StdGen (Maybe ArcStep)
+nextArc endarc w lastarc mx
     | ArcStep p d NothingID <- lastarc = do
-        offset <- randInCirc 5
+        offset <- randInCirc 20
         let pdir = 20 * unitVectorAtAngle d
-            (dout,pout) = fromMaybe (d,pdir) $ do
-                p' <- mx ^? _Just . asPos
-                let d' = turnTo 0.5 p p' d
-                return $ (d', vecTurnTo 0.5 p p' pdir)
-            newp = p + pout + offset
+            (dout, pout) = fromMaybe (d, pdir) $ do
+                p' <- endArcPos endarc <|> mx ^? _Just . asPos
+                let tangle = 0.5
+                    d' = turnTo tangle p p' d
+                return (d', vecTurnTo tangle p p' pdir)
+            newp = fromMaybe (p + pout + offset) $ do
+                p' <- endArcPos endarc
+                guard $ dist p' p < 20
+                return p'
         return $ case thingHit p newp w of
             Nothing -> Just $ ArcStep newp dout NothingID
             Just (p', Left cr) -> Just $ ArcStep p' dout (CrID (_crID cr))
             Just (p', Right wl) -> Just $ ArcStep p' dout (WlID (_wlID wl))
     | otherwise = return Nothing
 
+-- might want to check whether any cr/wall exists
+endArcPos :: Maybe ArcStep -> Maybe Point2
+endArcPos mas = do
+    as <- mas
+    case as ^. asObject of
+        NothingID -> Nothing
+        CrID {} -> do
+            as ^? asPos
+        WlID {} -> do
+            as ^? asPos
+
 --nextArc :: Float -> World -> ArcStep -> Maybe ArcStep -> State StdGen (Maybe ArcStep)
 --nextArc d w lastarc mx
 --    | ArcStep p d NothingID <- lastarc = do