Refactor tesla

src/Dodge/ArcStep.hs

@@ -0,0 +1,11 @@
+module Dodge.ArcStep where
+import Dodge.Data
+import Dodge.Tesla.Arc.Default
+
+import Control.Monad.State
+import System.Random
+
+doStep :: NextArcStep -> ItemParams -> World -> ArcStep -> State StdGen (Maybe ArcStep)
+doStep nas = case nas of
+    DefaultArcStep -> defaultArcStep
+    EndArc -> const $ const $ const $ return Nothing

src/Dodge/Creature/Impulse/UseItem.hs

@@ -33,7 +33,7 @@ itemEffect cr it w = case it ^? itUse of
     Just LeftUse {} -> doequipmentchange
     Just EquipUse{} -> doequipmentchange
     -- ConsumeUse will cause problems if the item is not selected
-    Just (ConsumeUse eff) -> setuhamdown $ hammerTest $ (useC eff) it cr . rmInvItem (_crID cr) (crSel cr)
+    Just (ConsumeUse eff) -> setuhamdown $ hammerTest $ useC eff it cr . rmInvItem (_crID cr) (crSel cr)
     Just NoUse  -> setuhamdown w
     Nothing     -> setuhamdown w
   where

src/Dodge/Damage.hs

@@ -6,6 +6,11 @@ import Geometry.Vector
 import LensHelp
 
 import qualified Data.Map.Strict as M
+damageCrWlID :: Damage -> CrWlID -> World -> World
+damageCrWlID dam crwl = case crwl of
+    NothingID -> id
+    CrID cid  -> creatures . ix cid . crState . csDamage .:~ dam
+    WlID wlid -> wallDamages . ix wlid .:~ dam
 
 damageCrWall :: Damage -> Either Creature Wall -> World -> World
 damageCrWall dt (Left cr) = creatures . ix (_crID cr) . crState . csDamage .:~ dt

src/Dodge/Data.hs

@@ -10,6 +10,8 @@ circular imports are probably not a good idea.
 {-# LANGUAGE DerivingStrategies #-}
 module Dodge.Data 
     ( module Dodge.Data
+    , module Dodge.Data.ArcStep
+    , module Dodge.Data.CrWlID
     , module Dodge.Data.Item.HeldUse
     , module Dodge.Data.Item.HeldScroll
     , module Dodge.Data.Item.Consumption
@@ -59,6 +61,8 @@ module Dodge.Data
     , module Dodge.Data.RadarBlip
     , module Dodge.Data.PathGraph
     ) where
+import Dodge.Data.CrWlID
+import Dodge.Data.ArcStep
 import Dodge.Data.Item.HeldUse
 import Dodge.Data.Item.HeldScroll
 import Dodge.Data.Item.Consumption
@@ -656,17 +660,10 @@ data ItemParams
         { _currentArc :: Maybe [ArcStep] 
         , _arcSize :: Float
         , _arcNumber :: Int
-        , _newArcStep :: ItemParams -> World 
+        , _newArcStep :: NextArcStep --ItemParams -> World -> ArcStep -> State StdGen (Maybe ArcStep)
-            -> ArcStep
-            -> State StdGen (Maybe ArcStep)
         , _previousArcEffect :: PreviousArcEffect
         }
     | ParamMID {_paramMID :: Maybe Int}
-data ArcStep = ArcStep
-    { _asPos :: Point2
-    , _asDir :: Float
-    , _asObject :: Maybe (Either Creature Wall)
-    }
 data PreviousArcEffect = NoPreviousArcEffect | PerturbTillBreakPreviousArc
 data Modification
     = ModIDTimerPoint3Bool
@@ -1291,7 +1288,6 @@ makeLenses ''ScreenLayer
 makeLenses ''Beam
 makeLenses ''BeamType
 makeLenses ''WorldBeams
-makeLenses ''ArcStep
 makeLenses ''EquipParams
 makeLenses ''TerminalCommand
 makeLenses ''TerminalInput

src/Dodge/Data/ArcStep.hs

@@ -0,0 +1,14 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE StrictData #-}
+module Dodge.Data.ArcStep where
+import Dodge.Data.CrWlID
+import Geometry.Data
+import Control.Lens
+data ArcStep = ArcStep
+    { _asPos :: Point2
+    , _asDir :: Float
+    , _asObject :: CrWlID --Maybe (Either Creature Wall)
+    }
+data NextArcStep = EndArc
+    | DefaultArcStep
+makeLenses ''ArcStep

src/Dodge/Data/CrWlID.hs

@@ -0,0 +1,6 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE StrictData #-}
+module Dodge.Data.CrWlID where
+import Control.Lens
+data CrWlID = CrID Int | WlID Int | NothingID
+makeLenses ''CrWlID

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' NothingID -> (lp',ld')
-        ArcStep lp' ld' (Just (Left cr)) -> (lp' -.- (_crRad cr + 1) *.* unitVectorAtAngle ld',ld'+pi)
+        ArcStep lp' ld' (CrID crid) -> case w ^? creatures . ix crid of
-        ArcStep lp' ld' (Just (Right _)) -> (lp' -.- 2 *.* unitVectorAtAngle ld',ld'+pi)
+            Nothing -> (lp',ld')
-    damthings (ArcStep _ _ Nothing) = id
+            Just cr -> (lp' -.- (_crRad cr + 1) *.* unitVectorAtAngle ld',ld'+pi)
-    damthings (ArcStep p dir (Just crwl)) = damageCrWall (thedamage p dir) crwl
+        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)
+        f (q,wl) = ArcStep q dir (WlID $ _wlID wl)
-        g cr   = ArcStep (_crPos cr +.+ csize *.* unitVectorAtAngle dir) dir (Just $ Left cr)
+        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
     }