diff --git a/src/Dodge/AIs.hs b/src/Dodge/AIs.hs index f80f5e863..e4ad970c6 100644 --- a/src/Dodge/AIs.hs +++ b/src/Dodge/AIs.hs @@ -1,17 +1,15 @@ module Dodge.AIs - ( basicShooterAI - , twitchMissAI + ( twitchMissAI , launcherAI , chargeAI , sniperAI , dodgeAI - , miniAI , spawnerAI ) where import Dodge.Creature.Stance.Data import Dodge.Creature.State.Data import Dodge.Creature.Impulse.Data -import Dodge.Data +import Dodge.Data hiding (Action (..), Impulse (..), Strategy (..)) import Dodge.Base import Dodge.Path import Dodge.SoundLogic @@ -64,7 +62,7 @@ addImpulse newActions = over (crState . goals) (\(as:ass) -> (newActions++as):as factionIs :: Faction -> Creature -> Bool -factionIs f c = (_faction $ _crState $ c) == f +factionIs f c = (_crFaction $ c) == f lineOrth :: Point2 -> IM.IntMap Creature -> Point2 -> Point2 lineOrth ypos crs cpos = p @@ -228,7 +226,7 @@ spawnerAI spawn w (f,g) cr = addImpulse newActions = Just . over (crState . goals) (\(as:ass) -> (newActions++as):ass) - needChild = length (filter (\cr' -> (cr' ^? crState . faction) == Just (SpawnedBy cid)) + needChild = length (filter (\cr' -> (cr' ^? crFaction) == Just (SpawnedBy cid)) $ IM.elems $ _creatures w) < 15 spawnChild = placeCrFaction spawn (SpawnedBy cid) (cpos +.+ rotateV dir (1,0)) cpos (_crDir cr) @@ -248,117 +246,11 @@ spawnerAI spawn w (f,g) cr = placeCrFaction :: Creature -> Faction -> Point2 -> Point2 -> Float -> World -> World placeCrFaction cr fact p op rot w = over creatures addCr w where addCr crs = IM.insert (Dodge.Base.newKey crs) - ( set (crState . faction) fact + ( set crFaction fact $ cr {_crPos = p,_crOldPos = op,_crDir = rot,_crID = Dodge.Base.newKey crs} ) crs --- be aware that the crit can be removed -- don't just refer to its id in the --- world->world part -miniAI :: World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature) -miniAI w (f,g) cr = - let cpos = _crPos cr - cid = _crID cr - ypos = _crPos $ you w - wp = _crInv cr IM.! _crInvSel cr - (aimtime,g1) = randomR (80,120) g - noAmmo = 0 == _wpLoadedAmmo wp - turnCloseSlow p | errorAngleVV 22 (p -.- cpos) - (unitVectorAtAngle (_crDir cr)) < 0.4 - = crTurnTowardSpeed 0.01 p - | otherwise = crTurnTowardSpeed 0.05 p - replaceGoal newImpulses = Just . over (crState . goals) (\gs -> newImpulses ++ tail gs) - addGoal newImpulses = Just . over (crState . goals) (\gs -> newImpulses ++ gs) - replaceImpulse newActions - = Just . over (crState . goals) (\((_:as):ass) -> (newActions ++ as):ass) - addImpulse newActions - = Just . over (crState . goals) (\(as:ass) -> (newActions++as):ass) --- autoFireTweak p | _wpIsAuto wp = Just --- | otherwise = replaceGoal [[AimAt p (_itUseRate wp * 2)]] - in --if _crHP cr <= 0 then killCr w f cr else - case head $ _goals $ _crState cr of - [] | canSeeFire cpos ypos w -> ( ( f , g1 ) - , replaceGoal [[AimAt ypos aimtime]] cr - ) - | otherwise -> ( ( f , g ) - , replaceGoal [] cr - ) - (WaitFor x:gls)| canSeeFire cpos ypos w -> ( ( f , g1 ) - , replaceGoal [[AimAt ypos aimtime]] cr - ) - | x == 0 -> ( (f ,g ), replaceImpulse [] cr ) - | otherwise -> ( (f ,g ), replaceImpulse [WaitFor (x-1)] cr ) - (MoveToFor p x:gls) - | canSeeFire cpos ypos w -> ( (f , g1) - , replaceGoal [[AimAt ypos aimtime]] cr - ) - | x == 0 -> ( (f , g) - , replaceImpulse [] cr - ) - | dist p cpos < 10 -> ( (f , g) , replaceImpulse [] cr) - | angleVV (unitVectorAtAngle (_crDir cr)) (p -.- cpos) > pi/4 - -> ( (f , g) - , replaceImpulse [MoveToFor p (x-1)] $ crTurnTowardSpeed 0.05 p cr ) - | otherwise -> ( (f , g) - , replaceImpulse [MoveToFor p (x-1)] $ crMvForward 2 - $ crTurnTowardSpeed 0.05 p cr ) - (PathTo p:_) | dist p cpos < 10 -> ( (f , g) , replaceImpulse [] cr ) - | hasLOS cpos p w -> ( (f , g) , addImpulse [MoveToFor p 100] cr ) - | otherwise -> case pointTowardsImpulse cpos p w of - Just q -> ( (f , g) , addImpulse [MoveToFor q 100] cr ) - _ -> ( (f , g) , replaceImpulse [] cr ) - (FireAt p:gls) | noAmmo -> ( (tryUseItem cid . f , g ) - , replaceGoal [[Reload - ,PathTo p - ,WaitFor 50 - --,Search 1 ,WaitFor 100 - ]] - cr - ) - | canSeeFireVisionAll cid (_yourID w) w - -> ( (tryUseItem cid . f , g) - , replaceGoal [[FireAt ypos]] $ turnCloseSlow p cr - ) - | pathToPointFireable cid p w - -> ( (tryUseItem cid . f , g) - , Just $ turnCloseSlow p cr - ) - | otherwise -> ( (f , g) - , replaceGoal [[PathTo p,WaitFor 50 ]] cr - ) - (Reload:gls) | _wpReloadState wp == 0 -> ( (f , g) , replaceImpulse [] cr ) - | canSeeFireVisionAny cid (_yourID w) w - -> ( (f , g) - , Just $ turnCloseSlow ypos cr - ) -- no longer chase if see you when reloading - -- $ replaceImpulse [] w - | otherwise -> ( (f , g) , Just cr) - (Search i:gls) | i == 0 -> ( (f , g) , replaceImpulse [] cr) - | otherwise - -> ( ( f , g1) - , replaceImpulse [ PathTo (randomPointXStepsFrom 3 cpos w) - , Search (i-1) - ] cr - ) - (Guard p p':_) | dist ypos cpos < 900 && canSeeFireVisionAny cid (_yourID w) w - -> ( ( f , g1) - , addGoal [[AimAt ypos (0)]] cr - ) - | dist cpos p > 10 - -> ( (f,g) , addGoal [[PathTo p]] cr) - | errorAngleVV 21 (unitVectorAtAngle (_crDir cr)) (p' -.- p) > pi/8 - -> ( (f,g) - ,Just $ crTurnTowardSpeed 0.05 p' cr) - | otherwise -> ( (f,g) ,Just cr) - (InitGuard :_) -> ( (f,g) - ,replaceGoal [[Guard cpos (cpos +.+ 50 *.* unitVectorAtAngle (_crDir cr))]] cr - ) - (AimAt p i:_) | i == 0 -> ( (f,g) , replaceImpulse [FireAt p] cr ) - | canSeeFireVisionAll cid (_yourID w) w - -> ( (f,g) , replaceImpulse [AimAt ypos (i-1)] $ turnCloseSlow p cr) - | otherwise - -> ( (f,g) , replaceImpulse [AimAt p (i-1)] $ turnCloseSlow p cr) - strafeOrChargeAI :: Float -> Float -> World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature) strafeOrChargeAI inRange outRange w (f,g) cr = let cpos = _crPos cr @@ -1316,106 +1208,6 @@ suppressShooterAI w (f,g) cr = | otherwise -> ( (f,g) , replaceImpulse [AimAt p (i-1)] $ turnCloseSlow p cr) -basicShooterAI :: World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature) -basicShooterAI w (f,g) cr = - let cpos = _crPos cr - cid = _crID cr - ypos = _crPos $ you w - wp = _crInv cr IM.! _crInvSel cr - (aimtime,g1) = randomR (60,80) g - noAmmo = 0 == _wpLoadedAmmo wp - turnCloseSlow p | errorAngleVV 22 (p -.- cpos) - (unitVectorAtAngle (_crDir cr)) < 0.4 - = crTurnTowardSpeed 0.01 p - | otherwise = crTurnTowardSpeed 0.05 p - replaceGoal newImpulses = Just . over (crState . goals) (\gs -> newImpulses ++ tail gs) - addGoal newImpulses = Just . over (crState . goals) (\gs -> newImpulses ++ gs) - replaceImpulse newActions - = Just . over (crState . goals) (\((_:as):ass) -> (newActions ++ as):ass) - addImpulse newActions - = Just . over (crState . goals) (\(as:ass) -> (newActions++as):ass) - in case head $ _goals $ _crState cr of - [] | canSeeFire cpos ypos w -> ( ( f , g1 ) - , replaceGoal [[AimAt ypos aimtime]] cr - ) - | otherwise -> ( ( f , g ) - , replaceGoal [] cr - ) - (WaitFor x:gls)| canSeeFire cpos ypos w -> ( ( f , g1 ) - , replaceGoal [[AimAt ypos aimtime]] cr - ) - | x == 0 -> ( (f ,g ), replaceImpulse [] cr ) - | otherwise -> ( (f ,g ), replaceImpulse [WaitFor (x-1)] cr ) - (MoveToFor p x:gls) - | canSeeFire cpos ypos w -> ( (f , g1) - , replaceGoal [[AimAt ypos aimtime]] cr - ) - | x == 0 -> ( (f , g) - , replaceImpulse [] cr - ) - | dist p cpos < 10 -> ( (f , g) , replaceImpulse [] cr) - | angleVV (unitVectorAtAngle (_crDir cr)) (p -.- cpos) > pi/4 - -> ( (f , g) - , replaceImpulse [MoveToFor p (x-1)] $ crTurnTowardSpeed 0.05 p cr ) - | otherwise -> ( (f , g) - , replaceImpulse [MoveToFor p (x-1)] $ crMvForward 2 - $ crTurnTowardSpeed 0.05 p cr ) - (PathTo p:_) | dist p cpos < 10 -> ( (f , g) , replaceImpulse [] cr ) - | hasLOS cpos p w -> ( (f , g) , addImpulse [MoveToFor p 100] cr ) - | otherwise -> case pointTowardsImpulse cpos p w of - Just q -> ( (f , g) , addImpulse [MoveToFor q 100] cr ) - _ -> ( (f , g) , replaceImpulse [] cr ) - (FireAt p:gls) | noAmmo -> ( (tryUseItem cid . f , g ) - , replaceGoal [[Reload - ,PathTo p - ,WaitFor 50 - --,Search 1 ,WaitFor 100 - ]] - cr - ) - | canSeeFireVisionAll cid (_yourID w) w - -> ( (tryUseItem cid . f , g) - , replaceGoal [[FireAt ypos]] $ turnCloseSlow p cr - ) - | pathToPointFireable cid p w - -> ( (tryUseItem cid . f , g) - , Just $ turnCloseSlow p cr - ) - | otherwise -> ( (f , g) - , replaceGoal [[PathTo p,WaitFor 50 ]] cr - ) - (Reload:gls) | _wpReloadState wp == 0 -> ( (f , g) , replaceImpulse [] cr ) - | canSeeFireVisionAny cid (_yourID w) w - -> ( (f , g) - , Just $ turnCloseSlow ypos cr - ) -- no longer chase if see you when reloading - -- -$ replaceImpulse [] w - | otherwise -> ( (f , g) , Just cr) - (Search i:gls) | i == 0 -> ( (f , g) , replaceImpulse [] cr) - | otherwise - -> ( ( f , g1) - , replaceImpulse [ PathTo (randomPointXStepsFrom 3 cpos w) - , Search (i-1) - ] cr - ) - (Guard p p':_) | dist ypos cpos < 900 && canSeeFireVisionAny cid (_yourID w) w - -> ( ( f , g1) - , addGoal [[AimAt ypos (2*aimtime)]] cr - ) - | dist cpos p > 10 - -> ( (f,g) , addGoal [[PathTo p]] cr) - | errorAngleVV 21 (unitVectorAtAngle (_crDir cr)) (p' -.- p) > pi/8 - -> ( (f,g) - ,Just $ crTurnTowardSpeed 0.05 p' cr) - | otherwise -> ( (f,g) ,Just cr) - (InitGuard :_) -> ( (f,g) - ,replaceGoal [[Guard cpos (cpos +.+ 50 *.* unitVectorAtAngle (_crDir cr))]] cr - ) - (AimAt p i:_) | i == 0 -> ( (f,g) , replaceImpulse [FireAt p] cr ) - | canSeeFireVisionAll cid (_yourID w) w - -> ( (f,g) , replaceImpulse [AimAt ypos (i-1)] $ turnCloseSlow p cr) - | otherwise - -> ( (f,g) , replaceImpulse [AimAt p (i-1)] $ turnCloseSlow p cr) sniperAI :: World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature) sniperAI w (f,g) cr = diff --git a/src/Dodge/Base.hs b/src/Dodge/Base.hs index 054419027..486640ea2 100644 --- a/src/Dodge/Base.hs +++ b/src/Dodge/Base.hs @@ -58,6 +58,11 @@ aCrPos i w = _crPos $ _creatures w IM.! i yourItem :: World -> Item yourItem w = _crInv (you w) IM.! _crInvSel (you w) +crItem :: World -> Int -> Item +crItem w cid = _crInv cr IM.! _crInvSel cr + where + cr = _creatures w IM.! cid + yourItemRef w = (creatures . ix (_yourID w) . crInv . ix (_crInvSel (you w))) wallNormal :: Wall -> Point2 @@ -495,3 +500,9 @@ mvPointToward mvPointToward !ep !p | dist p ep < 1 = ep | otherwise = p +.+ normalizeV (ep -.- p) + +isAnimate :: Creature -> Bool +{-# INLINE isAnimate #-} +isAnimate cr = case _crActionPlan cr of + Inanimate -> False + _ -> True diff --git a/src/Dodge/Creature.hs b/src/Dodge/Creature.hs index d4bb4234c..ca7dbc432 100644 --- a/src/Dodge/Creature.hs +++ b/src/Dodge/Creature.hs @@ -10,6 +10,8 @@ import Dodge.Creature.ImpulseRat import Dodge.Creature.ActionRat import Dodge.Creature.Rationality.Data import Dodge.Creature.AlertLevel +import Dodge.Creature.SetTarget +import Dodge.Creature.Test import Dodge.Data import Dodge.AIs import Dodge.Default @@ -64,10 +66,10 @@ smallChaseCrit = defaultCreature , _crPict = basicCrPict green , _crState = defaultState {_goals = [[Wait]] - ,_faction = ChaseCritters } , _crInv = IM.empty -- IM.fromList [(0,frontArmour)] , _crCorpse = onLayer CorpseLayer $ color (greyN 0.5) $ circleSolid 4 + , _crFaction = ColorFaction green } chaseCrit :: Creature chaseCrit = defaultCreature @@ -76,10 +78,10 @@ chaseCrit = defaultCreature , _crPict = basicCrPict green , _crState = defaultState {_goals = [[Wait]] - ,_faction = ChaseCritters } , _crInv = IM.empty , _crMeleeCooldown = Just 0 + , _crFaction = ColorFaction green } armourChaseCrit :: Creature armourChaseCrit = defaultCreature @@ -92,12 +94,12 @@ armourChaseCrit = defaultCreature ,(1,medkit 200) ] } -miniGunCrit' :: Creature -miniGunCrit' = defaultCreature +miniGunCrit :: Creature +miniGunCrit = defaultCreature { _crPict = basicCrPict red , _crUpdate = stateUpdate $ impulsiveAI $ composeInternalAIs - [ actionUpdateAI performActions - , shootAtTarget targetYouCognizant + [ performActions + , shootTargetWithStrat targetYouCognizant suppress , basicPerceptionUpdate [0] ] , _crInv = IM.fromList [(0,miniGun)] @@ -105,20 +107,6 @@ miniGunCrit' = defaultCreature , _crRad = 10 , _crState = defaultState , _crHP = 500 - , _crRationality = ActionRat - { _crImpulse = [] - , _crAction = [AimAtCloseSlow 0 (0,0) 0.2 0.01 (pi/4) ] - } - } -miniGunCrit :: Creature -miniGunCrit = defaultCreature - { _crPict = basicCrPict red - , _crUpdate = stateUpdate miniAI - , _crInv = IM.fromList [(0,miniGun)] - , _crInvSel = 0 - , _crRad = 10 - , _crState = defaultState {_goals = [[InitGuard]]} - , _crHP = 500 } longCrit :: Creature longCrit = defaultCreature @@ -133,12 +121,31 @@ longCrit = defaultCreature multGunCrit :: Creature multGunCrit = defaultCreature { _crPict = basicCrPict red - , _crUpdate = stateUpdate (twitchMissAI 300 350) +-- , _crUpdate = stateUpdate (twitchMissAI 300 350) , _crInv = IM.fromList [(0,multGun),(1,medkit 100)] , _crInvSel = 0 , _crRad = 10 , _crState = defaultState {_goals = [[InitGuard]]} , _crHP = 300 + , _crUpdate = stateUpdate $ impulsiveAI $ composeInternalAIs + [ performActions + , watchUpdateStrat + [ (crHasTargetLOS, shootFirstMiss 0) + , (crAwayFromPost, goToPostStrat) + ] + , basicPerceptionUpdate [0] + , doStrategyActions + , reloadOverride + , targetYouWhenCognizant + , overrideInternal (onBoth (&&) crHasTarget (crStratConMatches (GetTo (0,0)))) + $ \ _ -> crActionPlan . crStrategy .~ WatchAndWait + ] + , _crActionPlan = ActionPlan + { _crImpulse = [] + , _crAction = [] + , _crStrategy = WatchAndWait + , _crGoal = [] + } } launcherCrit :: Creature launcherCrit = defaultCreature @@ -173,7 +180,25 @@ pistolCrit = defaultCreature autoCrit :: Creature autoCrit = defaultCreature { _crPict = basicCrPict red - , _crUpdate = stateUpdate basicShooterAI + , _crUpdate = stateUpdate $ impulsiveAI $ composeInternalAIs + [ performActions + , watchUpdateStrat + [ (crHasTargetLOS, shootAdvanceStrat 0) + , (crAwayFromPost, goToPostStrat) + ] + , basicPerceptionUpdate [0] + , doStrategyActions + , reloadOverride + , targetYouWhenCognizant + , overrideInternal (onBoth (&&) crHasTarget (crStratConMatches (GetTo (0,0)))) + $ \ _ -> crActionPlan . crStrategy .~ WatchAndWait + ] + , _crActionPlan = ActionPlan + { _crImpulse = [] + , _crAction = [] + , _crStrategy = StrategyActions [StartSentinelPost] WatchAndWait + , _crGoal = [] + } , _crInv = IM.fromList [(0,autoGun),(1,medkit 100)] , _crInvSel = 0 , _crRad = 10 @@ -246,6 +271,7 @@ startCr = defaultCreature , _crMaxHP = 1500 , _crInv = startInventory , _crCorpse = onLayer CorpseLayer $ color (greyN 0.5) $ pictures [color (greyN 0.8) $ circleSolid 10, circLine 10] + , _crFaction = PlayerFaction } {- | Items you start with. @@ -253,6 +279,7 @@ Items you start with. startInventory = IM.fromList (zip [0..20] ( [bezierGun + ,multGun ,hvAutoGun ,remoteLauncher ,grenade diff --git a/src/Dodge/Creature/Action.hs b/src/Dodge/Creature/Action.hs index 2052a49e9..501fcd27e 100644 --- a/src/Dodge/Creature/Action.hs +++ b/src/Dodge/Creature/Action.hs @@ -355,6 +355,14 @@ advanceStepCounter speed cr = over (crStance . carriage) f cr creatureTurn :: Float -> Creature -> Creature creatureTurn a = crDir +~ a +creatureTurnTo :: Point2 -> Creature -> Creature +creatureTurnTo p cr + | vToTarg == (0,0) = cr -- this should deal with the angleVV error + | otherwise = cr & crDir .~ dirToTarget + where + vToTarg = p -.- _crPos cr + dirToTarget = argV vToTarg + creatureTurnToward :: Point2 -> Float -> Creature -> Creature creatureTurnToward p turnSpeed cr | vToTarg == (0,0) = cr -- this should deal with the angleVV error diff --git a/src/Dodge/Creature/Action/UseItem.hs b/src/Dodge/Creature/Action/UseItem.hs index cebf11633..332ba441b 100644 --- a/src/Dodge/Creature/Action/UseItem.hs +++ b/src/Dodge/Creature/Action/UseItem.hs @@ -13,7 +13,8 @@ useItem :: Int -> World -> World useItem n w = equippedItemEffect n w crUseItem :: Creature -> World -> World -crUseItem cr = itemEffect (_crID cr) (_crInv cr IM.! _crInvSel cr) +--crUseItem cr = itemEffect (_crID cr) (_crInv cr IM.! _crInvSel cr) +crUseItem cr = tryUseItem (_crID cr) tryUseItem :: Int -- ^ Creature id diff --git a/src/Dodge/Creature/ActionRat.hs b/src/Dodge/Creature/ActionRat.hs index 320e859d7..35734c65b 100644 --- a/src/Dodge/Creature/ActionRat.hs +++ b/src/Dodge/Creature/ActionRat.hs @@ -1,25 +1,212 @@ module Dodge.Creature.ActionRat + ( shootTargetWithStrat + , suppressShootTarget + , suppress + , shootAdvance + , shootFirstMiss + , doStrategyActions + , reloadOverride + , shootAdvanceStrat + , watchUpdateStrat + , goToPostStrat + , overrideInternal + ) where import Dodge.Data +import Dodge.Base import Dodge.Base.Collide import Dodge.Creature.ChooseTarget import Dodge.Creature.Rationality.Data +import Dodge.Creature.Stance.Data +import Dodge.Creature.Test import Geometry import Data.List +import qualified Data.IntMap.Strict as IM import Control.Lens +shootTargetWithStrat + :: (Creature -> World -> Maybe Creature) -- ^ Function for determining target + -> (World -> Creature -> Creature -> [Action] -> [Action]) + -- ^ Function for determining shooting strategy given target + -> World + -> Creature + -> Creature +shootTargetWithStrat targFunc strat w cr = case targFunc cr w of + Nothing -> cr + Just crTarg -> cr & crActionPlan . crAction %~ strat w cr crTarg + {- | Action update for a simple shooting creature -} -shootAtTarget +suppressShootTarget :: (Creature -> World -> Maybe Creature) -- ^ Function for determining target -> World -> Creature -> Creature -shootAtTarget targFunc w cr = case targFunc cr w of +suppressShootTarget targFunc w cr = case targFunc cr w of Nothing -> cr - Just crTarg -> cr & crRationality . crAction %~ shootAtTarg w cr crTarg + Just crTarg -> cr & crActionPlan . crAction %~ suppress w cr crTarg -shootAtTarg :: World -> Creature -> Creature -> [Action] -> [Action] -shootAtTarg w cr tcr as - | canSee (_crID cr) (_crID tcr) w = nub (ShootTillEmpty : as) - | otherwise = as +suppress :: World -> Creature -> Creature -> [Action] -> [Action] +suppress w cr tcr as + | canSee (_crID cr) (_crID tcr) w && cr ^. crStance . posture /= Aiming + && cr ^? crInv . ix (_crInvSel cr) . wpReloadState == Just 0 = + [ DrawWeapon + , WaitThen 50 ShootTillEmpty + , AimAtCloseSlow + { _targetID = _crID tcr + , _targetSeenAt = _crPos cr + , _aimSpeed = 0.2 + , _slowAimSpeed = 0.01 + , _slowAimAngle = pi/4 + } + ] + | otherwise = as + +shootFirstMiss :: Int -> World -> Creature -> Strategy +shootFirstMiss tcid w cr = StrategyActions acs (ShootAt tcid) + where + acs = + [ DoActionIfElse NoAction crIsAiming (DoActionThen DrawWeapon (WaitThen 50 NoAction)) + `DoActionThen` + LeadTarget (10,50) + `DoActionThen` + advanceShoot + `DoActionThen` + LeadTarget (50,0) + `DoActionThen` + (advanceShoot `DoActionWhileThen` lostest + $ DoReplicateThen advanceShoot 75 + $ DoImpulses [ChangeStrategy WatchAndWait] + ) + ] + lostest (w,cr') = canSee (_crID cr') tcid w + advanceShoot = ImpulsesList [[UseItem, MoveForward 3]] + + +shootAdvanceStrat :: Int -> World -> Creature -> Strategy +shootAdvanceStrat tcid _ _ = StrategyActions acs (ShootAt tcid) + where + acs = + [ DoActionIfElse NoAction crIsAiming (DoActionThen DrawWeapon (WaitThen 50 NoAction)) + `DoActionThen` + (DoActionWhileThen advanceShoot lostest + . DoReplicateThen advanceShoot 75 + $ DoImpulses [ChangeStrategy WatchAndWait] + ) + , AimAtCloseSlow + { _targetID = tcid + , _targetSeenAt = (0,0) -- hack + , _aimSpeed = 0.2 + , _slowAimSpeed = 0.01 + , _slowAimAngle = pi/8 + } + ] + lostest (w,cr') = canSee (_crID cr') tcid w + advanceShoot = ImpulsesList [[UseItem, MoveForward 3]] + +goToPostStrat :: World -> Creature -> Strategy +goToPostStrat w cr = case find sentinelGoal $ _crGoal $ _crActionPlan cr of + Just (SentinelAt p _) -> StrategyActions + [DoActionThen (WaitThen 150 holsterIfAiming) + $ DoActionThen (PathTo p) + NoAction + -- $ DoImpulses [ChangeStrategy WatchAndWait] + ] $ GetTo p + _ -> WatchAndWait + where + sentinelGoal (SentinelAt p dir) = True + sentinelGoal _ = False + holsterIfAiming + | crIsAiming (w,cr) = HolsterWeapon + | otherwise = NoAction + +overrideInternal + :: ((World , Creature) -> Bool) + -> (World -> Creature -> Creature) + -> World + -> Creature + -> Creature +overrideInternal test update w cr + | test (w,cr) = update w cr + | otherwise = cr + +shootAdvance :: World -> Creature -> Creature -> [Action] -> [Action] +shootAdvance w cr tcr as + | lostest (w,cr) && cr ^. crStance . posture /= Aiming + && cr ^? crInv . ix (_crInvSel cr) . wpReloadState == Just 0 = + [ DrawWeapon + , DoImpulses [ChangeStrategy $ ShootAt $ _crID tcr] + , WaitThen 50 + . DoActionWhileThen advanceShoot lostest + . DoReplicateThen advanceShoot 50 + $ DoImpulses [ChangeStrategy WatchAndWait] + , AimAtCloseSlow + { _targetID = _crID tcr + , _targetSeenAt = _crPos cr + , _aimSpeed = 0.2 + , _slowAimSpeed = 0.01 + , _slowAimAngle = pi/8 + } + ] + | cr ^. crStance . posture == Aiming && cr ^? crInv . ix (_crInvSel cr) . wpReloadState /= Just 0 + = [ HolsterWeapon ] + | otherwise = as + where + lostest (w,cr') = canSee (_crID cr) (_crID tcr) w + advanceShoot = ImpulsesList [[UseItem, MoveForward 3]] + +applyNewStrategies + :: World + -> Creature + -> Creature +applyNewStrategies w cr = case cr ^? crActionPlan . crStrategy of + Just (StrategyActions acs strat) -> cr & crActionPlan . crAction .~ acs + & crActionPlan . crStrategy .~ strat + otherwise -> cr + +doStrategyActions + :: World + -> Creature + -> Creature +doStrategyActions w cr = case cr ^? crActionPlan . crStrategy of + Just (StrategyActions acs strat) -> cr & crActionPlan . crAction .~ acs + & crActionPlan . crStrategy .~ strat + otherwise -> cr + +updateShoot + :: World + -> Creature + -> Creature +updateShoot w cr = case _crStrategy $ _crActionPlan cr of + WatchAndWait -> undefined + +reloadOverride + :: World + -> Creature + -> Creature +reloadOverride _ cr + | cr ^? crInv . ix (_crInvSel cr) . wpLoadedAmmo == Just 0 + && cr ^. crStance . posture == Aiming + = cr & crActionPlan . crStrategy .~ StrategyActions reloadActions Reload + | otherwise = cr + where + reloadActions = + [ HolsterWeapon + , WaitThen 1 $ DoActionWhileThen NoAction crIsReloading (DoImpulses [ChangeStrategy WatchAndWait]) + ] + +watchUpdateStrat + :: [ ((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 + _ -> cr + +listGuard :: ([(a -> Bool, b)] , b) -> a -> b +listGuard ( (test,y):ps, z ) x + | test x = y + | otherwise = listGuard (ps, z) x +listGuard (_,z) _ = z diff --git a/src/Dodge/Creature/ImpulseRat.hs b/src/Dodge/Creature/ImpulseRat.hs index 52e53883e..6e48d6965 100644 --- a/src/Dodge/Creature/ImpulseRat.hs +++ b/src/Dodge/Creature/ImpulseRat.hs @@ -14,7 +14,7 @@ chaseTarget -> Creature chaseTarget targFunc w cr = case targFunc cr w of Nothing -> cr - Just crTarg -> cr & crRationality . crImpulse .~ chaseTarg cr crTarg + Just crTarg -> cr & crActionPlan . crImpulse .~ chaseTarg cr crTarg chaseTarg :: Creature -> Creature -> [Impulse] chaseTarg cr crT @@ -40,7 +40,7 @@ impulseShootAtTarget -> Creature impulseShootAtTarget targFunc w cr = case targFunc cr w of Nothing -> cr - Just crTarg -> cr & crRationality . crImpulse .~ impulseShootAtTarg cr crTarg + Just crTarg -> cr & crActionPlan . crImpulse .~ impulseShootAtTarg cr crTarg impulseShootAtTarg :: Creature -> Creature -> [Impulse] impulseShootAtTarg cr crT diff --git a/src/Dodge/Creature/Inanimate.hs b/src/Dodge/Creature/Inanimate.hs index fcd297461..15dd9b0ad 100644 --- a/src/Dodge/Creature/Inanimate.hs +++ b/src/Dodge/Creature/Inanimate.hs @@ -20,7 +20,7 @@ import Picture import qualified Data.IntMap.Strict as IM import Control.Lens -defaultInanimate = defaultCreature & crState . crIsAnimate .~ False +defaultInanimate = defaultCreature & crActionPlan .~ Inanimate lamp :: Creature lamp = defaultInanimate @@ -60,7 +60,6 @@ barrel = defaultInanimate ] , _crState = defaultState {_goals = [[Wait]] - ,_faction = ChaseCritters ,_crSpState = Barrel [] } , _crInv = IM.empty -- IM.fromList [(0,frontArmour)] @@ -76,7 +75,6 @@ explosiveBarrel = defaultInanimate ] , _crState = defaultState {_goals = [[Wait]] - ,_faction = ChaseCritters ,_crSpState = Barrel [] } , _crInv = IM.empty -- IM.fromList [(0,frontArmour)] diff --git a/src/Dodge/Creature/Picture.hs b/src/Dodge/Creature/Picture.hs index 2124c76c0..a0f120bd3 100644 --- a/src/Dodge/Creature/Picture.hs +++ b/src/Dodge/Creature/Picture.hs @@ -6,6 +6,7 @@ module Dodge.Creature.Picture , circLine ) where import Dodge.Data +import Dodge.Creature.Stance.Data import Dodge.Creature.State.Data import Dodge.Creature.AlertLevel.Data import Dodge.Picture.Layer @@ -21,7 +22,7 @@ basicCrPict -> Picture basicCrPict col cr = pictures [ onLayer CrLayer . piercingMod $ bluntScale naked - , drawAwakeLevel cr +-- , drawAwakeLevel cr , drawEquipment cr ] where @@ -66,7 +67,7 @@ drawEquipment drawEquipment cr = pictures $ map f $ IM.toList (_crInv cr) where f (i,it) = case it ^? itEquipPict of - Just g -> g cr i + Just g | (cr ^? crStance . posture) == Just Aiming -> g cr i _ -> blank circLine x = line [(0,0),(x,0)] diff --git a/src/Dodge/Creature/Rationality.hs b/src/Dodge/Creature/Rationality.hs index 3b801c95b..84c247311 100644 --- a/src/Dodge/Creature/Rationality.hs +++ b/src/Dodge/Creature/Rationality.hs @@ -6,6 +6,7 @@ import Dodge.Creature.Rationality.Data import Dodge.Creature.Action import Dodge.Creature.Action.UseItem import Dodge.Creature.State.Data +import Dodge.Creature.Stance.Data import Dodge.SoundLogic import Geometry @@ -14,6 +15,8 @@ import qualified Data.IntMap.Strict as IM import System.Random import Control.Lens +-- Alternatives would probably be a very good fit for actions... + composeInternalAIs :: [World -> Creature -> Creature] -> World @@ -39,7 +42,7 @@ followImpulses w (f,g) cr $ foldr (\imp (f' , cr') -> let (f'', cr'') = followImpulse imp w cr' in (f'' . f', cr'')) (f, cr) - (_crImpulse $ _crRationality cr) + (_crImpulse $ _crActionPlan cr) where g' = snd $ next g @@ -53,14 +56,20 @@ followImpulse imp w cr = case imp of MoveForward x -> (id, crMvForward x cr) Turn a -> (id, creatureTurn a cr) TurnToward p a -> (id, creatureTurnToward p a cr) --- UseItem -> (crUseItem cr, cr) + TurnTo p -> (id, creatureTurnTo p cr) + ChangePosture post -> (id, cr & crStance . posture .~ post) + UseItem -> (crUseItem cr, cr) SwitchToItem i -> (id, cr & crInvSel .~ i) Melee crID -> (hitCr crID , crMvBy (10 *.* normalizeV (posFromID crID -.- cpos)) $ cr & crMeleeCooldown ?~ 20) -- randomise cooldown? RandomTurn a -> (id, creatureTurn (rr a) cr) - _ -> (id , cr) + MakeSound sid -> ( soundOnceOrigin sid (CrSound (_crID cr)) (_crPos cr) , cr ) DropItem -> undefined + ChangeStrategy strat -> (id, cr & crActionPlan . crStrategy .~ strat) + AddGoal gl -> (id, cr & crActionPlan . crGoal %~ (gl :) ) + ArbitraryCreatureImpulse f -> (id, f w cr) + _ -> (id , cr) where cpos = _crPos cr posFromID cid = _crPos $ _creatures w IM.! cid @@ -78,10 +87,10 @@ actionUpdateAI actF w c = performActions w $ actF w c performActions :: World -> Creature -> Creature performActions w cr = cr - & crRationality . crImpulse .~ concat iss - & crRationality . crAction .~ catMaybes mayas + & crActionPlan . crImpulse .~ concat iss + & crActionPlan . crAction .~ catMaybes mayas where - (iss, mayas) = unzip $ map (performAction cr w) $ cr ^. crRationality . crAction + (iss, mayas) = unzip $ map (performAction cr w) $ cr ^. crActionPlan . crAction {- | Performing an action means that a creature has some impulses for a frame, and updates or deletes the action itself. -} @@ -91,9 +100,9 @@ performAction -> Action -> ( [Impulse] , Maybe Action ) performAction cr w ac = case ac of - ShootTillEmpty -> case cr ^? crInv . ix (_crInvSel cr) . wpLoadedAmmo of - Just x | x > 0 -> ( [UseItem] , Just ShootTillEmpty ) - _ -> ( [] , Nothing ) + ShootTillEmpty -> case cr ^? crInv . ix (_crInvSel cr) . wpReloadState of + Just x | x == 0 -> ( [UseItem] , Just ShootTillEmpty ) + _ -> ( [] , Just (WaitThen 20 HolsterWeapon) ) AimAtCloseSlow tcid p speed slowSpeed a | canSee (_crID cr) tcid w && safeAngleVV (unitVectorAtAngle cdir) (tpos -.- cpos) < a -> ([TurnToward tpos slowSpeed] , Just $ AimAtCloseSlow tcid tpos speed slowSpeed a) @@ -104,9 +113,41 @@ performAction cr w ac = case ac of | otherwise -> ([TurnToward p speed] , Just $ AimAtCloseSlow tcid p speed slowSpeed a) where tpos = _crPos (_creatures w IM.! tcid) + WaitThen 0 newAc -> ([] , Just newAc) + WaitThen t newAc -> ([] , Just (WaitThen (t-1) newAc)) ImpulsesList (xs:xss) -> (xs, Just $ ImpulsesList xss) ImpulsesList _ -> ([], Nothing) + DoImpulses imps -> (imps, Nothing) + DrawWeapon -> ([ChangePosture Aiming, MakeSound pickUpSound] , Nothing) + HolsterWeapon -> ([ChangePosture AtEase, MakeSound putDownSound] , Nothing) + DoActionThen ac ac' -> case performAction cr w ac of + (imps , Just ac'') -> (imps, Just (DoActionThen ac'' ac')) + (imps , Nothing ) -> (imps, Just ac') + DoActionWhile ac f + | f (w,cr) -> (fst $ performAction cr w ac, Just $ DoActionWhile ac f) + | otherwise -> ([], Nothing) + DoActionIfElse ac f ac' + | f (w,cr) -> performAction cr w ac + | otherwise -> performAction cr w ac' + DoActionWhileThen ac f ac' + | f (w,cr) -> (fst $ performAction cr w ac, Just $ DoActionWhileThen ac f ac') + | otherwise -> performAction cr w ac' + DoReplicateThen ac 0 ac' -> performAction cr w ac' + DoReplicateThen ac t ac' -> (fst $ performAction cr w ac, Just $ DoReplicateThen ac (t-1) ac') + DoActions [] -> ([], Nothing) + DoActions acs -> + let (imps, newAcs) = unzip $ map (performAction cr w) acs + in (concat imps, Just . DoActions $ catMaybes newAcs) + StartSentinelPost -> ([AddGoal $ SentinelAt (_crPos cr) (_crDir cr)], Nothing) + PathTo p + | dist cpos p < 5 -> ([], Nothing) + | hasLOS cpos p w -> ([TurnToward p (pi/4),MoveForward 3] , Just (PathTo p)) + | otherwise -> ([], Nothing) + LeadTarget p -> case cr ^? crTarget . _Just of + Just tcid -> let tcr = _creatures w IM.! tcid + in ([TurnTo (_crPos tcr +.+ rotateV (_crDir tcr) p)], Nothing) + _ -> ([], Nothing) + _ -> ([], Nothing) where cpos = _crPos cr cdir = _crDir cr - diff --git a/src/Dodge/Creature/Rationality/Data.hs b/src/Dodge/Creature/Rationality/Data.hs index e21d585e3..85bfe8ce3 100644 --- a/src/Dodge/Creature/Rationality/Data.hs +++ b/src/Dodge/Creature/Rationality/Data.hs @@ -6,64 +6,3 @@ import Dodge.Creature.Stance.Data import Geometry.Data import Control.Lens -data Rationality - = NonRat - | ImpulseRat - {_crImpulse :: [Impulse] } - | ActionRat - {_crImpulse :: [Impulse] - ,_crAction :: [Action] - } - | StrategyRat - {_crImpulse :: [Impulse] - ,_crAction :: [Action] - ,_crStrategy :: Strategy - } -data Impulse - = Move Point2 - | MoveForward Float - | Turn Float - | RandomTurn Float - | TurnToward Point2 Float - | UseItem - | SwitchToItem Int - | DropItem - | PickupNearby Int - | UseWorldObject Int - | Bark -- placeholder for various communication types - | UseIntrinsicAbility - | Melee Int - | ChangePosture Posture - deriving (Eq,Ord,Show) - -data Action - = Attack Int - | AimAtCloseSlow - {_targetID :: Int - ,_targetSeenAt :: Point2 - ,_aimSpeed :: Float - ,_slowAimSpeed :: Float - ,_slowAimAngle :: Float - } - | MeleeAttack Point2 Int - | PathTo Point2 - | FleeFrom Int - | HealSelf - | DefendSelf - | Protect Int - | SearchFor Int - | Search - | PickupItem Int - | ShootTillEmpty - | ImpulsesList [[Impulse]] - deriving (Eq,Ord,Show) - -data Strategy - = Flank Int - | Ambush Int - | Lure Int Point2 - | GuardArea Point2 - | Patrol [Point2] - -makeLenses ''Rationality -makeLenses ''Impulse diff --git a/src/Dodge/Creature/SetTarget.hs b/src/Dodge/Creature/SetTarget.hs new file mode 100644 index 000000000..8c8643e9d --- /dev/null +++ b/src/Dodge/Creature/SetTarget.hs @@ -0,0 +1,16 @@ +{- | +Deals with setting a target for creatures +-} +module Dodge.Creature.SetTarget + where +import Dodge.Data +import Dodge.Creature.AlertLevel.Data + +import Control.Lens +targetYouWhenCognizant + :: World + -> Creature + -> Creature +targetYouWhenCognizant w cr = case cr ^? crAwarenessLevel . ix 0 of + Just (Cognizant _) -> cr & crTarget .~ Just 0 + _ -> cr & crTarget .~ Nothing diff --git a/src/Dodge/Creature/State.hs b/src/Dodge/Creature/State.hs index 56374ea35..50329b45b 100644 --- a/src/Dodge/Creature/State.hs +++ b/src/Dodge/Creature/State.hs @@ -116,23 +116,24 @@ movementSideEff cr w | otherwise = case cr ^? crStance . carriage of Just (Walking x y) -> takeStep x y w _ -> w - where hasJetPack = any (\it -> it ^? itIdentity == Just JetPack) $ _crInv cr - oldPos = _crOldPos cr - momentum' = 0.97 *.* (_crPos cr -.- _crOldPos cr) - momentum'' | magV momentum' > 3 = 3 *.* normalizeV momentum' - | otherwise = momentum' - momentum = momentum'' +.+ 0.01 *.* unitVectorAtAngle randAng - (randDir,g) = randomR (-0.5,0.5) $ _randGen w - (randAng,_) = randomR (0,2*pi) $ _randGen w + where + hasJetPack = any (\it -> it ^? itIdentity == Just JetPack) $ _crInv cr + oldPos = _crOldPos cr + momentum' = 0.97 *.* (_crPos cr -.- _crOldPos cr) + momentum'' | magV momentum' > 3 = 3 *.* normalizeV momentum' + | otherwise = momentum' + momentum = momentum'' +.+ 0.01 *.* unitVectorAtAngle randAng + (randDir,g) = randomR (-0.5,0.5) $ _randGen w + (randAng,_) = randomR (0,2*pi) $ _randGen w - (v1:v2:v3:_) = fst $ runState ((sequence . repeat . randInCirc) 0.1) $ _randGen w - (r1:r2:r3:_) = map ((*.*) 100) (v2:v3:v1:[]) + (v1:v2:v3:_) = fst $ runState ((sequence . repeat . randInCirc) 0.1) $ _randGen w + (r1:r2:r3:_) = map ((*.*) 100) (v2:v3:v1:[]) - crHasMoved = dist (_crPos cr) (_crOldPos cr) > 0.5 - takeStep x y | crHasMoved && x < 20 && x + y >= 20 = soundMultiFrom footor 22 3 0 - | crHasMoved && x < 80 && x + y >= 80 = soundMultiFrom footor 23 3 0 - | otherwise = id - footor = [FootstepSound 0,FootstepSound 1] + crHasMoved = dist (_crPos cr) (_crOldPos cr) > 0.5 + takeStep x y | crHasMoved && x < 20 && x + y >= 20 = soundMultiFrom footor 22 3 0 + | crHasMoved && x < 80 && x + y >= 80 = soundMultiFrom footor 23 3 0 + | otherwise = id + footor = [FootstepSound 0,FootstepSound 1] invSideEff :: Creature -> World -> World invSideEff cr w = weaponReloadSounds cr $ IM.foldrWithKey f w (_crInv cr) @@ -142,29 +143,22 @@ invSideEff cr w = weaponReloadSounds cr $ IM.foldrWithKey f w (_crInv cr) weaponReloadSounds :: Creature -> World -> World weaponReloadSounds cr w = case _crInv cr IM.!? _crInvSel cr of - Just (Weapon {_wpReloadState = 0}) - -> w - Just (Weapon {_wpReloadState = 1}) - -> stopSoundFrom (CrReloadSound cid) w - Just (Weapon {}) - -> soundFrom (CrReloadSound cid) reloadSound (1) 0 w - _ - -> w - where cid = _crID cr + Just (Weapon {_wpReloadState = 0}) -> w + Just (Weapon {_wpReloadState = 1}) -> stopSoundFrom (CrReloadSound cid) w + Just (Weapon {}) -> soundFrom (CrReloadSound cid) reloadSound (1) 0 w + _ -> w + where + cid = _crID cr updateMovement :: StdGen -> Creature -> (Creature, StdGen) updateMovement g cr - | isFrictionless cr - = (over crPos (+.+ momentum) $ setOldPos cr, g') - | otherwise - = case cr ^? crStance . carriage of - Just (Walking x y) - -> (set (crStance . carriage) (Walking ((x+y)`mod`120) 0) - $ setOldPos - cr, g) - _ -> (set (crStance . carriage) (Walking 0 0) - $ setOldPos - cr, g) + | isFrictionless cr = (over crPos (+.+ momentum) $ setOldPos cr, g') + | otherwise = case cr ^? crStance . carriage of + Just (Walking x y) + -> (set (crStance . carriage) (Walking ((x+y)`mod`120) 0) $ setOldPos cr + , g) + _ -> (set (crStance . carriage) (Walking 0 0) $ setOldPos cr + , g) where momentum' = 0.98 *.* (_crPos cr -.- _crOldPos cr) momentum'' | magV momentum' > 1 = 1 *.* normalizeV momentum' @@ -180,25 +174,30 @@ isFrictionless cr = case cr ^? crStance . carriage of updateReloadCounter :: Creature -> Creature updateReloadCounter cr = over (crInv . ix iSel . itUseTime) decreaseToZero - . over (crInv . ix iSel . wpReloadState) decreaseToZero - $ cr - where iSel = _crInvSel cr + . over (crInv . ix iSel . wpReloadState) decreaseToZero + $ cr + where + iSel = _crInvSel cr decreaseToZero :: Int -> Int -decreaseToZero x | x > 0 = x - 1 - | otherwise = 0 +decreaseToZero x = max 0 (x - 1) onDeath :: (Creature -> World -> World) -> CRUpdate -> CRUpdate onDeath h u w (f,g) cr | _crHP cr > 0 = u w (f,g) cr | otherwise = ( ( h cr . f, g ) , Nothing ) -updateBarrel :: - World -> (World -> World,StdGen) -> Creature -> ((World -> World , StdGen), Maybe Creature) -updateBarrel w (f,g) cr | _crHP cr > 0 = ((f, g), newCr) - | otherwise = ((f, g), Nothing) - where damages = _crDamage $ _crState cr - newCr = Just $ doDamage cr +updateBarrel + :: World + -> (World -> World,StdGen) + -> Creature + -> ((World -> World , StdGen), Maybe Creature) +updateBarrel w (f,g) cr + | _crHP cr > 0 = ((f, g), newCr) + | otherwise = ((f, g), Nothing) + where + damages = _crDamage $ _crState cr + newCr = Just $ doDamage cr -- it is easy to leave off the "f" here -- should find some better way of doing all this that is less prone to error @@ -207,29 +206,30 @@ updateExpBarrel :: updateExpBarrel w (f,g) cr | _crHP cr > 0 = ((f . foldr (.) id pierceSparks . hiss, g'), newCr) | otherwise = ((f . makeExplosionAt (_crPos cr) . stopSounds , g'), Nothing) - where damages = _crDamage $ _crState cr - pierceSparks :: [World -> World] - pierceSparks - = zipWith4 (\p a colid time-> (createBarrelSpark time colid (_crPos cr +.+ p) (a + argV p)) - (Just $ _crID cr)) - poss as colids times - as = randomRs (-0.7,0.7) $ g - colids = randomRs (0,11) $ g - times = randomRs (2,5) $ g - (g',_) = split g - poss = _piercedPoints $ _crSpState $ _crState cr - --newCr = Just $ doDamage $ applyFuseDamage cr -- $ foldr perforate cr damages - newCr = Just $ applyFuseDamage $ set (crState . crDamage) [] $ damToExpBarrel damages cr - perforate :: DamageType -> Creature -> Creature - perforate (Piercing amount sp int ep) cr = over (crState . crSpState . piercedPoints) - ((:) $ int -.- _crPos cr) cr - perforate _ cr = cr - applyFuseDamage cr = over crHP (\hp -> hp - length (_piercedPoints - $ _crSpState $ _crState cr)) - cr - hiss | poss == [] = id - | otherwise = soundMultiFrom [BarrelHiss 0,BarrelHiss 1] 41 50 1 - stopSounds = stopSoundFrom (BarrelHiss 0) . stopSoundFrom (BarrelHiss 1) + where + damages = _crDamage $ _crState cr + pierceSparks :: [World -> World] + pierceSparks + = zipWith4 (\p a colid time-> (createBarrelSpark time colid (_crPos cr +.+ p) (a + argV p)) + (Just $ _crID cr)) + poss as colids times + as = randomRs (-0.7,0.7) $ g + colids = randomRs (0,11) $ g + times = randomRs (2,5) $ g + (g',_) = split g + poss = _piercedPoints $ _crSpState $ _crState cr + --newCr = Just $ doDamage $ applyFuseDamage cr -- $ foldr perforate cr damages + newCr = Just $ applyFuseDamage $ set (crState . crDamage) [] $ damToExpBarrel damages cr + perforate :: DamageType -> Creature -> Creature + perforate (Piercing amount sp int ep) cr = over (crState . crSpState . piercedPoints) + ((:) $ int -.- _crPos cr) cr + perforate _ cr = cr + applyFuseDamage cr = over crHP (\hp -> hp - length (_piercedPoints + $ _crSpState $ _crState cr)) + cr + hiss | poss == [] = id + | otherwise = soundMultiFrom [BarrelHiss 0,BarrelHiss 1] 41 50 1 + stopSounds = stopSoundFrom (BarrelHiss 0) . stopSoundFrom (BarrelHiss 1) damToExpBarrel :: [DamageType] -> Creature -> Creature damToExpBarrel ds cr = foldr damToExpBarrel' (foldr damToExpBarrel' cr pierceDam) otherDam diff --git a/src/Dodge/Creature/State/Data.hs b/src/Dodge/Creature/State/Data.hs index 51cd3afb3..91916cf7e 100644 --- a/src/Dodge/Creature/State/Data.hs +++ b/src/Dodge/Creature/State/Data.hs @@ -6,17 +6,16 @@ import Geometry import Dodge.Data.DamageType import Dodge.Creature.Impulse.Data import Dodge.Creature.Stance.Data +import Picture.Data import Control.Lens data CreatureState = CrSt { _goals :: [[Impulse]] - , _faction :: Faction , _crDamage :: [DamageType] , _crPastDamage :: [[DamageType]] , _crSpState :: CrSpState , _crDropsOnDeath :: CreatureDropType - , _crIsAnimate :: Bool } data CreatureDropType @@ -36,6 +35,8 @@ data Faction | ChaseCritters | SpawnedBy Int | NoFaction + | ColorFaction Color + | PlayerFaction deriving (Eq,Show) makeLenses ''CreatureState diff --git a/src/Dodge/Creature/Test.hs b/src/Dodge/Creature/Test.hs new file mode 100644 index 000000000..839b492da --- /dev/null +++ b/src/Dodge/Creature/Test.hs @@ -0,0 +1,54 @@ +{- | +Module testing for properties of creatures, whether they are reloading, etc. +Each function takes the world and a creature and returns a bool. +Note that the creature NEED NOT be the same as the creature with that id in the world, +in fact in some cases a creature with that id may not even exist. +-} +module Dodge.Creature.Test + where +import Dodge.Data +import Dodge.Base.Collide +import Dodge.Creature.Stance.Data +import Geometry +import SameConstr + +import Data.List (find) +import Data.Maybe +import qualified Data.IntMap.Strict as IM +import Control.Lens + +andTest :: (a -> Bool) -> (a -> Bool) -> a -> Bool +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 (w,cr) = case cr ^? crInv . ix (_crInvSel cr) . wpReloadState of + Just t -> t > 0 + _ -> False + +crCanSeeCID :: Int -> (World, Creature) -> Bool +crCanSeeCID cid (w,cr) = hasLOS (_crPos cr) (_crPos $ _creatures w IM.! cid) w + +crIsAiming :: (World,Creature) -> Bool +crIsAiming (_,cr) = _posture (_crStance cr) == Aiming + +crHasTarget :: (World,Creature) -> Bool +crHasTarget (_,cr) = isJust $ cr ^? crTarget . _Just + +crHasTargetLOS :: (World,Creature) -> Bool +crHasTargetLOS (w,cr) = case cr ^? crTarget . _Just of + Just i -> crCanSeeCID i (w,cr) + Nothing -> False + +crStratConMatches :: Strategy -> (World,Creature) -> Bool +crStratConMatches strat (_,cr) = eqConstr strat (_crStrategy $ _crActionPlan cr) + +crAwayFromPost :: (World,Creature) -> Bool +crAwayFromPost (_,cr) = case find sentinelGoal $ _crGoal $ _crActionPlan cr of + Just (SentinelAt p dir) -> dist p (_crPos cr) > 15 + _ -> False + where + sentinelGoal (SentinelAt p dir) = True + sentinelGoal _ = False diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index c8c9f9579..fe0679952 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -6,6 +6,7 @@ circular imports are probably not a good idea. {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE StrictData #-} +{-# LANGUAGE DeriveGeneric #-} module Dodge.Data ( module Dodge.Data , module Dodge.Data.DamageType @@ -33,9 +34,11 @@ import Geometry.Data import Sound.Data import qualified DoubleStack as DS +import GHC.Generics import Control.Lens import Control.Monad.State import System.Random +import Data.Data import Data.Graph.Inductive import Data.Int (Int16) import qualified Data.Set as S @@ -151,11 +154,13 @@ data Creature = Creature , _crCorpse :: Picture , _crApplyDamage :: [DamageType] -> Creature -> (World -> World,Creature) , _crStance :: Stance - , _crRationality :: Rationality + , _crActionPlan :: ActionPlan , _crMeleeCooldown :: Maybe Int , _crAwakeLevel :: AwakeLevel , _crAttentionDir :: AttentionDir , _crAwarenessLevel :: IM.IntMap AwarenessLevel + , _crFaction :: Faction + , _crTarget :: Maybe Int } data WorldState = DoorNumOpen Int @@ -443,6 +448,138 @@ data ForceField = FF } data FFState = FFDestroyable { _ffsHP :: Int } +data ActionPlan + = Inanimate + | ActionPlan + {_crImpulse :: [Impulse] + ,_crAction :: [Action] + ,_crStrategy :: Strategy + ,_crGoal :: [Goal] + } +data Impulse + = Move Point2 + | MoveForward Float + | StepForward + | Turn Float + | RandomTurn Float + | TurnToward Point2 Float + | TurnTo Point2 + | UseItem + | SwitchToItem Int + | DropItem + | PickupNearby Int + | UseWorldObject Int + | Bark -- placeholder for various communication types + | UseIntrinsicAbility + | Melee Int + | ChangePosture Posture + | MakeSound Int + | ChangeStrategy Strategy + | AddGoal Goal + | ArbitraryCreatureImpulse (World -> Creature -> Creature) +-- deriving (Eq,Ord,Show) +data Action + = Attack + {_attackTargetID :: Int} + | AimAtCloseSlow + {_targetID :: Int + ,_targetSeenAt :: Point2 + ,_aimSpeed :: Float + ,_slowAimSpeed :: Float + ,_slowAimAngle :: Float + } + | MeleeAttack + {_meleeAttackLastSeen :: Point2 + ,_meleeAttackTargetID :: Int + } + | PathTo + {_pathToPoint :: Point2 + } + | FleeFrom + {_fleeFromCID :: Int + } + | HealSelf + | DefendSelf + | Protect + {_protectCID :: Int + } + | SearchFor + {_searchForCID :: Int + } + | Search + | PickupItem + {_pickupItemID :: Int + } + | ShootTillEmpty + | ImpulsesList + {_impulsesListList :: [[Impulse]] + } + | DoImpulses + {_doImpulsesList :: [Impulse] + } + | DrawWeapon + | HolsterWeapon + | WaitThen + {_waitThenTimer :: Int + ,_waitThenAction :: Action + } + | DoActionWhile + {_doActionWhileAction :: Action + ,_doActionWhileCondition :: ( (World, Creature) -> Bool) + } + | DoActionIfElse + {_doActionIfElseIfAction :: Action + ,_doActionIfElseCondition :: ( (World, Creature) -> Bool) + ,_doActionIfElseElseAction :: Action + } + | DoActionWhileThen + {_doActionWhileThenDo :: Action + ,_doActionWhileThenCondition :: ( (World, Creature) -> Bool) + ,_doActionWhileThenThen :: Action + } + | DoActions + {_doActionsList :: [Action] + } + | DoActionOnce + {_doActionOnceAction :: Action + } + | DoActionThen + {_doActionThenFirst :: Action + ,_doActionThenSecond :: Action + } + | DoGuardActions + {_doGuardActionsList :: [( (World, Creature) -> Bool, Action, Maybe Action)] + } + | DoReplicateThen + {_doReplicateThenDo :: Action + ,_doReplicateThenTimes :: Int + ,_doReplicateThenAfter :: Action + } + | LeadTarget + {_leadTargetBy :: Point2 + } + | NoAction + | StartSentinelPost + deriving (Generic) +-- deriving (Eq,Ord,Show) +data Strategy + = Flank Int + | Ambush Int + | Lure Int Point2 + | Patrol [Point2] + | ShootAt Int + | FollowImpulses + | WatchAndWait + | StrategyActions [Action] Strategy + | GetTo Point2 + | Reload + deriving (Generic) +-- deriving (Eq,Ord,Show) +data Goal + = LiveLongAndProsper + | Kill Int + | SentinelAt Point2 Float + makeLenses ''World makeLenses ''Cloud makeLenses ''Creature @@ -460,6 +597,9 @@ makeLenses ''ForceField makeLenses ''FFState makeLenses ''PressPlate makeLenses ''Button +makeLenses ''ActionPlan +makeLenses ''Impulse +makeLenses ''Action numColor :: Int -> Color numColor 0 = (1,0,0,1) diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index a11f9e267..e79fb519e 100644 --- a/src/Dodge/Default.hs +++ b/src/Dodge/Default.hs @@ -91,20 +91,20 @@ defaultCreature = Creature , _crCorpse = onLayer CorpseLayer $ color (greyN 0.5) $ circleSolid 10 , _crApplyDamage = defaultApplyDamage , _crStance = Stance {_carriage=Walking 0 0,_posture=AtEase} - , _crRationality = ImpulseRat [] + , _crActionPlan = ActionPlan [] [] WatchAndWait [LiveLongAndProsper] , _crMeleeCooldown = Nothing , _crAwakeLevel = Vigilant , _crAttentionDir = AttentiveTo [] , _crAwarenessLevel = IM.empty + , _crFaction = NoFaction + , _crTarget = Nothing } defaultState = CrSt { _goals = [] - , _faction = NoFaction , _crDamage = [] , _crPastDamage = [] , _crSpState = GenCr , _crDropsOnDeath = DropAmount 1 - , _crIsAnimate = True } defaultEquipment = Equipment { _itIdentity = Generic diff --git a/src/Dodge/Floor.hs b/src/Dodge/Floor.hs index 6483da1ef..a264bded2 100644 --- a/src/Dodge/Floor.hs +++ b/src/Dodge/Floor.hs @@ -50,7 +50,7 @@ roomTreex = do [[StartRoom] ,[Corridor] ,[SpecificRoom . pure . pure . Right $ roomGlassOctogon 400 - & rmPS %~ (PS (0,0) 0 (PutCrit miniGunCrit') :) + & rmPS %~ (PS (0,-300) 0 (PutCrit multGunCrit) :) ] ,[Corridor] ,[Corridor] diff --git a/src/Dodge/Item/Attachment.hs b/src/Dodge/Item/Attachment.hs index fba11bfe4..a5c24b6ea 100644 --- a/src/Dodge/Item/Attachment.hs +++ b/src/Dodge/Item/Attachment.hs @@ -36,11 +36,10 @@ charFiringStrat -> Int -- ^ Creature id -> World -> World -charFiringStrat strats cid w = - let Just (c :<| _) = w ^? creatures . ix cid . crInv - . ix (_crInvSel $ _creatures w IM.! cid) . itAttachment - . _Just . itCharMode - in fromJust (Prelude.lookup c strats) cid w +charFiringStrat strats cid w = case w ^? creatures . ix cid . crInv + . ix (_crInvSel $ _creatures w IM.! cid) . itAttachment . _Just . itCharMode of + Just (c :<| _) -> fromJust (Prelude.lookup c strats) cid w + Nothing -> w increaseFuse :: Int -- ^ Old fuse time diff --git a/src/Dodge/LevelGen/AutoDoor.hs b/src/Dodge/LevelGen/AutoDoor.hs index 5faa56448..1361416c8 100644 --- a/src/Dodge/LevelGen/AutoDoor.hs +++ b/src/Dodge/LevelGen/AutoDoor.hs @@ -96,7 +96,7 @@ autoDoorPane (trigx,trigy) n closedPos openPos = Door a = fst closedPos b = snd closedPos dm w - | any (crNearSeg 40 trigx trigy) $ IM.filter (_crIsAnimate . _crState) $ _creatures w + | any (crNearSeg 40 trigx trigy) $ IM.filter isAnimate $ _creatures w = flip (foldr changeZonedWall) zoneps $ over walls (IM.adjust openDoor n) w | otherwise = flip (foldr changeZonedWall') zoneps $ over walls (IM.adjust closeDoor n) w diff --git a/src/Dodge/SoundLogic.hs b/src/Dodge/SoundLogic.hs index 427c54c42..08f1548dc 100644 --- a/src/Dodge/SoundLogic.hs +++ b/src/Dodge/SoundLogic.hs @@ -42,8 +42,10 @@ module Dodge.SoundLogic ( , smokeTrailSound , foot1Sound , foot2Sound + , module Dodge.SoundLogic.Synonyms ) where import Dodge.Data +import Dodge.SoundLogic.Synonyms import Sound.Data (SoundStatus (..)) import Geometry.Vector import Geometry (dist) @@ -180,26 +182,3 @@ soundMultiFrom (so:sos) sType time fadeTime w stopSoundFrom :: SoundOrigin -> World -> World stopSoundFrom so = over (sounds . ix so . soundTime) (fmap $ min 0) -reloadSound,putDownSound,pickUpSound,fireSound,grenadeBang,healSound,teleSound,twoStepSlowSound :: Int -clickSound = 1 -reloadSound = 2 -pickUpSound = 4 -putDownSound = 5 -fireSound = 6 -grenadeBang = 7 -tapQuiet = 8 -twoStepSound = 9 -healSound = 10 -doorSound = 11 -twoStepSlowSound = 12 -knifeSound = 13 -buzzSound = 14 -hitSound = 15 -autoGunSound = 16 -shotgunSound = 17 -teleSound = 18 -longGunSound = 19 -launcherSound = 20 -smokeTrailSound = 21 -foot1Sound = 22 -foot2Sound = 23 diff --git a/src/Dodge/SoundLogic/Synonyms.hs b/src/Dodge/SoundLogic/Synonyms.hs new file mode 100644 index 000000000..642092292 --- /dev/null +++ b/src/Dodge/SoundLogic/Synonyms.hs @@ -0,0 +1,29 @@ +module Dodge.SoundLogic.Synonyms + where + +reloadSound,putDownSound,pickUpSound,fireSound,grenadeBang,healSound,teleSound,twoStepSlowSound :: Int +clickSound = 1 +reloadSound = 2 +pickUpSound = 4 +putDownSound = 5 +fireSound = 6 +grenadeBang = 7 +tapQuiet = 8 +twoStepSound = 9 +healSound = 10 +doorSound = 11 +twoStepSlowSound = 12 +knifeSound = 13 +buzzSound = 14 +hitSound = 15 +autoGunSound = 16 +shotgunSound = 17 +teleSound = 18 +longGunSound = 19 +launcherSound = 20 +smokeTrailSound = 21 +foot1Sound = 22 +foot2Sound = 23 + +drawWeaponSound = 4 +holsterWeaponSound = 5 diff --git a/src/Dodge/WallCreatureCollisions.hs b/src/Dodge/WallCreatureCollisions.hs index 356b26183..48f23bcfa 100644 --- a/src/Dodge/WallCreatureCollisions.hs +++ b/src/Dodge/WallCreatureCollisions.hs @@ -1,5 +1,7 @@ +{- | +Deals with moving creature wall collisions. + -} module Dodge.WallCreatureCollisions where --- imports {{{ import Dodge.Data import Dodge.Creature.State.Data import Dodge.Base @@ -43,12 +45,11 @@ wallBuffer = 3 -- out from the wall -- this is then repeated if the point ends up on a new wall collideWalls :: Float -> Point2 -> [(Point2,Point2)] -> Point2 -> Point2 -collideWalls rad cp1 walls cp2 - = case (listToMaybe.mapMaybe (pushOutFromWall rad cp2)) walls of - Nothing -> cp2 - Just cp3 -> case (listToMaybe.reverse.mapMaybe (pushOutFromWall rad cp3)) walls of - Nothing -> cp3 - Just cp4 -> cp4 +collideWalls rad cp1 walls cp2 = case (listToMaybe.mapMaybe (pushOutFromWall rad cp2)) walls of + Nothing -> cp2 + Just cp3 -> case (listToMaybe.reverse.mapMaybe (pushOutFromWall rad cp3)) walls of + Nothing -> cp3 + Just cp4 -> cp1 -- pushes a point out from a list of walls -- if multiple new points occur, chooses the one closest to the orignal point @@ -72,15 +73,16 @@ pushOrCrush wls cr = case mapMaybe (pushOutFromWall (_crRad cr) cpos) wls of -- assumes wall points are different pushOutFromWall :: Float -> Point2 -> (Point2,Point2) -> Maybe (Point2) pushOutFromWall rad cp2 (wp1,wp2) - | isOnWall = Just newP -- +.+ (1 *.* norm)) - | otherwise = Nothing - where norm = errorNormalizeV 61 $ vNormal (wp1 -.- wp2) - wp1' = (rad *.* norm) +.+ wp1 - wp2' = (rad *.* norm) +.+ wp2 - newP = errorClosestPointOnLine 5 wp1' wp2' cp2 - isOnWall = circOnSegNoEndpoints wp1 wp2 cp2 rad - isJust Nothing = False - isJust _ = True + | isOnWall = Just newP -- +.+ (1 *.* norm)) + | otherwise = Nothing + where + norm = errorNormalizeV 61 $ vNormal (wp1 -.- wp2) + wp1' = (rad *.* norm) +.+ wp1 + wp2' = (rad *.* norm) +.+ wp2 + newP = errorClosestPointOnLine 5 wp1' wp2' cp2 + isOnWall = circOnSegNoEndpoints wp1 wp2 cp2 rad + isJust Nothing = False + isJust _ = True pushOutFromCorners :: World -> Creature -> Creature pushOutFromCorners w cr = cr & crPos .~ newPos @@ -93,8 +95,9 @@ collideCorners rad p1 ps p2 = foldr (intersectCirclePoint rad) p2 ps -- collide circles with points (outer corners) intersectCirclePoint :: Float -> Point2 -> Point2 -> Point2 -intersectCirclePoint rad p cCen | dist cCen p > rad = cCen - | otherwise = p +.+ (rad *.* errorNormalizeV 65 (cCen -.- p)) +intersectCirclePoint rad p cCen + | dist cCen p > rad = cCen + | otherwise = p +.+ (rad *.* errorNormalizeV 65 (cCen -.- p)) checkPushThroughs :: Float -> Point2 -> [(Point2,Point2)] -> Point2 -> Point2 checkPushThroughs rad cp1 walls cp2 @@ -102,12 +105,13 @@ checkPushThroughs rad cp1 walls cp2 checkPushThrough :: Float -> Point2 -> Point2 -> (Point2,Point2) -> Maybe (Point2) checkPushThrough rad cp1 cp2 (wp1,wp2) - | isPushedThrough = intersectSegSeg' cp1 cp2 wp1 wp2 - | otherwise = Nothing - where norm = errorNormalizeV 61 $ vNormal (wp1 -.- wp2) - wp1' = (rad *.* norm) +.+ wp1 - wp2' = (rad *.* norm) +.+ wp2 - newP = errorClosestPointOnLine 5 wp1' wp2' cp2 - isPushedThrough = isRHS wp1 wp2 cp2 && isJust (intersectSegSeg' cp1 cp2 wp1 wp2) - isJust Nothing = False - isJust _ = True + | isPushedThrough = intersectSegSeg' cp1 cp2 wp1 wp2 + | otherwise = Nothing + where + norm = errorNormalizeV 61 $ vNormal (wp1 -.- wp2) + wp1' = (rad *.* norm) +.+ wp1 + wp2' = (rad *.* norm) +.+ wp2 + newP = errorClosestPointOnLine 5 wp1' wp2' cp2 + isPushedThrough = isRHS wp1 wp2 cp2 && isJust (intersectSegSeg' cp1 cp2 wp1 wp2) + isJust Nothing = False + isJust _ = True diff --git a/src/Geometry.hs b/src/Geometry.hs index 0ba975022..26212aee5 100644 --- a/src/Geometry.hs +++ b/src/Geometry.hs @@ -268,6 +268,7 @@ nRaysRad n x = take n $ iterate (rotateV (2*pi/fromIntegral n)) (x,0) -- | Test whether an angle is to the left of another angle, according to the -- smallest change in rotation between them. +-- This appears to sometimes fail if the angles are not normalized. isLeftOfA :: Float -> Float -> Bool isLeftOfA angle1 angle2 = (angle1 - angle2 < pi && angle1 > angle2) diff --git a/src/SameConstr.hs b/src/SameConstr.hs new file mode 100644 index 000000000..f4c6c0650 --- /dev/null +++ b/src/SameConstr.hs @@ -0,0 +1,37 @@ +{-# LANGUAGE DefaultSignatures, TypeOperators, FlexibleContexts #-} +{- | Pulled from +https://stackoverflow.com/questions/10112733/haskell-simple-constructor-comparison-function + -} +module SameConstr where + +import GHC.Generics +import Data.Function (on) + +--class EqC a where +-- eqConstr :: a -> a -> Bool +-- default eqConstr :: (Generic a, GEqC (Rep a)) => a -> a -> Bool +-- eqConstr = geqConstr `on` from + +eqConstr :: (Generic a, GEqC (Rep a)) => a -> a -> Bool +eqConstr = geqConstr `on` from + +class GEqC f where + geqConstr :: f p -> f p -> Bool + {-# INLINE geqConstr #-} + geqConstr _ _ = True + +instance GEqC f => GEqC (M1 i c f) where + {-# INLINE geqConstr #-} + geqConstr (M1 x) (M1 y) = geqConstr x y + +instance GEqC (K1 i c) +instance GEqC (f :*: g) +instance GEqC U1 +instance GEqC V1 + +instance (GEqC f, GEqC g) => GEqC (f :+: g) where + {-# INLINE geqConstr #-} + geqConstr (L1 x) (L1 y) = geqConstr x y + geqConstr (R1 x) (R1 y) = geqConstr x y + geqConstr _ _ = False +