From b36e7f8b78bcc7c1e01c44459447e335fb7a6516 Mon Sep 17 00:00:00 2001 From: justin Date: Wed, 20 Jul 2022 21:18:11 +0100 Subject: [PATCH] Refactor tesla --- src/Dodge/ArcStep.hs | 11 +++++++++++ src/Dodge/Creature/Impulse/UseItem.hs | 2 +- src/Dodge/Damage.hs | 5 +++++ src/Dodge/Data.hs | 14 +++++--------- src/Dodge/Data/ArcStep.hs | 14 ++++++++++++++ src/Dodge/Data/CrWlID.hs | 6 ++++++ src/Dodge/Tesla/Arc.hs | 24 +++++++++++++++--------- src/Dodge/Tesla/Arc/Default.hs | 9 +++++---- src/Dodge/Tesla/ItemParams.hs | 3 +-- 9 files changed, 63 insertions(+), 25 deletions(-) create mode 100644 src/Dodge/ArcStep.hs create mode 100644 src/Dodge/Data/ArcStep.hs create mode 100644 src/Dodge/Data/CrWlID.hs diff --git a/src/Dodge/ArcStep.hs b/src/Dodge/ArcStep.hs new file mode 100644 index 000000000..d70ae0e64 --- /dev/null +++ b/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 diff --git a/src/Dodge/Creature/Impulse/UseItem.hs b/src/Dodge/Creature/Impulse/UseItem.hs index a6842b59f..7e15b4b2b 100644 --- a/src/Dodge/Creature/Impulse/UseItem.hs +++ b/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 diff --git a/src/Dodge/Damage.hs b/src/Dodge/Damage.hs index f19c47797..9aca2dfd2 100644 --- a/src/Dodge/Damage.hs +++ b/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 diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 6ae52a1d3..7df86be86 100644 --- a/src/Dodge/Data.hs +++ b/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 - -> ArcStep - -> State StdGen (Maybe ArcStep) + , _newArcStep :: NextArcStep --ItemParams -> World -> 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 diff --git a/src/Dodge/Data/ArcStep.hs b/src/Dodge/Data/ArcStep.hs new file mode 100644 index 000000000..9a54c6e2a --- /dev/null +++ b/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 diff --git a/src/Dodge/Data/CrWlID.hs b/src/Dodge/Data/CrWlID.hs new file mode 100644 index 000000000..030685b0a --- /dev/null +++ b/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 diff --git a/src/Dodge/Tesla/Arc.hs b/src/Dodge/Tesla/Arc.hs index 74ce11161..6bbd00936 100644 --- a/src/Dodge/Tesla/Arc.hs +++ b/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 diff --git a/src/Dodge/Tesla/Arc/Default.hs b/src/Dodge/Tesla/Arc/Default.hs index 2d8975fbb..3c3a27c5f 100644 --- a/src/Dodge/Tesla/Arc/Default.hs +++ b/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] diff --git a/src/Dodge/Tesla/ItemParams.hs b/src/Dodge/Tesla/ItemParams.hs index 6058658e6..a98e6b59c 100644 --- a/src/Dodge/Tesla/ItemParams.hs +++ b/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 }