diff --git a/src/Dodge/Base.hs b/src/Dodge/Base.hs index 2eff4a81b..64dd26121 100644 --- a/src/Dodge/Base.hs +++ b/src/Dodge/Base.hs @@ -494,4 +494,5 @@ evenOddSplit = foldr f ([],[]) f a (ls,rs) = (rs, a : ls) dbArg :: (a -> a -> b) -> a -> b +{-# INLINE dbArg #-} dbArg f x = f x x diff --git a/src/Dodge/Creature/ArmourChase.hs b/src/Dodge/Creature/ArmourChase.hs index 878986d23..349447f17 100644 --- a/src/Dodge/Creature/ArmourChase.hs +++ b/src/Dodge/Creature/ArmourChase.hs @@ -33,14 +33,14 @@ armourChaseCrit = defaultCreature targetYouWhenCognizantR >=> flockACCR >=> overrideMeleeCloseTargetR >=> - return . (crMeleeCooldown . _Just %~ max 0 . subtract 1) + return . (crMeleeCooldown %~ max 0 . subtract 1) , _crHP = 300 , _crPict = basicCrPict green , _crInv = IM.fromList [(0,frontArmour) ,(1,medkit 200) ] - , _crMeleeCooldown = Just 0 + , _crMeleeCooldown = 0 , _crGroup = ShieldGroup } diff --git a/src/Dodge/Creature/ChaseCrit.hs b/src/Dodge/Creature/ChaseCrit.hs index 279d75deb..8230ca6a6 100644 --- a/src/Dodge/Creature/ChaseCrit.hs +++ b/src/Dodge/Creature/ChaseCrit.hs @@ -36,16 +36,16 @@ chaseCrit :: Creature chaseCrit = defaultCreature { _crUpdate = stateUpdate $ --dummyUpdate impulsiveAIR $ - --doStrategyActionsR >=> - --performActionsR >=> - --overrideMeleeCloseTargetR >=> - --chaseTargetR targetYouLOS >=> - --basicPerceptionUpdateR [0] >=> - --targetYouWhenCognizantR >=> - return . (crMeleeCooldown . _Just %~ max 0 . subtract 1) + doStrategyActionsR >=> + performActionsR >=> + overrideMeleeCloseTargetR >=> + chaseTargetR targetYouLOS >=> + basicPerceptionUpdateR [0] >=> + targetYouWhenCognizantR >=> + return . (crMeleeCooldown %~ max 0 . subtract 1) , _crHP = 300 , _crPict = basicCrPict green , _crInv = IM.fromList [(0,medkit 200)] - , _crMeleeCooldown = Just 0 + , _crMeleeCooldown = 0 , _crFaction = ColorFaction green } diff --git a/src/Dodge/Creature/ImpulseRat.hs b/src/Dodge/Creature/ImpulseRat.hs index 66d6474ae..3bc571087 100644 --- a/src/Dodge/Creature/ImpulseRat.hs +++ b/src/Dodge/Creature/ImpulseRat.hs @@ -32,7 +32,7 @@ meleeHeadingMove meleeHeadingMove maxta minta tacutoff speed tp cr tcr | dist tpos cpos < combinedRad + 5 && abs (_crDir cr - argV (tpos -.- cpos)) < tacutoff - && _crMeleeCooldown cr == Just 0 + && _crMeleeCooldown cr == 0 = [Melee (_crID tcr), Turn pi] | dist tpos cpos < combinedRad + 5 && abs (_crDir cr - argV (tpos -.- cpos)) < tacutoff @@ -50,7 +50,7 @@ mvPointMeleeTarg :: Point2 -> Creature -> Creature -> [Impulse] mvPointMeleeTarg p cr crT | dist tpos cpos < combinedRad + 5 && abs (_crDir cr - argV (tpos -.- cpos)) < pi/4 - && _crMeleeCooldown cr == Just 0 + && _crMeleeCooldown cr == 0 = [Melee (_crID crT)] | dist tpos cpos < combinedRad + 5 && abs (_crDir cr - argV (tpos -.- cpos)) < pi/4 @@ -89,7 +89,7 @@ impulseShootAtTarg :: Creature -> Creature -> [Impulse] impulseShootAtTarg cr crT | dist tpos cpos < combinedRad + 5 && abs (_crDir cr - argV (tpos -.- cpos)) < pi/4 - && _crMeleeCooldown cr == Just 0 + && _crMeleeCooldown cr == 0 = [Melee (_crID crT)] | dist tpos cpos < combinedRad + 5 && abs (_crDir cr - argV (tpos -.- cpos)) < pi/4 diff --git a/src/Dodge/Creature/Picture.hs b/src/Dodge/Creature/Picture.hs index 65231b479..2f5b72ffd 100644 --- a/src/Dodge/Creature/Picture.hs +++ b/src/Dodge/Creature/Picture.hs @@ -142,9 +142,7 @@ naked col cr aimingOneHand = crIsAiming' cr && crIt ^? itAimStance == Just OneHand aimingTwist = crIsAiming' cr && crIt ^? itAimStance == Just TwoHandTwist crIt = _crInv cr IM.! _crInvSel cr - strikeMelee = case _crMeleeCooldown cr of - Nothing -> False - Just x -> x > 5 + strikeMelee = _crMeleeCooldown cr > 5 pdam = sum $ concatMap (map _dmAmount) pastDams crad = _crRad cr pastDams = _crPastDamage $ _crState cr diff --git a/src/Dodge/Creature/Rationality.hs b/src/Dodge/Creature/Rationality.hs index dac7e7866..0e92e4a13 100644 --- a/src/Dodge/Creature/Rationality.hs +++ b/src/Dodge/Creature/Rationality.hs @@ -29,7 +29,7 @@ impulsiveAIR -> Creature -> World -> (Endo World , Maybe Creature) -impulsiveAIR impf cr w = followImpulses w . ($ w) . runReader $ impf cr +impulsiveAIR impf cr w = bimap Endo Just $ followImpulses w . ($ w) . runReader $ impf cr --impulsiveAI -- :: (World -> Creature -> Creature) -- ^ Internal AI update, should determine impulses @@ -43,10 +43,9 @@ impulsiveAIR impf cr w = followImpulses w . ($ w) . runReader $ impf cr followImpulses :: World -> Creature - -> (Endo World, Maybe Creature) + -> (World -> World, Creature) followImpulses w cr - = (\(f''' ,cr') -> (Endo f''',Just cr')) - $ foldr + = foldr (\imp (f , cr') -> let (f'', cr'') = followImpulse cr' w imp in (f'' . f , cr'')) (id, cr) (_crImpulse $ _crActionPlan cr) @@ -67,7 +66,7 @@ followImpulse cr w imp = case imp of SwitchToItem i -> (id, cr & crInvSel .~ i) Melee cid -> (hitCr cid - , crMvBy (10 *.* normalizeV (posFromID cid -.- cpos)) $ cr & crMeleeCooldown ?~ 20) -- randomise cooldown? + , crMvBy (10 *.* normalizeV (posFromID cid -.- cpos)) $ cr & crMeleeCooldown .~ 20) -- randomise cooldown? RandomTurn a -> (id, creatureTurn (rr a) cr) MakeSound sid -> ( soundOnceOrigin sid (CrSound (_crID cr)) (_crPos cr) , cr ) DropItem -> undefined diff --git a/src/Dodge/Creature/ReaderUpdate.hs b/src/Dodge/Creature/ReaderUpdate.hs index afb91b96f..cbe080bbc 100644 --- a/src/Dodge/Creature/ReaderUpdate.hs +++ b/src/Dodge/Creature/ReaderUpdate.hs @@ -19,7 +19,7 @@ overrideMeleeCloseTargetR cr = return $ maybe cr (tryMeleeAttack cr) (_crTarget tryMeleeAttack :: Creature -> Creature -> Creature tryMeleeAttack cr tcr - | _crMeleeCooldown cr == Just 0 + | _crMeleeCooldown cr == 0 && dist (_crPos tcr) cpos < _crRad cr + _crRad tcr + 5 && abs (_crDir cr - argV (_crPos tcr -.- cpos)) < pi/4 -- = cr & crActionPlan . crStrategy .~ StrategyActions MeleeStrike meleeActions diff --git a/src/Dodge/Creature/State.hs b/src/Dodge/Creature/State.hs index d854c2d1b..294f31dea 100644 --- a/src/Dodge/Creature/State.hs +++ b/src/Dodge/Creature/State.hs @@ -75,8 +75,8 @@ velocity to carry across frames. crFriction :: Creature -> Point2 -> Point2 crFriction _ _ = V2 0 0 -meleeCooldown :: CRUpdate -> CRUpdate -meleeCooldown u cr = u $ cr & crMeleeCooldown . _Just %~ (max 0 . (\x -> x - 1)) +--meleeCooldown :: CRUpdate -> CRUpdate +--meleeCooldown u cr = u $ cr & crMeleeCooldown . _Just %~ (max 0 . (\x -> x - 1)) doDamage :: Creature -> Creature doDamage cr = set (crState . crDamage) [] diff --git a/src/Dodge/Creature/SwarmCrit.hs b/src/Dodge/Creature/SwarmCrit.hs index 57a2accfb..b0d7c5789 100644 --- a/src/Dodge/Creature/SwarmCrit.hs +++ b/src/Dodge/Creature/SwarmCrit.hs @@ -32,7 +32,7 @@ swarmCrit :: Creature swarmCrit = defaultCreature { _crUpdate = stateUpdate $ impulsiveAIR $ flockToPointUsing (encircleDistP 100) (meleeHeadingMove 0.1 0.1 (pi/4) 3.9) - >=> return . (crMeleeCooldown . _Just %~ max 0 . subtract 1) + >=> return . (crMeleeCooldown %~ max 0 . subtract 1) >=> basicPerceptionUpdateR [0] >=> doStrategyActionsR >=> targetYouWhenCognizantR @@ -45,7 +45,7 @@ swarmCrit = defaultCreature , _crPict = basicCrPict yellow , _crCorpse = onLayer CorpseLayer $ color (greyN 0.5) $ circleSolid 2 , _crFaction = ColorFaction yellow - , _crMeleeCooldown = Just 0 + , _crMeleeCooldown = 0 } --swarmCritMoveFunc :: Creature -> Point2 -> Creature -> Point2 diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index ff7fca6b7..3a941530a 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -72,7 +72,7 @@ data World = World , _mousePos :: !Point2 , _testString :: String , _yourID :: !Int - , _worldEvents :: !(World -> World) + , _worldEvents :: (World -> World) , _pressPlates :: IM.IntMap PressPlate , _buttons :: IM.IntMap Button , _soundQueue :: [(Int,Int16)] @@ -174,7 +174,7 @@ data Creature = Creature , _crApplyDamage :: [DamageType] -> Creature -> (World -> World,Creature) , _crStance :: Stance , _crActionPlan :: ActionPlan - , _crMeleeCooldown :: Maybe Int + , _crMeleeCooldown :: !Int , _crAwakeLevel :: AwakeLevel , _crAttentionDir :: AttentionDir , _crAwarenessLevel :: IM.IntMap AwarenessLevel diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index ab827e8d5..0f48f6c4d 100644 --- a/src/Dodge/Default.hs +++ b/src/Dodge/Default.hs @@ -47,7 +47,7 @@ defaultCreature = Creature ,_strideLength = 40 } , _crActionPlan = ActionPlan [] [] WatchAndWait [LiveLongAndProsper] - , _crMeleeCooldown = Nothing + , _crMeleeCooldown = 0 , _crAwakeLevel = Vigilant , _crAttentionDir = AttentiveTo [] , _crAwarenessLevel = IM.empty diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index de71572d7..a79fed76f 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -33,7 +33,7 @@ import Data.Monoid --import System.Random update :: World -> World -update = update' . pushSideEffects +update = functionalUpdate . pushSideEffects pushSideEffects :: World -> World pushSideEffects w = w @@ -42,8 +42,8 @@ pushSideEffects w = w {- | The update step. For most menus the only way to change the world is using event handling. -} -update' :: World -> World -update' w = case _menuLayers w of +functionalUpdate :: World -> World +functionalUpdate w = case _menuLayers w of (TerminalMessage t xs:mls) -> w & menuLayers .~ (TerminalMessage (max (t-1) 0) xs:mls) (WaitMessage s i: _) | i < 1 -> w & dbArg _worldEvents @@ -64,7 +64,7 @@ update' w = case _menuLayers w of . simpleCrSprings . zoneCreatures . updateWalls - . set worldEvents id + . resetWorldEvents . dbArg _worldEvents . updateParticles . updateProjectiles @@ -88,6 +88,9 @@ update' w = case _menuLayers w of where (x,y) = cloudZoneOfPoint $ _clPos cl +resetWorldEvents :: World -> World +resetWorldEvents w = w {_worldEvents = id} + updateCreatureGroups :: World -> World updateCreatureGroups w = w & creatureGroups %~ IM.mapMaybe (\cgp -> _crGroupUpdate cgp w cgp)