diff --git a/src/Dodge/Creature/Action.hs b/src/Dodge/Creature/Action.hs index b75d425d7..caad5a4d6 100644 --- a/src/Dodge/Creature/Action.hs +++ b/src/Dodge/Creature/Action.hs @@ -125,10 +125,10 @@ performAction cr w ac = case ac of StartSentinelPost -> ([AddGoal $ SentinelAt (cr ^. crPos . _xy) (_crDir cr)], Nothing) PathTo p -> performPathTo cr w p TurnToPoint p -> performTurnToA cr p - LeadTarget p -> case cr ^? crIntention . targetCr . _Just of - Just tcr -> ([TurnTo (tcr ^. crPos . _xy +.+ rotateV (_crDir tcr) p)], Nothing) - _ -> ([], Nothing) - UseTarget f -> performAction cr w $ doMCrAc f $ cr ^? crIntention . targetCr . _Just + LeadTarget p -> fromMaybe ([],Nothing) $ do + i <- cr ^? crIntention . targetCr . _Just + tcr <- w ^? cWorld . lWorld . creatures . ix i + return $ ([TurnTo (tcr ^. crPos . _xy +.+ rotateV (_crDir tcr) p)], Nothing) UseSelf f -> performAction cr w $ doCrAc f cr UseAheadPos f -> performAction cr w (doP2Ac f (cr ^. crPos . _xy +.+ 20 *.* unitVectorAtAngle (_crDir cr))) UseMvTargetPos f -> performAction cr w $ doMP2Ac f $ _mvToPoint $ _crIntention cr diff --git a/src/Dodge/Creature/Boid.hs b/src/Dodge/Creature/Boid.hs index 57197c609..461a1a4d0 100644 --- a/src/Dodge/Creature/Boid.hs +++ b/src/Dodge/Creature/Boid.hs @@ -1,5 +1,6 @@ module Dodge.Creature.Boid where +import Data.Maybe import Linear import Dodge.Creature.Radius import Control.Lens @@ -176,9 +177,10 @@ swarmUsingCenter :: World -> Creature -> Creature -swarmUsingCenter updT upd w cr = case _targetCr $ _crIntention cr of - Nothing -> upd cenp cr - Just tcr -> updT tcr cenp cr +swarmUsingCenter updT upd w cr = fromMaybe (upd cenp cr) $ do + i <- _targetCr $ _crIntention cr + tcr <- w ^? cWorld . lWorld . creatures . ix i + return $ updT tcr cenp cr where cid = _crID cr cenp = _crGroupCenter $ _creatureGroups (_lWorld (_cWorld w)) IM.! _crGroupID (_crGroup $ _creatures (_lWorld (_cWorld w)) IM.! cid) @@ -191,9 +193,10 @@ flockChaseTarget :: World -> Creature -> Creature -flockChaseTarget updT upd w cr = case _targetCr $ _crIntention cr of - Nothing -> upd crs cr - Just tcr -> updT tcr crs cr +flockChaseTarget updT upd w cr = fromMaybe (upd crs cr) $ do + i <- _targetCr $ _crIntention cr + tcr <- w ^? cWorld . lWorld . creatures . ix i + return $ updT tcr crs cr where is = _swarm $ _crGroup cr crs = IM.restrictKeys (w ^. cWorld . lWorld . creatures) is @@ -213,18 +216,18 @@ flockPointTarget f targFunc w cr = case targFunc cr w of crs = IM.restrictKeys (w ^. cWorld . lWorld . creatures) is p = f crTarg crs cr -flockToPointUsing :: - (Creature -> Point2 -> Creature -> Point2) -> - (Point2 -> Creature -> Creature -> [Impulse]) -> - Creature -> - Reader World Creature -flockToPointUsing pf mvf cr = reader $ \w -> case _targetCr $ _crIntention cr of - Nothing -> cr - Just tcr -> cr & crActionPlan . apImpulse .~ mvf ptarg cr tcr - where - cenp = w ^?! cWorld . lWorld . creatureGroups . ix (cr ^?! crGroup . crGroupID) . crGroupCenter - -- crGroupCenter $ _creatureGroups (_cWorld w) IM.! _crGroupID (_crGroup cr) - ptarg = pf tcr cenp cr +--flockToPointUsing :: +-- (Creature -> Point2 -> Creature -> Point2) -> +-- (Point2 -> Creature -> Creature -> [Impulse]) -> +-- Creature -> +-- Reader World Creature +--flockToPointUsing pf mvf cr = reader $ \w -> case _targetCr $ _crIntention cr of +-- Nothing -> cr +-- Just tcr -> cr & crActionPlan . apImpulse .~ mvf ptarg cr tcr +-- where +-- cenp = w ^?! cWorld . lWorld . creatureGroups . ix (cr ^?! crGroup . crGroupID) . crGroupCenter +-- -- crGroupCenter $ _creatureGroups (_cWorld w) IM.! _crGroupID (_crGroup cr) +-- ptarg = pf tcr cenp cr flockToPointUsing' :: (Creature -> Point2 -> Creature -> Point2) -> @@ -232,12 +235,13 @@ flockToPointUsing' :: World -> Creature -> Creature -flockToPointUsing' pf mvf w cr = case _targetCr $ _crIntention cr of - Nothing -> cr - Just tcr -> cr & crActionPlan . apImpulse .~ mvf ptarg cr tcr +flockToPointUsing' pf mvf w cr = fromMaybe cr $ do + i <- _targetCr $ _crIntention cr + tcr <- w ^? cWorld . lWorld . creatures . ix i + let ptarg = pf tcr cenp cr + return $ cr & crActionPlan . apImpulse .~ mvf ptarg cr tcr where cenp = w ^?! cWorld . lWorld . creatureGroups . ix (cr ^?! crGroup . crGroupID) . crGroupCenter - ptarg = pf tcr cenp cr flockFunc :: (Creature -> Point2 -> Creature -> Point2) -> diff --git a/src/Dodge/Creature/Impulse.hs b/src/Dodge/Creature/Impulse.hs index 29ab44a82..dc270f62e 100644 --- a/src/Dodge/Creature/Impulse.hs +++ b/src/Dodge/Creature/Impulse.hs @@ -2,6 +2,7 @@ module Dodge.Creature.Impulse (impulsiveAIBefore) where +import Data.Maybe import Linear import NewInt import Dodge.Creature.MoveType @@ -64,12 +65,14 @@ followImpulse cr w imp = case imp of ArbitraryImpulseFunction f -> crup $ doWdCrCr f w cr ArbitraryImpulse f -> followImpulse cr w (doCrWdImp f cr w) ArbitraryImpulseEffect f -> (doCrWdWd f cr, cr) - ImpulseUseTargetCID f -> case cr ^? crIntention . targetCr . _Just of - Just tcr -> followImpulse cr w (doIntImp f $ _crID tcr) - _ -> crup cr - ImpulseUseTarget f -> case cr ^? crIntention . targetCr . _Just of - Just tcr -> followImpulse cr w (doCrImp f tcr) - _ -> crup cr + ImpulseUseTargetCID f -> fromMaybe (crup cr) $ do + i <- cr ^? crIntention . targetCr . _Just + tcr <- w ^? cWorld . lWorld . creatures . ix i + return $ followImpulse cr w (doIntImp f $ _crID tcr) + ImpulseUseTarget f -> fromMaybe (crup cr) $ do + i <- cr ^? crIntention . targetCr . _Just + tcr <- w ^? cWorld . lWorld . creatures . ix i + return $ followImpulse cr w (doCrImp f tcr) ImpulseUseAheadPos f -> followImpulse cr w (doP2Imp f (cr ^. crPos . _xy +.+ 20 *.* unitVectorAtAngle (_crDir cr))) MvForward -> crup $ crMvForward speed (w ^. cWorld . lWorld) cr MvTurnToward p -> diff --git a/src/Dodge/Creature/Perception.hs b/src/Dodge/Creature/Perception.hs index 9400347b6..d316f990e 100644 --- a/src/Dodge/Creature/Perception.hs +++ b/src/Dodge/Creature/Perception.hs @@ -5,19 +5,19 @@ module Dodge.Creature.Perception ( visionCheck, ) where -import Control.Monad -import Dodge.Creature.Radius -import Linear import Control.Lens +import Control.Monad import qualified Data.Map.Strict as M import Data.Maybe import Dodge.Base.Collide +import Dodge.Creature.Radius import Dodge.Creature.Vocalization import Dodge.Data.World import Dodge.FloatFunction import Geometry.Data import Geometry.Vector import qualified IntMapHelp as IM +import Linear import RandomHelp import Sound.Data @@ -48,17 +48,18 @@ basicAwarenessUpdate cr = case _cpAttention $ _crPerception cr of & maybeBark where oldAwareness = _cpAwareness $ _crPerception cr - newAwareness - = (IM.mapMaybe decreaseAwareness . IM.unionWith combineAwareness is) + newAwareness = + (IM.mapMaybe decreaseAwareness . IM.unionWith combineAwareness is) oldAwareness - becomesCognizant - = any isCognizant $ IM.unionWith cogRaised oldAwareness newAwareness + becomesCognizant = + any isCognizant $ IM.unionWith cogRaised oldAwareness newAwareness thejitter = [RandomImpulse $ RandImpulseCircMove 1] maybeBark = fromMaybe id $ do guard becomesCognizant sid <- vocalizationTest cr - return $ crActionPlan . apAction - .~ [ ImpulsesList ( [Bark sid] : replicate 5 thejitter) ] + return $ + crActionPlan . apAction + .~ [ImpulsesList ([Bark sid] : replicate 5 thejitter)] -- TODO fold in randgen update, requires that this is a world to world function chaseCritAwarenessUpdate :: World -> Creature -> Creature @@ -73,26 +74,29 @@ chaseCritAwarenessUpdate w cr = case _cpAttention $ _crPerception cr of & maybeBark where oldAwareness = _cpAwareness $ _crPerception cr - newAwareness = (IM.mapMaybe decreaseAwareness . IM.unionWith combineAwareness is) - oldAwareness - becomesCognizant = any isCognizant - $ IM.unionWith cogRaised oldAwareness newAwareness + newAwareness = + (IM.mapMaybe decreaseAwareness . IM.unionWith combineAwareness is) + oldAwareness + becomesCognizant = + any isCognizant $ + IM.unionWith cogRaised oldAwareness newAwareness thejitter = [RandomImpulse $ RandImpulseCircMove 3] - maybeBark - | becomesCognizant -- && randBool - && cr ^? crVocalization . vcCoolDown == Just 0 = - let soundid = evalState (takeOne (crWarningSounds cr)) (_randGen w) - numjits = fst $ randomR (15, 25) (_randGen w) - in (crActionPlan . apStrategy .~ WarningCry) - . (crActionPlan . apAction .~ - [ ImpulsesList - ( [Bark soundid] : - replicate numjits thejitter - ++ [[ChangeStrategy $ CloseToMelee 0]] - ) - , AimAt 0 (w ^?! cWorld . lWorld . creatures . ix 0 . crPos . _xy) - ]) - | otherwise = id + maybeBark = fromMaybe id $ do + guard $ becomesCognizant + guard $ cr ^? crVocalization . vcCoolDown == Just 0 + let soundid = evalState (takeOne (crWarningSounds cr)) (_randGen w) + numjits = fst $ randomR (15, 25) (_randGen w) + return $ + (crActionPlan . apStrategy .~ WarningCry) + . ( crActionPlan . apAction + .~ [ ImpulsesList + ( [Bark soundid] : + replicate numjits thejitter + ++ [[ChangeStrategy $ CloseToMelee 0]] + ) + , AimAt 0 (w ^?! cWorld . lWorld . creatures . ix 0 . crPos . _xy) + ] + ) cogRaised :: Awareness -> Awareness -> Awareness cogRaised Suspicious{} Cognizant{} = Cognizant 100 @@ -153,7 +157,6 @@ visionCheck cr tpos = doFloatFloat (_viFOV vi) ang * doFloatFloat (_viDist vi) d dirvec = unitVectorAtAngle (_crDir cr) ang = angleVV dirvec (tpos - (cpos - crRad (cr ^. crType) *^ dirvec)) d = dist tpos cpos - awakeLevelPerception :: Creature -> Float awakeLevelPerception cr = case _cpVigilance $ _crPerception cr of diff --git a/src/Dodge/Creature/ReaderUpdate.hs b/src/Dodge/Creature/ReaderUpdate.hs index 9202dddf7..c4ec90d70 100644 --- a/src/Dodge/Creature/ReaderUpdate.hs +++ b/src/Dodge/Creature/ReaderUpdate.hs @@ -32,8 +32,10 @@ import LensHelp import Linear import RandomHelp -overrideMeleeCloseTarget :: Creature -> Creature -overrideMeleeCloseTarget cr = maybe cr (tryMeleeAttack cr) (_targetCr $ _crIntention cr) +overrideMeleeCloseTarget :: World -> Creature -> Creature +overrideMeleeCloseTarget w cr = maybe cr (tryMeleeAttack cr) $ do + i <- _targetCr $ _crIntention cr + w ^? cWorld . lWorld . creatures . ix i tryMeleeAttack :: Creature -> Creature -> Creature tryMeleeAttack cr tcr @@ -58,7 +60,8 @@ setMvPos w cr = cr & crIntention . mvToPoint .~ mpos where int = _crIntention cr mtpos = do - tpos <- (^. crPos . _xy) <$> _targetCr int + i <- int ^. targetCr + tpos <- w ^? cWorld . lWorld . creatures . ix i . crPos . _xy guard $ hasLOSIndirect (cr ^. crPos . _xy) tpos w return tpos mpos = mtpos <|> _mvToPoint int @@ -90,29 +93,29 @@ setTargetMv targFunc w cr = -- ugly flockACC :: World -> Creature -> Creature -flockACC w cr = case cr ^? crIntention . targetCr . _Just of - Nothing -> cr - Just tcr -> - let tpos = tcr ^. crPos . _xy - cpos = cr ^. crPos . _xy - isFarACC cr' = - _crGroup cr' == _crGroup cr - && _crID cr' /= _crID cr - && dist (cr' ^. crPos . _xy) tpos > dist cpos tpos - macr = - safeMinimumOn (dist cpos . (^. crPos . _xy)) - . filter isFarACC - $ crsNearCirc cpos 50 w - in case macr of - Nothing -> cr - Just acr -> - let r = crRad (acr ^. crType) + crRad (cr ^. crType) + 10 - horDir = normalizeV (vNormal (cpos -.- tpos)) - horShift = - if isLHS tpos cpos (acr ^. crPos . _xy) - then r *.* horDir - else negate r *.* horDir - in cr & crIntention . mvToPoint ?~ tpos +.+ horShift +flockACC w cr = fromMaybe cr $ do + i <- cr ^. crIntention . targetCr + tcr <- w ^? cWorld . lWorld . creatures . ix i + let tpos = tcr ^. crPos . _xy + cpos = cr ^. crPos . _xy + isFarACC cr' = + _crGroup cr' == _crGroup cr + && _crID cr' /= _crID cr + && dist (cr' ^. crPos . _xy) tpos > dist cpos tpos + macr = + safeMinimumOn (dist cpos . (^. crPos . _xy)) + . filter isFarACC + $ crsNearCirc cpos 50 w + return $ case macr of + Nothing -> cr + Just acr -> + let r = crRad (acr ^. crType) + crRad (cr ^. crType) + 10 + horDir = normalizeV (vNormal (cpos -.- tpos)) + horShift = + if isLHS tpos cpos (acr ^. crPos . _xy) + then r *.* horDir + else negate r *.* horDir + in cr & crIntention . mvToPoint ?~ tpos +.+ horShift chaseCritMv :: World -> Creature -> Creature chaseCritMv w cr = case _apStrategy (_crActionPlan cr) of @@ -203,7 +206,7 @@ targetYouWhenCognizant w cr = case cr ^? crPerception . cpAwareness . ix 0 of Just (Cognizant _) -> (w ^?! cWorld . lWorld . creatures . ix 0) `seq` cr - & crIntention . targetCr ?~ (w ^?! cWorld . lWorld . creatures . ix 0) + & crIntention . targetCr ?~ 0 & crPerception . cpVigilance .~ Vigilant _ -> cr & crIntention . targetCr .~ Nothing diff --git a/src/Dodge/Creature/SentinelAI.hs b/src/Dodge/Creature/SentinelAI.hs index 8e8153a77..85897b0a8 100644 --- a/src/Dodge/Creature/SentinelAI.hs +++ b/src/Dodge/Creature/SentinelAI.hs @@ -38,10 +38,9 @@ sentinelAI = ] ) ] --- w where advanceShoot = DoImpulses [UseItem, MoveForward 3] - tcid cr = _crID <$> _targetCr (_crIntention cr) + tcid cr = _targetCr (_crIntention cr) lostest = WdCrLOSTarget -- w' cr = maybe False (\cid -> canSee (_crID cr) cid w') (tcid cr) --chainCreatureUpdates :: [World -> Creature -> Creature] -> World -> Creature -> Creature diff --git a/src/Dodge/Creature/SetTarget.hs b/src/Dodge/Creature/SetTarget.hs index c213d845d..769a4de9c 100644 --- a/src/Dodge/Creature/SetTarget.hs +++ b/src/Dodge/Creature/SetTarget.hs @@ -6,11 +6,7 @@ import Dodge.Data.World --import MaybeHelp -- | Assumes that you are id 0: if creature is cognizant of you, sets you as target -targetYouWhenCognizant :: - World -> - Creature -> - Creature -targetYouWhenCognizant w cr = case cr ^? crPerception . cpAwareness . ix 0 of - --Just (Cognizant _) -> cr & crIntention . targetCr ?~ _creatures (_cWorld w) IM.! 0 - Just (Cognizant _) -> cr & crIntention . targetCr ?~ (w ^?! cWorld . lWorld . creatures . ix 0) +targetYouWhenCognizant :: World -> Creature -> Creature +targetYouWhenCognizant _ cr = case cr ^? crPerception . cpAwareness . ix 0 of + Just (Cognizant _) -> cr & crIntention . targetCr ?~ 0 _ -> cr & crIntention . targetCr .~ Nothing diff --git a/src/Dodge/Creature/Test.hs b/src/Dodge/Creature/Test.hs index 702ea9bb4..2187da7fc 100644 --- a/src/Dodge/Creature/Test.hs +++ b/src/Dodge/Creature/Test.hs @@ -66,14 +66,16 @@ crHasTarget :: Creature -> Bool crHasTarget cr = isJust $ cr ^? crIntention . targetCr . _Just crHasTargetLOS :: World -> Creature -> Bool -crHasTargetLOS w cr = case cr ^? crIntention . targetCr . _Just of - Just i -> crCanSeeCr i (w, cr) - Nothing -> False +crHasTargetLOS w cr = fromMaybe False $ do + i <- cr ^. crIntention . targetCr + tcr <- w ^? cWorld . lWorld . creatures . ix i + return $ crCanSeeCr tcr (w, cr) -crSafeDistFromTarg :: Float -> Creature -> Bool -crSafeDistFromTarg d cr = case cr ^? crIntention . targetCr . _Just of - Just tcr -> dist (cr ^. crPos . _xy) (tcr ^. crPos . _xy) > d - Nothing -> True +crSafeDistFromTarg :: World -> Float -> Creature -> Bool +crSafeDistFromTarg w d cr = fromMaybe True $ do + i <- cr ^? crIntention . targetCr . _Just + tcr <- w ^? cWorld . lWorld . creatures . ix i + return $ dist (cr ^. crPos . _xy) (tcr ^. crPos . _xy) > d crStratConMatches :: Strategy -> Creature -> Bool crStratConMatches strat cr = strat == _apStrategy (_crActionPlan cr) diff --git a/src/Dodge/CreatureEffect.hs b/src/Dodge/CreatureEffect.hs index be2ce93f4..7e4e03585 100644 --- a/src/Dodge/CreatureEffect.hs +++ b/src/Dodge/CreatureEffect.hs @@ -44,8 +44,8 @@ doWdCrBl wcb = case wcb of maybe False (\cid -> canSee (_crID cr) cid w) - (_crID <$> _targetCr (_crIntention cr)) - WdCrSafeDistFromTarget x -> \_ -> crSafeDistFromTarg x -- currently ignores walls etc + (_targetCr (_crIntention cr)) + WdCrSafeDistFromTarget x -> \w -> crSafeDistFromTarg w x -- currently ignores walls etc doCrBl :: CrBl -> Creature -> Bool doCrBl cb = case cb of @@ -55,18 +55,14 @@ doCrBl cb = case cb of CrIsAiming -> crIsAiming CrIsAnimate -> isAnimate -doMCrAc :: MCrAc -> Maybe Creature -> Action -doMCrAc mca = case mca of - MCrNoAction -> const ActionNothing - doCrAc :: CrAc -> Creature -> Action doCrAc ca = case ca of CrTurnAround -> \cr -> TurnToPoint (cr ^. crPos . _xy -.- 10 *.* unitVectorAtAngle (_crDir cr)) - CrFleeFromTarget -> fleeFromTarget +-- CrFleeFromTarget -> fleeFromTarget -fleeFromTarget :: Creature -> Action -fleeFromTarget cr = fleeFrom cr (_targetCr (_crIntention cr)) +--fleeFromTarget :: Creature -> Action +--fleeFromTarget cr = fleeFrom cr (_targetCr (_crIntention cr)) doP2Ac :: P2Ac -> Point2 -> Action doP2Ac p2a = case p2a of diff --git a/src/Dodge/Data/ActionPlan.hs b/src/Dodge/Data/ActionPlan.hs index 109dd2015..3c47f61a6 100644 --- a/src/Dodge/Data/ActionPlan.hs +++ b/src/Dodge/Data/ActionPlan.hs @@ -149,9 +149,6 @@ data Action } | NoAction | StartSentinelPost - | UseTarget - { _useTarget :: MCrAc - } | UseSelf { _useSelf :: CrAc } diff --git a/src/Dodge/Data/Creature.hs b/src/Dodge/Data/Creature.hs index 0b5f2eb24..dafc1c031 100644 --- a/src/Dodge/Data/Creature.hs +++ b/src/Dodge/Data/Creature.hs @@ -74,7 +74,7 @@ data CrHP | CrIsPitted data Intention = Intention - { _targetCr :: Maybe Creature + { _targetCr :: Maybe Int , _mvToPoint :: Maybe Point2 , _viewPoint :: Maybe Point2 } diff --git a/src/Dodge/Data/CreatureEffect.hs b/src/Dodge/Data/CreatureEffect.hs index 9692e4895..a32752df6 100644 --- a/src/Dodge/Data/CreatureEffect.hs +++ b/src/Dodge/Data/CreatureEffect.hs @@ -42,12 +42,9 @@ data CrBl | CrIsAnimate deriving (Eq, Ord, Show, Read) --Generic, Flat) -data MCrAc = MCrNoAction - deriving (Eq, Ord, Show, Read) --Generic, Flat) - data CrAc = CrTurnAround - | CrFleeFromTarget +-- | CrFleeFromTarget deriving (Eq, Ord, Show, Read) --Generic, Flat) data P2Ac = P2NoAction @@ -70,7 +67,6 @@ deriveJSON defaultOptions ''CrImp deriveJSON defaultOptions ''P2Imp deriveJSON defaultOptions ''CrBl deriveJSON defaultOptions ''WdCrBl -deriveJSON defaultOptions ''MCrAc deriveJSON defaultOptions ''CrAc deriveJSON defaultOptions ''P2Ac deriveJSON defaultOptions ''MP2Ac diff --git a/src/Dodge/Humanoid.hs b/src/Dodge/Humanoid.hs index 9f6ce53c4..6ba3cc6ec 100644 --- a/src/Dodge/Humanoid.hs +++ b/src/Dodge/Humanoid.hs @@ -17,7 +17,7 @@ updateHumanoid cr = case cr ^?! crType of humanoidAIList [ const doStrategyActions , performActions - , const overrideMeleeCloseTarget + , overrideMeleeCloseTarget , setViewPos , setMvPos , chaseCritMv