Refactor tesla

src/Dodge/Tesla/Arc.hs

@@ -7,6 +7,7 @@ import RandomHelp
 import Picture
 import Geometry
 import LensHelp
+import Dodge.ArcStep
 --import Dodge.Data
 --import Geometry
 --import LensHelp
@@ -54,11 +55,15 @@ moveTeslaArc thearc w pt
     makeaspark = randSpark ELECTRICAL rspeed rcol rdir lp
     makesparks = makeaspark . makeaspark . makeaspark
     (lp,ld) = case last thearc of
-        ArcStep lp' ld' Nothing -> (lp',ld')
-        ArcStep lp' ld' (Just (Left cr)) -> (lp' -.- (_crRad cr + 1) *.* unitVectorAtAngle ld',ld'+pi)
-        ArcStep lp' ld' (Just (Right _)) -> (lp' -.- 2 *.* unitVectorAtAngle ld',ld'+pi)
-    damthings (ArcStep _ _ Nothing) = id
-    damthings (ArcStep p dir (Just crwl)) = damageCrWall (thedamage p dir) crwl
+        ArcStep lp' ld' NothingID -> (lp',ld')
+        ArcStep lp' ld' (CrID crid) -> case w ^? creatures . ix crid of
+            Nothing -> (lp',ld')
+            Just cr -> (lp' -.- (_crRad cr + 1) *.* unitVectorAtAngle ld',ld'+pi)
+        ArcStep lp' ld' (WlID wlid) -> case w ^? walls . ix wlid of
+            Nothing -> (lp',ld')
+            Just _ -> (lp' -.- 2 *.* unitVectorAtAngle ld',ld'+pi)
+    --damthings (ArcStep _ _ NothingID) = id
+    damthings (ArcStep p dir crwl) = damageCrWlID (thedamage p dir) crwl
     thedamage p dir = Damage ELECTRICAL 50 (p -.- q) p (p +.+ q) NoDamageEffect
       where
         q = 5 *.* unitVectorAtAngle dir
@@ -84,14 +89,14 @@ createArc arcparams w p dir = updateArc arcparams w p dir
 createNewArc :: ItemParams -> World -> Point2 -> Float
     -> State StdGen [ArcStep]
 createNewArc arcparams w p dir = take (_arcNumber arcparams)
-    <$> unfoldrMID (_newArcStep arcparams arcparams w) (ArcStep p dir Nothing)
+    <$> unfoldrMID (doStep (_newArcStep arcparams) arcparams w) (ArcStep p dir NothingID)
 
 updateArc :: ItemParams
     -> World
     -> Point2
     -> Float
     -> State StdGen [ArcStep]
-updateArc ip w p dir = take (_arcNumber ip) <$> zipArcs ip w (ArcStep p dir Nothing) carc
+updateArc ip w p dir = take (_arcNumber ip) <$> zipArcs ip w (ArcStep p dir NothingID) carc
   where
     carc = tail $ fromJust $ _currentArc ip
 
@@ -101,10 +106,11 @@ zipArcs :: ItemParams
     -> [ArcStep]
     -> State StdGen [ArcStep]
 zipArcs ip w x (y:ys) = (x :) <$> do  
-    defaultnext <- _newArcStep ip ip w x
+    defaultnext <- doStep (_newArcStep ip) ip w x
     case defaultnext of
         Nothing -> return []
-        Just z@(ArcStep _ _ (Just _)) -> return [z]
+        Just z@(ArcStep _ _ (CrID _)) -> return [z]
+        Just z@(ArcStep _ _ (WlID _)) -> return [z]
         Just z -> do
             p <- randInCirc 5
             let csize = _arcSize ip

src/Dodge/Tesla/Arc/Default.hs

@@ -12,7 +12,8 @@ import qualified Data.IntMap.Strict as IM
 
 defaultArcStep :: RandomGen g => ItemParams -> World -> ArcStep
     -> State g (Maybe ArcStep)
-defaultArcStep _     _ (ArcStep _ _ (Just _)) = return Nothing
+defaultArcStep _     _ (ArcStep _ _ (CrID _)) = return Nothing
+defaultArcStep _     _ (ArcStep _ _ (WlID _)) = return Nothing
 defaultArcStep itparams w (ArcStep p dir _) = do
     let csize = _arcSize itparams
     --rot <- takeOne [pi/4,negate pi/4]
@@ -29,7 +30,7 @@ defaultArcStep itparams w (ArcStep p dir _) = do
             . mapMaybe (\ q -> sequence $ collidePointWallsFilterStream (const True) p (center +.+ q) w)
                 -- collidePointWallsWall and wlsnearpoint
             $ polyCirc 6 csize
-        f (q,wl) = ArcStep q dir (Just $ Right wl)
-        g cr   = ArcStep (_crPos cr +.+ csize *.* unitVectorAtAngle dir) dir (Just $ Left cr)
+        f (q,wl) = ArcStep q dir (WlID $ _wlID wl)
+        g cr   = ArcStep (_crPos cr +.+ csize *.* unitVectorAtAngle dir) dir (CrID $ _crID cr)
     return . listToMaybe . sortOn (dist p . (^. asPos))
-        $ ArcStep newp dir Nothing : catMaybes [fmap f mwl,fmap g mcr]
+        $ ArcStep newp dir NothingID : catMaybes [fmap f mwl,fmap g mcr]

src/Dodge/Tesla/ItemParams.hs

@@ -1,12 +1,11 @@
 module Dodge.Tesla.ItemParams where
 import Dodge.Data
-import Dodge.Tesla.Arc.Default
 
 teslaParams :: ItemParams
 teslaParams = Arcing 
     { _currentArc = Nothing
     , _arcSize = 20
     , _arcNumber = 10
-    , _newArcStep = defaultArcStep
+    , _newArcStep = DefaultArcStep --defaultArcStep
     , _previousArcEffect = NoPreviousArcEffect
     }