From 6cd59d99bcc6f2ab1391dacc5b990672e047fa92 Mon Sep 17 00:00:00 2001 From: justin Date: Sat, 11 Dec 2021 22:08:43 +0000 Subject: [PATCH] Cleanup --- src/Dodge/Creature.hs | 16 +++---- src/Dodge/Creature/Action.hs | 8 ++-- src/Dodge/Creature/Impulse.hs | 27 +++--------- src/Dodge/Creature/LauncherCrit.hs | 2 +- src/Dodge/Creature/LtAutoCrit.hs | 12 ++--- src/Dodge/Creature/PistolCrit.hs | 10 ++--- src/Dodge/Creature/ReaderUpdate.hs | 8 ++-- src/Dodge/Creature/SentinelAI.hs | 12 ++--- src/Dodge/Creature/SpreadGunCrit.hs | 12 ++--- src/Dodge/Creature/State.hs | 61 +++++++------------------- src/Dodge/Creature/Strategy.hs | 7 ++- src/Dodge/Creature/SwarmCrit.hs | 6 +-- src/Dodge/Creature/Test.hs | 45 ++++++++++--------- src/Dodge/Creature/Volition.hs | 4 +- src/Dodge/Data.hs | 10 ++--- src/Dodge/Debug/Terminal.hs | 22 +++++----- src/Dodge/Placement/Instance/Turret.hs | 23 ++++------ 17 files changed, 115 insertions(+), 170 deletions(-) diff --git a/src/Dodge/Creature.hs b/src/Dodge/Creature.hs index 25c409211..16f2863b1 100644 --- a/src/Dodge/Creature.hs +++ b/src/Dodge/Creature.hs @@ -16,7 +16,6 @@ import Dodge.Item.Weapon.Booster import Dodge.Item.Weapon.Utility import Dodge.Item.Weapon.Drone import Dodge.Item.Craftable ---import Dodge.Creature.ReaderUpdate --import Dodge.Creature.AlertLevel --import Dodge.Creature.SetTarget import Dodge.Creature.Volition @@ -52,7 +51,6 @@ import qualified IntMapHelp as IM --import Data.Maybe --import Data.Function import Control.Lens ---import Control.Monad.Reader --import System.Random --import qualified Data.Set as S --import qualified Data.Map as M @@ -110,12 +108,12 @@ multGunCrit = defaultCreature , _crRad = 10 , _crHP = 300 , _crUpdate = stateUpdate $ impulsiveAI $ sentinelExtraWatchUpdate - [ ( not . crHasAmmo + [ ( const $ not . crHasAmmo , \_ _ -> StrategyActions Reload reloadActions ) - , (not . crSafeDistFromTarg 150 + , (const $ not . crSafeDistFromTarg 150 , \_ cr -> StrategyActions Flee - [(not . crSafeDistFromTarg 150) `DoActionWhile` UseTarget (fleeFrom cr) + [const (not . crSafeDistFromTarg 150) `DoActionWhile` UseTarget (fleeFrom cr) `DoActionThen` DoImpulses [ChangeStrategy WatchAndWait] ] ) , (crHasTargetLOS, \_ _ -> StrategyActions (ShootAt 0) @@ -130,10 +128,10 @@ multGunCrit = defaultCreature } } where - drawwp = DoActionIfElse NoAction crIsAiming (DoActionThen drawWeapon (WaitThen 50 NoAction)) + drawwp = DoActionIfElse NoAction (const crIsAiming) (DoActionThen drawWeapon (WaitThen 50 NoAction)) reloadActions = [ holsterWeapon - , WaitThen 1 $ DoActionWhileInterrupt NoAction crIsReloading (DoImpulses [ChangeStrategy WatchAndWait]) + , WaitThen 1 $ DoActionWhileInterrupt NoAction (const crIsReloading) (DoImpulses [ChangeStrategy WatchAndWait]) ] addArmour :: Creature -> Creature @@ -163,9 +161,7 @@ startCr = defaultCreature } {- | Items you start with. -} startInvList :: [Item] -startInvList = - [ - ] +startInvList = [ ] startInventory :: IM.IntMap Item startInventory = IM.fromList $ zip [0..] startInvList testInventory :: IM.IntMap Item diff --git a/src/Dodge/Creature/Action.hs b/src/Dodge/Creature/Action.hs index d12b7a762..47509a12d 100644 --- a/src/Dodge/Creature/Action.hs +++ b/src/Dodge/Creature/Action.hs @@ -105,18 +105,18 @@ performAction cr w ac = case ac of (imps , Nothing ) -> (imps, Just afta) DoActionWhile f act -> performAction cr w $ DoActionWhilePartial act f act DoActionWhilePartial partAc f resetAc - | f (w,cr) -> case performAction cr w partAc of + | f w cr -> case performAction cr w partAc of (imps, Just nxta) -> (imps, Just $ DoActionWhilePartial nxta f resetAc) (imps, Nothing) -> (imps, Just $ DoActionWhilePartial resetAc f resetAc) | otherwise -> performAction cr w partAc DoActionIf f ifa - | f (w,cr) -> performAction cr w ifa + | f w cr -> performAction cr w ifa | otherwise -> ([],Nothing) DoActionIfElse ifa f elsea - | f (w,cr) -> performAction cr w ifa + | f w cr -> performAction cr w ifa | otherwise -> performAction cr w elsea DoActionWhileInterrupt repa f afta - | f (w,cr) -> (fst $ performAction cr w repa, Just $ DoActionWhileInterrupt repa f afta) + | f w cr -> (fst $ performAction cr w repa, Just $ DoActionWhileInterrupt repa f afta) | otherwise -> performAction cr w afta DoActions [] -> ([], Nothing) DoActions acs -> diff --git a/src/Dodge/Creature/Impulse.hs b/src/Dodge/Creature/Impulse.hs index 497cd27b6..05bf5489b 100644 --- a/src/Dodge/Creature/Impulse.hs +++ b/src/Dodge/Creature/Impulse.hs @@ -1,7 +1,5 @@ module Dodge.Creature.Impulse - ( impulsiveAIR --- , impulsiveAI - , impulsiveAI + ( impulsiveAI , followImpulses ) where import Dodge.Data @@ -10,27 +8,13 @@ import Dodge.Creature.Impulse.Movement import Dodge.Creature.Impulse.UseItem import Dodge.SoundLogic import Geometry +import LensHelp import qualified Data.IntMap.Strict as IM import System.Random -import Control.Lens -import Control.Monad.Reader import Data.Bifunctor --import Data.Maybe -impulsiveAIR - :: (Creature -> Reader World Creature) - -> Creature - -> World - -> (World -> World , Maybe Creature) -impulsiveAIR impf cr w = second Just $ followImpulses w . ($ w) . runReader $ impf cr - ---impulsiveAI :: (World -> Creature -> Creature) --- -> Creature --- -> World --- -> (World -> World , Maybe Creature) ---impulsiveAI impf cr w = second Just $ followImpulses w $ impf w cr - impulsiveAI :: (World -> Creature -> Creature) -> Creature -> World @@ -56,14 +40,13 @@ followImpulse cr w imp = case imp of ChangePosture post -> (id, cr & crStance . posture .~ post) UseItem -> (tryUseItem cr, cr) SwitchToItem i -> (id, cr & crInvSel .~ i) - Melee cid' -> - (hitCr cid' - , crMvBy (10 *.* normalizeV (posFromID cid' -.- cpos)) $ cr & crMeleeCooldown .~ 20) -- randomise cooldown? + Melee cid' -> (hitCr cid' + , crMvBy (10 *.* normalizeV (posFromID cid' -.- cpos)) $ cr & crMeleeCooldown .~ 20) RandomTurn a -> (id, creatureTurn (rr a) cr) MakeSound sid -> ( soundStart (CrSound (_crID cr)) (_crPos cr) sid Nothing , cr ) DropItem -> undefined ChangeStrategy strat -> (id, cr & crActionPlan . crStrategy .~ strat) - AddGoal gl -> (id, cr & crActionPlan . crGoal %~ (gl :) ) + AddGoal gl -> (id, cr & crActionPlan . crGoal .:~ gl ) ArbitraryImpulseFunction f -> (id, f w cr) ArbitraryImpulse f -> followImpulse cr w (f cr w) ImpulseUseTargetCID f -> case cr ^? crIntention . targetCr . _Just of diff --git a/src/Dodge/Creature/LauncherCrit.hs b/src/Dodge/Creature/LauncherCrit.hs index 50e1a412a..9590213a4 100644 --- a/src/Dodge/Creature/LauncherCrit.hs +++ b/src/Dodge/Creature/LauncherCrit.hs @@ -28,7 +28,7 @@ launcherCrit = defaultCreature [ Left performActions , Left $ watchUpdateStrat [ (crHasTargetLOS, \_ _ -> StrategyActions (ShootAt 0) [retreatFire]) - , (crAwayFromPost, goToPostStrat) + , (const crAwayFromPost, const goToPostStrat) ] , Left $ perceptionUpdate' [0] , Right doStrategyActions diff --git a/src/Dodge/Creature/LtAutoCrit.hs b/src/Dodge/Creature/LtAutoCrit.hs index e9c6a4409..abf180e0d 100644 --- a/src/Dodge/Creature/LtAutoCrit.hs +++ b/src/Dodge/Creature/LtAutoCrit.hs @@ -30,18 +30,18 @@ ltAutoCrit = defaultCreature [ Left performActions , Left $ watchUpdateStrat [ (crHasTargetLOS, \_ _ -> StrategyActions (ShootAt 0) - [DoActionIf (not . crIsAiming) drawWeapon + [DoActionIf (const $ not . crIsAiming) drawWeapon ,DoActionThen - (DoActionWhile crHasTargetLOS $ ArbitraryAction chooseMovement) + (DoActionWhile crHasTargetLOS' $ ArbitraryAction chooseMovement) (DoImpulses [ChangeStrategy WatchAndWait]) ] ) - , (crAwayFromPost, goToPostStrat) + , (const crAwayFromPost, const goToPostStrat) ] , Left $ perceptionUpdate' [0] - , Right $ doStrategyActions - , Right $ reloadOverride - , Left $ targetYouWhenCognizant + , Right doStrategyActions + , Right reloadOverride + , Left targetYouWhenCognizant , Right $ overrideInternal (\cr -> crHasTarget' cr && crStratConMatches' (GetTo (V2 0 0)) cr) (crActionPlan . crStrategy .~ WatchAndWait) diff --git a/src/Dodge/Creature/PistolCrit.hs b/src/Dodge/Creature/PistolCrit.hs index f13561521..b645c5418 100644 --- a/src/Dodge/Creature/PistolCrit.hs +++ b/src/Dodge/Creature/PistolCrit.hs @@ -33,13 +33,13 @@ pistolCrit = defaultCreature [Left performActions ,Left $ watchUpdateStrat [ (crHasTargetLOS, \w cr -> StrategyActions (ShootAt 0) - [DoActionIf (not . crIsAiming) drawWeapon,chooseMovement cr w]) - , (crAwayFromPost, goToPostStrat) + [DoActionIf (const $ not . crIsAiming) drawWeapon,chooseMovement cr w]) + , (const crAwayFromPost, const goToPostStrat) ] ,Left $ perceptionUpdate' [0] - ,Right $ doStrategyActions - ,Right $ reloadOverride - ,Left $ targetYouWhenCognizant + ,Right doStrategyActions + ,Right reloadOverride + ,Left targetYouWhenCognizant ,Right $ overrideInternal (\cr -> crHasTarget' cr && crStratConMatches' (GetTo (V2 0 0)) cr) (crActionPlan . crStrategy .~ WatchAndWait) diff --git a/src/Dodge/Creature/ReaderUpdate.hs b/src/Dodge/Creature/ReaderUpdate.hs index 872254447..1f06c89cc 100644 --- a/src/Dodge/Creature/ReaderUpdate.hs +++ b/src/Dodge/Creature/ReaderUpdate.hs @@ -24,6 +24,7 @@ import qualified Data.IntMap.Strict as IM import Control.Lens import Control.Applicative import Data.Maybe +import Data.Bifunctor overrideMeleeCloseTarget :: Creature -> Creature overrideMeleeCloseTarget cr = maybe cr (tryMeleeAttack cr) (_targetCr $ _crIntention cr) @@ -117,7 +118,8 @@ reloadOverride cr reloadActions = [ holsterWeapon , 1 `WaitThen` - DoActionWhileInterrupt NoAction crIsReloading (DoImpulses [ChangeStrategy WatchAndWait]) + DoActionWhileInterrupt NoAction (const crIsReloading) + (DoImpulses [ChangeStrategy WatchAndWait]) ] overrideInternal :: (Creature -> Bool) -> (Creature -> Creature) -> Creature -> Creature @@ -126,13 +128,13 @@ overrideInternal test update cr | otherwise = cr watchUpdateStrat - :: [ ((World, Creature) -> Bool, World -> Creature -> Strategy) ] + :: [ (World -> Creature -> Bool, World -> Creature -> Strategy) ] -> World -> Creature -> Creature watchUpdateStrat fs w cr = case cr ^? crActionPlan . crStrategy of Just WatchAndWait -> cr - & crActionPlan . crStrategy .~ listGuard (fs, \_ _ -> WatchAndWait) (w, cr) w cr + & crActionPlan . crStrategy .~ listGuard (map (first uncurry) fs, \_ _ -> WatchAndWait) (w, cr) w cr _ -> cr listGuard :: ([(a -> Bool, b)] , b) -> a -> b diff --git a/src/Dodge/Creature/SentinelAI.hs b/src/Dodge/Creature/SentinelAI.hs index 8ec0b6b5e..744cb31a3 100644 --- a/src/Dodge/Creature/SentinelAI.hs +++ b/src/Dodge/Creature/SentinelAI.hs @@ -23,7 +23,7 @@ sentinelAI w = reloadOverride . [ (crHasTargetLOS , \ _ cr -> StrategyActions (ShootAt (fromJust $ tcid cr)) [ DoActionIf - (not . crIsAiming) + (const $ not . crIsAiming) (drawWeapon `DoActionThen` (50 `WaitThen` NoAction)) `DoActionThen` lostest `DoActionWhile` advanceShoot @@ -38,7 +38,7 @@ sentinelAI w = reloadOverride . where advanceShoot = DoImpulses [UseItem, MoveForward 3] tcid cr = _crID <$> _targetCr (_crIntention cr) - lostest (w',cr) = maybe False (\cid -> canSee (_crID cr) cid w') (tcid cr) + lostest w' cr = maybe False (\cid -> canSee (_crID cr) cid w') (tcid cr) --chainCreatureUpdates :: [World -> Creature -> Creature] -> World -> Creature -> Creature --chainCreatureUpdates ls w cr = foldr (\f -> f w) cr ls @@ -53,7 +53,7 @@ sentinelFireType f = chainCreatureUpdatesLR , aiming ] ) - , (crAwayFromPost, goToPostStrat) + , (const crAwayFromPost, const goToPostStrat) ] , Left $ perceptionUpdate' [0] -- , Left $ perceptionUp 0 @@ -65,21 +65,21 @@ sentinelFireType f = chainCreatureUpdatesLR (crActionPlan . crStrategy .~ WatchAndWait) ] where - drawwp = DoActionIfElse NoAction crIsAiming (DoActionThen drawWeapon (WaitThen 50 NoAction)) + drawwp = DoActionIfElse NoAction (const crIsAiming) (DoActionThen drawWeapon (WaitThen 50 NoAction)) aiming = AimAt { _targetID = 0 , _targetSeenAt = V2 0 0 -- hack } sentinelExtraWatchUpdate - :: [((World, Creature) -> Bool , World -> Creature -> Strategy)] + :: [(World -> Creature -> Bool , World -> Creature -> Strategy)] -> World -> Creature -> Creature sentinelExtraWatchUpdate xs = chainCreatureUpdatesLR [ Left performActions , Left $ watchUpdateStrat - ( xs ++ [(crAwayFromPost, goToPostStrat)] ) + ( xs ++ [(const crAwayFromPost, const goToPostStrat)] ) , Left $ perceptionUpdate' [0] , Right doStrategyActions , Left targetYouWhenCognizant diff --git a/src/Dodge/Creature/SpreadGunCrit.hs b/src/Dodge/Creature/SpreadGunCrit.hs index 1b709cd09..b1f2d5f4b 100644 --- a/src/Dodge/Creature/SpreadGunCrit.hs +++ b/src/Dodge/Creature/SpreadGunCrit.hs @@ -31,18 +31,18 @@ spreadGunCrit = defaultCreature [Left performActions ,Left $ watchUpdateStrat [ (crHasTargetLOS, \_ _ -> StrategyActions (ShootAt 0) - [DoActionIf (not . crIsAiming) drawWeapon + [DoActionIf (const $ not . crIsAiming) drawWeapon ,DoActionThen - (DoActionWhile crHasTargetLOS $ ArbitraryAction chooseMovement) + (DoActionWhile crHasTargetLOS' $ ArbitraryAction chooseMovement) (DoImpulses [ChangeStrategy WatchAndWait]) ] ) - , (crAwayFromPost, goToPostStrat) + , (const crAwayFromPost, const goToPostStrat) ] ,Left $ perceptionUpdate' [0] - ,Right $ doStrategyActions - ,Right $ reloadOverride - ,Left $ targetYouWhenCognizant + ,Right doStrategyActions + ,Right reloadOverride + ,Left targetYouWhenCognizant ,Right $ overrideInternal (\cr -> crHasTarget' cr && crStratConMatches' (GetTo (V2 0 0)) cr) (\ cr -> cr & crActionPlan . crStrategy .~ WatchAndWait) diff --git a/src/Dodge/Creature/State.hs b/src/Dodge/Creature/State.hs index ade735f7b..8a6aa308f 100644 --- a/src/Dodge/Creature/State.hs +++ b/src/Dodge/Creature/State.hs @@ -1,7 +1,6 @@ module Dodge.Creature.State ( stateUpdate , stateUpdateDamage - , stateUpdateDamage' , doDamage , clearDamage , invSideEff @@ -24,7 +23,7 @@ import qualified IntMapHelp as IM --import StrictHelp import qualified Data.IntSet as IS -import Data.Maybe +--import Data.Maybe import Data.Function import Control.Lens --import Control.Applicative @@ -45,34 +44,15 @@ import qualified Data.Vector.Mutable as MV -- update shield positions stateUpdate :: (Creature -> World -> (World -> World, Creature)) -> Creature -> World -> World -stateUpdate f cr w = let (fw,mcr) = stateUpdateDamage' doDamage f cr w - in fw $ w & creatures . at (_crID cr) .~ mcr +stateUpdate = stateUpdateDamage doDamage -stateUpdateDamage :: (Creature -> Creature) -> CRUpdate -> CRUpdate +stateUpdateDamage :: (Creature -> Creature) + -> (Creature -> World -> (World -> World, Creature)) +-- -> CRUpdate + -> Creature -> World -> World stateUpdateDamage damageupdate u cr w = case u (updateMovement cr) w of - (f, maybeCr) -> - ( invSideEff (fromMaybe cr maybeCr) . movementSideEff cr . deathEff . f - , fmap (stepReloading . damageupdate) $ crOrCorpse =<< maybeCr - ) - where - crOrCorpse cr' - | cr' ^. crHP > 0 = Just cr' - | otherwise = Nothing - deathEff - | cr ^.crHP > 0 = id - | otherwise = stopSoundFrom (CrWeaponSound (_crID cr) 0) - . over decorations addCorpse - . dropByState cr - addCorpse = IM.insertNewKey - $ uncurryV translate (_crOldPos cr) - $ rotate (_crDir cr) - (_crCorpse cr) -stateUpdateDamage' :: (Creature -> Creature) -> CRUpdate' -> CRUpdate -stateUpdateDamage' damageupdate u cr w = case u (updateMovement cr) w of - (f, upcr) -> - ( invSideEff upcr . movementSideEff cr . deathEff . f - , stepReloading . damageupdate <$> crOrCorpse upcr - ) + (f, upcr) -> invSideEff upcr . movementSideEff cr . deathEff . f $ w + & creatures . at (_crID cr) .~ (stepReloading . damageupdate <$> crOrCorpse upcr) where crOrCorpse cr' | cr' ^. crHP > 0 = Just cr' @@ -88,22 +68,16 @@ stateUpdateDamage' damageupdate u cr w = case u (updateMovement cr) w of (_crCorpse cr) -- | Drop items according to the creature state. dropByState :: Creature -> World -> World -dropByState cr w = foldr (copyInvItemToFloor cr) w is - where - is :: [Int] - is = case cr ^. crState . crDropsOnDeath of - DropAll -> IM.keys $ _crInv cr - DropSpecific xs -> xs - DropAmount n -> take n $ evalState (shuffle $ IM.keys $ _crInv cr) (_randGen w) +dropByState cr w = foldr (copyInvItemToFloor cr) w $ case cr ^. crState . crDropsOnDeath of + DropAll -> IM.keys $ _crInv cr + DropSpecific xs -> xs + DropAmount n -> take n $ evalState (shuffle $ IM.keys $ _crInv cr) (_randGen w) setOldPos :: Creature -> Creature setOldPos cr = cr & crOldPos .~ _crPos cr & crOldDir .~ _crDir cr ---meleeCooldown :: CRUpdate -> CRUpdate ---meleeCooldown u cr = u $ cr & crMeleeCooldown . _Just %~ (max 0 . (\x -> x - 1)) - clearDamage :: Creature -> Creature clearDamage = crState . crDamage .~ [] @@ -125,15 +99,15 @@ bpVector = V.fromList $ 0 : [0 .. 18] movementSideEff :: Creature -> World -> World movementSideEff cr w | hasJetPack = case cr ^? crStance . carriage of - Just (Boosting v) - -> makeFlameletTimed + Just (Boosting v) -> w + & randGen .~ g + & makeFlameletTimed (oldPos +.+ (_crRad cr + 3) *.* unitVectorAtAngle (_crDir cr + pi)) 20 (momentum +.+ 1 *.* rotateV randDir (vInverse v)) Nothing 1 20 - $ set randGen g w _ -> w | otherwise = footstepSideEffect cr w where @@ -146,7 +120,6 @@ movementSideEff cr w (randDir,g) = randomR (-0.5,0.5) $ _randGen w (randAng,_) = randomR (0,2*pi) $ _randGen w - heldItemUpdate :: Item -> Item heldItemUpdate = invItemUpdate . (itUse %~ useupdate) @@ -220,7 +193,3 @@ isFrictionless cr = case cr ^? crStance . carriage of Just (Boosting _) -> True Just Floating -> True _ -> False - - - - diff --git a/src/Dodge/Creature/Strategy.hs b/src/Dodge/Creature/Strategy.hs index d59e03f42..c40e9050e 100644 --- a/src/Dodge/Creature/Strategy.hs +++ b/src/Dodge/Creature/Strategy.hs @@ -8,8 +8,8 @@ import Dodge.Creature.Volition import Data.List -goToPostStrat :: World -> Creature -> Strategy -goToPostStrat w cr = case find sentinelGoal $ _crGoal $ _crActionPlan cr of +goToPostStrat :: Creature -> Strategy +goToPostStrat cr = case find sentinelGoal $ _crGoal $ _crActionPlan cr of Just (SentinelAt p _) -> StrategyActions (GetTo p) [DoActionThen (WaitThen 150 holsterIfAiming) $ DoActionThen (PathTo p) @@ -21,6 +21,5 @@ goToPostStrat w cr = case find sentinelGoal $ _crGoal $ _crActionPlan cr of sentinelGoal (SentinelAt _ _) = True sentinelGoal _ = False holsterIfAiming - | crIsAiming (w,cr) = holsterWeapon + | crIsAiming cr = holsterWeapon | otherwise = NoAction - diff --git a/src/Dodge/Creature/SwarmCrit.hs b/src/Dodge/Creature/SwarmCrit.hs index 52d472251..80f4be0be 100644 --- a/src/Dodge/Creature/SwarmCrit.hs +++ b/src/Dodge/Creature/SwarmCrit.hs @@ -20,10 +20,10 @@ swarmCrit :: Creature swarmCrit = defaultCreature { _crUpdate = stateUpdate $ impulsiveAI $ chainCreatureUpdatesLR [ Left $ flockToPointUsing' (encircleDistP 100) (meleeHeadingMove 0.1 0.1 (pi/4) 3.9) - , Right $ (crMeleeCooldown %~ max 0 . subtract 1) + , Right (crMeleeCooldown %~ max 0 . subtract 1) , Left $ perceptionUpdate' [0] - , Right $ doStrategyActions - , Left $ targetYouWhenCognizant + , Right doStrategyActions + , Left targetYouWhenCognizant ] -- , doStrategyActions -- , targetYouWhenCognizant diff --git a/src/Dodge/Creature/Test.hs b/src/Dodge/Creature/Test.hs index d1c94db21..37db604a7 100644 --- a/src/Dodge/Creature/Test.hs +++ b/src/Dodge/Creature/Test.hs @@ -34,8 +34,8 @@ andTest f g a = f a && g a onBoth :: (a -> b -> c) -> (d -> a) -> (d -> b) -> d -> c onBoth f g h x = f (g x) (h x) -crIsReloading :: (World, Creature) -> Bool -crIsReloading (_,cr) = case cr ^? crInv . ix (_crInvSel cr) . itConsumption . reloadState . _Just' of +crIsReloading :: Creature -> Bool +crIsReloading cr = case cr ^? crInv . ix (_crInvSel cr) . itConsumption . reloadState . _Just' of Just t -> t > 0 _ -> False @@ -56,26 +56,23 @@ crCanSeeCID cid (w,cr) = hasLOS (_crPos cr) (_crPos $ _creatures w IM.! cid) w crCanSeeCIDR :: Int -> Creature -> Reader World Bool crCanSeeCIDR cid cr = reader $ \w -> hasLOS (_crPos cr) (_crPos $ _creatures w IM.! cid) w -crIsAiming :: (World,Creature) -> Bool -crIsAiming (_,cr) = _posture (_crStance cr) == Aiming +crIsAiming :: Creature -> Bool +crIsAiming cr = _posture (_crStance cr) == Aiming crIsAiming' :: Creature -> Bool crIsAiming' cr = _posture (_crStance cr) == Aiming -crIsAimingR :: Creature -> Reader World Bool -crIsAimingR cr = return $ _posture (_crStance cr) == Aiming - -crHasTarget :: (World,Creature) -> Bool -crHasTarget (_,cr) = isJust $ cr ^? crIntention . targetCr . _Just - crHasTarget' :: Creature -> Bool crHasTarget' cr = isJust $ cr ^? crIntention . targetCr . _Just -crHasTargetR :: Creature -> Reader World Bool -crHasTargetR cr = return $ isJust $ cr ^? crIntention . targetCr . _Just -crHasTargetLOS :: (World,Creature) -> Bool -crHasTargetLOS (w,cr) = case cr ^? crIntention . targetCr . _Just of +crHasTargetLOS :: World -> Creature -> Bool +crHasTargetLOS w cr = case cr ^? crIntention . targetCr . _Just of + Just i -> crCanSeeCr i (w,cr) + Nothing -> False + +crHasTargetLOS' :: World -> Creature -> Bool +crHasTargetLOS' w cr = case cr ^? crIntention . targetCr . _Just of Just i -> crCanSeeCr i (w,cr) Nothing -> False @@ -84,8 +81,8 @@ crHasTargetLOSR cr = reader $ \w -> case cr ^? crIntention . targetCr . _Just of Just i -> crCanSeeCr i (w,cr) Nothing -> False -crSafeDistFromTarg :: Float -> (World,Creature) -> Bool -crSafeDistFromTarg d (_,cr) = case cr ^? crIntention . targetCr . _Just of +crSafeDistFromTarg :: Float -> Creature -> Bool +crSafeDistFromTarg d cr = case cr ^? crIntention . targetCr . _Just of Just tcr -> dist (_crPos cr) (_crPos tcr) > d Nothing -> True @@ -103,8 +100,8 @@ crStratConMatches' strat cr = eqConstr strat (_crStrategy $ _crActionPlan cr) crStratConMatchesR :: Strategy -> Creature -> Reader World Bool crStratConMatchesR strat cr = return $ eqConstr strat (_crStrategy $ _crActionPlan cr) -crAwayFromPost :: (World,Creature) -> Bool -crAwayFromPost (_,cr) = case find sentinelGoal $ _crGoal $ _crActionPlan cr of +crAwayFromPost :: Creature -> Bool +crAwayFromPost cr = case find sentinelGoal $ _crGoal $ _crActionPlan cr of Just (SentinelAt p _) -> dist p (_crPos cr) > 15 _ -> False where @@ -119,8 +116,14 @@ crAwayFromPostR cr = return $ case find sentinelGoal $ _crGoal $ _crActionPlan c sentinelGoal (SentinelAt _ _) = True sentinelGoal _ = False -crHasAmmo :: (World,Creature) -> Bool -crHasAmmo (_,cr) = maybe False (> 0) $ cr ^? crInv . ix (_crInvSel cr) . itConsumption . ammoLoaded +crHasAmmo :: Creature -> Bool +crHasAmmo cr = maybe False (> 0) $ cr ^? crInv . ix (_crInvSel cr) . itConsumption . ammoLoaded -crCanShoot :: (World,Creature) -> Bool +crHasAmmo' :: Creature -> Bool +crHasAmmo' cr = maybe False (> 0) $ cr ^? crInv . ix (_crInvSel cr) . itConsumption . ammoLoaded + +crCanShoot :: Creature -> Bool crCanShoot p = crIsAiming p && crHasAmmo p + +crCanShoot' :: Creature -> Bool +crCanShoot' p = crIsAiming' p && crHasAmmo' p diff --git a/src/Dodge/Creature/Volition.hs b/src/Dodge/Creature/Volition.hs index 3325dd82c..b384186ba 100644 --- a/src/Dodge/Creature/Volition.hs +++ b/src/Dodge/Creature/Volition.hs @@ -23,7 +23,7 @@ fleeFrom cr mtcr = case mtcr of shootTillEmpty :: Action --shootTillEmpty = (crCanShoot `DoActionWhile` DoImpulses [UseItem]) -shootTillEmpty = (crCanShoot `DoActionWhile` DoImpulses [UseItem]) +shootTillEmpty = (const crCanShoot `DoActionWhile` DoImpulses [UseItem]) `DoActionThen` 20 `WaitThen` holsterWeapon --advanceShoot :: Int -> Action @@ -39,5 +39,5 @@ shootFirstMiss :: Action shootFirstMiss = LeadTarget (V2 30 50) `DoActionThen` DoImpulses [UseItem] `DoActionThen` - (crCanShoot `DoActionWhile` DoActions [LeadTarget (V2 0 0),DoImpulses [UseItem]]) + (const crCanShoot `DoActionWhile` DoActions [LeadTarget (V2 0 0),DoImpulses [UseItem]]) `DoActionThen` 20 `WaitThen` holsterWeapon diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index b7665cd03..f0c636efe 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -799,26 +799,26 @@ data Action ,_waitThenAction :: Action } | DoActionWhile - {_doActionWhileCondition :: (World, Creature) -> Bool + {_doActionWhileCondition :: World -> Creature -> Bool ,_doActionWhileAction :: Action } | DoActionWhilePartial {_doActionWhilePartial :: Action - ,_doActionWhileCondition :: (World, Creature) -> Bool + ,_doActionWhileCondition :: World -> Creature -> Bool ,_doActionWhileAction :: Action } | DoActionIf - {_doActionIfCondition :: (World, Creature) -> Bool + {_doActionIfCondition :: World -> Creature -> Bool ,_doActionIfAction :: Action } | DoActionIfElse {_doActionIfElseIfAction :: Action - ,_doActionIfElseCondition :: (World, Creature) -> Bool + ,_doActionIfElseCondition :: World -> Creature -> Bool ,_doActionIfElseElseAction :: Action } | DoActionWhileInterrupt {_doActionWhileThenDo :: Action - ,_doActionWhileThenCondition :: (World, Creature) -> Bool + ,_doActionWhileThenCondition :: World -> Creature -> Bool ,_doActionWhileThenThen :: Action } | DoActions diff --git a/src/Dodge/Debug/Terminal.hs b/src/Dodge/Debug/Terminal.hs index 8afc63435..ac77202f1 100644 --- a/src/Dodge/Debug/Terminal.hs +++ b/src/Dodge/Debug/Terminal.hs @@ -8,17 +8,17 @@ import Dodge.Creature.State import Control.Lens applyTerminalString :: String -> Universe -> Universe -applyTerminalString "NOCLIP" w = w & config . debug_noclip %~ not -applyTerminalString "LOADME" w = w & uvWorld . creatures . ix 0 . crInv .~ stackedInventory - & uvWorld . creatures . ix 0 . crInvCapacity .~ 50 ---applyTerminalString "GODON" u = u --- & uvWorld . creatures . ix 0 . crUpdate .~ (stateUpdateDamage' clearDamage yourControl) ---applyTerminalString "GODOFF" u = u & uvWorld . creatures . ix 0 . crUpdate .~ stateUpdate yourControl -applyTerminalString "LOADTEST" w = w & uvWorld . creatures . ix 0 . crInv .~ testInventory - & uvWorld . creatures . ix 0 . crInvCapacity .~ 50 -applyTerminalString "LM" w = applyTerminalString "LOADME" w -applyTerminalString "LT" w = applyTerminalString "LOADTEST" w -applyTerminalString _ w = w +applyTerminalString "NOCLIP" = config . debug_noclip %~ not +applyTerminalString "LOADME" = (uvWorld . creatures . ix 0 . crInv .~ stackedInventory) + . (uvWorld . creatures . ix 0 . crInvCapacity .~ 50) +applyTerminalString "GODON" = + uvWorld . creatures . ix 0 . crUpdate .~ stateUpdateDamage clearDamage yourControl +applyTerminalString "GODOFF" = uvWorld . creatures . ix 0 . crUpdate .~ stateUpdate yourControl +applyTerminalString "LOADTEST" = (uvWorld . creatures . ix 0 . crInv .~ testInventory) + . (uvWorld . creatures . ix 0 . crInvCapacity .~ 50) +applyTerminalString "LM" = applyTerminalString "LOADME" +applyTerminalString "LT" = applyTerminalString "LOADTEST" +applyTerminalString _ = id loadme :: a loadme = undefined diff --git a/src/Dodge/Placement/Instance/Turret.hs b/src/Dodge/Placement/Instance/Turret.hs index 6434389da..1140a73e7 100644 --- a/src/Dodge/Placement/Instance/Turret.hs +++ b/src/Dodge/Placement/Instance/Turret.hs @@ -12,7 +12,7 @@ import Dodge.FloorItem import Dodge.Wall.Delete import Dodge.WorldEvent.Explosion import Dodge.Item.Weapon.BatteryGuns -import Dodge.Item.Weapon.BulletGun.Cane +--import Dodge.Item.Weapon.BulletGun.Cane --import Dodge.SoundLogic.LoadSound --import Dodge.SoundLogic --import Dodge.Item.Draw @@ -37,7 +37,7 @@ putLasTurret rotSpeed = sps0 $ PutMachine blue (reverse $ square wdth) defaultMa lasTurret :: MachineType lasTurret = Turret --{ _tuWeapon = lasGun - { _tuWeapon = autoRifle + { _tuWeapon = lasGun , _tuTurnSpeed = 0.1 , _tuFireTime = 0 , _tuMCrID = Nothing @@ -50,13 +50,17 @@ updateTurret rotSpeed mc w & deleteWallIDs (_mcWallIDs mc) & makeExplosionAt mcpos & copyItemToFloor mcpos lasGun + & deleteHomonculus | otherwise = w & initHomonculus & dodamage & maybeFire & elecDamBranch where - initHomonculus w' = case w' ^? machines . ix mcid . mcType . tuMCrID . _Just of + deleteHomonculus = case _tuMCrID (_mcType mc) of + Nothing -> id + Just cid -> creatures . at cid .~ Nothing + initHomonculus w' = case w' ^? machines . ix mcid . mcType . tuMCrID . _Just of Nothing -> w' & machines . ix mcid . mcType . tuMCrID ?~ cid & creatures . at cid ?~ thecreature where @@ -73,7 +77,7 @@ updateTurret rotSpeed mc w & crPict .~ (\cr _ _ -> drawCrEquipment cr) -- & crPict .~ basicCrPict red -- & crUpdate .~ (\cr -> crUpCrUp stepReloading cr . invSideEff cr) - & crUpdate .~ stateUpdate (\cr w'' -> followImpulses w'' cr) + & crUpdate .~ stateUpdateDamage clearDamage (flip followImpulses) & crStance . posture .~ Aiming Just cid -> w' & creatures . ix cid . crPos .~ mcpos @@ -85,22 +89,11 @@ updateTurret rotSpeed mc w elecDamBranch | elecDam < 10 = updateFiringStatus . doTurn | otherwise = id - -- TODO make this use the same function as the lasgun - --it = _tuWeapon (_mcType mc) maybeFire | _tuFireTime (_mcType mc) > 0 - -- massive hack = fromMaybe id $ do cid <- _tuMCrID (_mcType mc) - --return $ useItem cid - -- return id return $ creatures . ix cid . crActionPlan . crImpulse .~ [UseItem] --- cr <- w ^? creatures . ix cid --- it <- cr ^? crInv . ix 0 --- return $ _rUse (_itUse it) it cr --- = _rUse (_itUse it) it (defaultCreature {_crPos = mcpos,_crDir = mcdir}) --- = ( particles .:~ makeLaserAt 5 (mcpos + 15 *.* unitVectorAtAngle mcdir) mcdir ) --- . soundContinue (MachineSound mcid) mcpos tone440sawtoothquietS (Just 1) | otherwise = id mcid = _mcID mc ypos = _crPos $ you w