diff --git a/src/Dodge/AIs.hs b/src/Dodge/AIs.hs index e4ad970c6..1a6b21cbf 100644 --- a/src/Dodge/AIs.hs +++ b/src/Dodge/AIs.hs @@ -1,8 +1,6 @@ module Dodge.AIs - ( twitchMissAI - , launcherAI + ( launcherAI , chargeAI - , sniperAI , dodgeAI , spawnerAI ) where @@ -888,108 +886,6 @@ circleClockwiseAI inRange outRange w (f,g) cr = | otherwise -> ( (f,g) , replaceImpulse [AimAt p (i-1)] $ strafeCloseSlow p cr) -twitchMissAI :: Float -> Float -> World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature) -twitchMissAI inRange outRange w (f,g) cr = - let cpos = _crPos cr - yposl = ypos +.+ 25 *.* normalizeV (vNormal (cpos -.- ypos)) - yposr = ypos -.- 25 *.* normalizeV (vNormal (cpos -.- ypos)) - yposoff = evalState (takeOne [yposl,yposr]) $ _randGen w - cid = _crID cr - ypos = _crPos $ you w - wp = _crInv cr IM.! _crInvSel cr - fireRate = fromMaybe 0 $ wp ^? itUseRate - noAmmo = 0 == _wpLoadedAmmo wp - strafeCloseSlow p | errorAngleVV 22 (p -.- cpos) - (unitVectorAtAngle (_crDir cr)) < 0.1 - = crTurnTowardSpeed 0.01 p . crMvForward closeDist - | otherwise - = crTurnAndStrafeIn inOrOut 0.05 p - where inOrOut | dist p cpos < inRange = -1 - | dist p cpos < outRange = 0 - | otherwise = 1 - closeDist | dist p cpos < inRange = -1 - | dist p cpos < outRange = 0 - | otherwise = 1 - 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) - (t,g') = randomR (fireRate+10,fireRate+15) g - retreatPs = sortBy (compare `on` dist cpos) $ map f $ nRaysRad 8 400 - where f p = fromMaybe (ypos +.+ p) $ fmap fst - $ reflectPointWalls ypos (ypos +.+ p) (wallsAlongLine ypos (ypos +.+ p) w) - retreatP' = cpos +.+ 300 *.* (cpos -.- ypos) - retreatP'' = fromMaybe retreatP' $ fmap fst - $ reflectPointWalls ypos retreatP' - $ wallsAlongLine ypos retreatP' w - retreatP = head $ sortBy (compare `on` (\p -> dist p ypos < 300)) $ retreatP'' : retreatPs - fireActions = [TurnToward yposoff, Fire, TurnTo ypos, WaitFor t - ,Fire,Fire,Reload,ImpulseID 0 (WaitFor 20),MakeJudgement] - fleeActions = [MoveToFor retreatP 50,MakeJudgement] - in --if _crHP cr <= 0 then killCr w f cr else - case head $ _goals $ _crState cr of - [] -> ((f,g), replaceGoal [] cr) - (MakeJudgement:_) - | not (canSeeFire cpos ypos w) -> ((f,g),replaceImpulse [] cr) - | dist cpos ypos > 400 -> ((f,g), replaceImpulse [MoveToFor ypos 20] cr) - | dist cpos ypos < 150 -> ((f,g'),replaceImpulse fleeActions $ crMvBy (3,0) cr) - | otherwise -> ((f,g'),replaceImpulse fireActions cr) - (ImpulseID i (WaitFor x):gls) - | x == 0 -> ( (f ,g' ), replaceImpulse [] cr ) - | otherwise -> ( (f ,g' ), replaceImpulse [ImpulseID i (WaitFor (x-1))] - $ strafeCloseSlow ypos cr ) - (WaitFor x:gls)| x == 0 -> ( (f ,g' ), replaceImpulse [] cr ) - | otherwise -> ( (f ,g' ), replaceImpulse [WaitFor (x-1)] cr ) - (MoveToFor p x:gls) - | 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.5 p cr ) - | otherwise -> ( (f , g') - , replaceImpulse [MoveToFor p (x-1)] $ crMvForward 3 - $ crTurnTowardSpeed 0.05 p cr ) - (PathTo p:_) - | canSeeFire cpos ypos w -> ((f,g),replaceGoal [[MakeJudgement]] cr) - | dist p cpos < 10 -> ( (f , g') , replaceImpulse [] cr ) - | hasLOS cpos p w -> ( (f , g') , addImpulse [MoveToFor p 50] cr ) - | otherwise -> case pointTowardsImpulse cpos p w of - Just q -> ( (f , g') , addImpulse [MoveToFor q 50] cr ) - _ -> ( (f , g') , replaceImpulse [] cr ) - (Fire:gls) -> ( (tryUseItem cid . f , g' ) - , replaceImpulse [] cr - ) - (Reload:gls) | _wpReloadState wp == 0 -> ( (f , g') , replaceImpulse [] cr ) - | canSeeFireVisionAny cid (_yourID w) w - -> ( (f , g') - , Just $ strafeCloseSlow ypos cr - ) -- no longer chase if see you when reloading - -- $ replaceImpulse [] w - | otherwise -> ( (f , g) , Just cr) - (Guard p p':_) | dist ypos cpos < 900 && canSeeFireVisionAny cid (_yourID w) w - -> ( ( f , g') - , addGoal [[MakeJudgement]] 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 - ) - (TurnToward p:_) - | errorAngleVV 99 (p -.- cpos) (unitVectorAtAngle $ _crDir cr) > 2 - -> ( (f,g') , Just . crTurnTowardSpeed 0.2 p $ cr) - | errorAngleVV 99 (p -.- cpos) (unitVectorAtAngle $ _crDir cr) > 0.2 - -> ( (f,g') , Just . crTurnTowardSpeed 0.1 p $ cr) - | otherwise - -> ( (f,g') , replaceImpulse [] . crTurnTo p $ cr) - (TurnTo p:_) -> ( (f,g') , replaceImpulse [] . crTurnTo p $ cr) - closeToRangeAI :: Float -> Float -> World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature) closeToRangeAI inRange outRange w (f,g) cr = let cpos = _crPos cr @@ -1208,86 +1104,6 @@ suppressShooterAI w (f,g) 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 = - 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) - 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 < 1 -> ( (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 < 1 -> ( (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 ,WaitFor 50 ]] 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 [[WaitFor 50 ]] cr) - (Reload:gls) - | _wpReloadState wp == 0 -> ( (f , g) , replaceImpulse [] cr ) - | canSeeFireVisionAny cid (_yourID w) w -> - ( (f , g) , Just $ turnCloseSlow ypos cr) - | 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':_) | canSeeFireVision cid (_yourID w) w - -> ( ( f , g1) - , addGoal [[AimAt ypos (2*aimtime)]] cr - ) - | dist cpos p > 1 - -> ( (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 ) - | canSeeFireVision cid (_yourID w) w - -> ( (f,g) , replaceImpulse [AimAt ypos (i-1)] $ crTurnTowardSpeed 0.2 p cr) - | otherwise - -> ( (f,g) , replaceImpulse [AimAt p (i-1)] $ turnCloseSlow p cr) - errorNormalizeVAI :: Point2 -> Point2 errorNormalizeVAI (0,0) = error "problem with function: errorNormalizeVAI in DodgeAIs" errorNormalizeVAI p = normalizeV p diff --git a/src/Dodge/Creature.hs b/src/Dodge/Creature.hs index ca7dbc432..31d42a547 100644 --- a/src/Dodge/Creature.hs +++ b/src/Dodge/Creature.hs @@ -111,7 +111,26 @@ miniGunCrit = defaultCreature longCrit :: Creature longCrit = defaultCreature { _crPict = basicCrPict red - , _crUpdate = stateUpdate sniperAI +-- , _crUpdate = stateUpdate sniperAI + , _crUpdate = stateUpdate $ impulsiveAI $ composeInternalAIs + [ performActions + , watchUpdateStrat + [ (crHasTargetLOS, aimThenShootStrat 0) + , (crAwayFromPost, goToPostStrat) + ] + , basicPerceptionUpdate [0] + , doStrategyActions + , reloadOverrideNoHolster + , targetYouWhenCognizant + , overrideInternal (onBoth (&&) crHasTarget (crStratConMatches (GetTo (0,0)))) + $ \ _ -> crActionPlan . crStrategy .~ WatchAndWait + ] + , _crActionPlan = ActionPlan + { _crImpulse = [] + , _crAction = [] + , _crStrategy = StrategyActions WatchAndWait [StartSentinelPost] + , _crGoal = [] + } , _crInv = IM.fromList [(0,longGun),(1,medkit 100)] , _crInvSel = 0 , _crRad = 10 @@ -130,7 +149,8 @@ multGunCrit = defaultCreature , _crUpdate = stateUpdate $ impulsiveAI $ composeInternalAIs [ performActions , watchUpdateStrat - [ (crHasTargetLOS, shootFirstMiss 0) + [ (not . crSafeDistFromTarg 150 , fleeTime 5) + , (crHasTargetLOS, shootFirstMiss 0) , (crAwayFromPost, goToPostStrat) ] , basicPerceptionUpdate [0] @@ -196,7 +216,7 @@ autoCrit = defaultCreature , _crActionPlan = ActionPlan { _crImpulse = [] , _crAction = [] - , _crStrategy = StrategyActions [StartSentinelPost] WatchAndWait + , _crStrategy = StrategyActions WatchAndWait [StartSentinelPost] , _crGoal = [] } , _crInv = IM.fromList [(0,autoGun),(1,medkit 100)] diff --git a/src/Dodge/Creature/Action.hs b/src/Dodge/Creature/Action.hs index 501fcd27e..0ff722c80 100644 --- a/src/Dodge/Creature/Action.hs +++ b/src/Dodge/Creature/Action.hs @@ -50,8 +50,6 @@ crStrafeRight speed cr = advanceStepCounter s2 $ over crPos (+.+ p) cr equipFactor = product $ map equipSpeed $ IM.elems $ _crInv cr s2 = (speed * equipFactor) - - turnTo :: Point2 -- ^ Target point -> Int -- ^ Creature id diff --git a/src/Dodge/Creature/Action/Flee.hs b/src/Dodge/Creature/Action/Flee.hs new file mode 100644 index 000000000..b176c8705 --- /dev/null +++ b/src/Dodge/Creature/Action/Flee.hs @@ -0,0 +1,25 @@ +module Dodge.Creature.Action.Flee + where +import Dodge.Data +import Geometry + +import Data.List +import Data.Maybe + +retreatPointForFrom + :: Float -> World -> Creature -> Point2 -> Maybe Point2 +retreatPointForFrom d w cr p + = listToMaybe + . sortOn (dist cpos) + $ divideCircle 10 p d + where + cpos = _crPos cr +-- = head $ sortBy (compare `on` (\p -> dist p ypos < 300)) $ retreatP'' : retreatPs +-- where +-- retreatPs = sortBy (compare `on` dist cpos) $ map f $ nRaysRad 8 400 +-- where f p = fromMaybe (ypos +.+ p) $ fmap fst +-- $ reflectPointWalls ypos (ypos +.+ p) (wallsAlongLine ypos (ypos +.+ p) w) +-- retreatP' = cpos +.+ 300 *.* (cpos -.- ypos) +-- retreatP'' = fromMaybe retreatP' $ fmap fst +-- $ reflectPointWalls ypos retreatP' +-- $ wallsAlongLine ypos retreatP' w diff --git a/src/Dodge/Creature/ActionRat.hs b/src/Dodge/Creature/ActionRat.hs index 35734c65b..c46fa84d9 100644 --- a/src/Dodge/Creature/ActionRat.hs +++ b/src/Dodge/Creature/ActionRat.hs @@ -1,15 +1,18 @@ module Dodge.Creature.ActionRat ( shootTargetWithStrat + , aimThenShootStrat , suppressShootTarget , suppress , shootAdvance , shootFirstMiss , doStrategyActions , reloadOverride + , reloadOverrideNoHolster , shootAdvanceStrat , watchUpdateStrat , goToPostStrat , overrideInternal + , fleeTime ) where import Dodge.Data @@ -63,16 +66,16 @@ suppress w cr tcr as | otherwise = as shootFirstMiss :: Int -> World -> Creature -> Strategy -shootFirstMiss tcid w cr = StrategyActions acs (ShootAt tcid) +shootFirstMiss tcid w cr = StrategyActions (ShootAt tcid) acs where acs = [ DoActionIfElse NoAction crIsAiming (DoActionThen DrawWeapon (WaitThen 50 NoAction)) `DoActionThen` - LeadTarget (10,50) + LeadTarget (30,50) `DoActionThen` advanceShoot `DoActionThen` - LeadTarget (50,0) + LeadTarget (0,0) `DoActionThen` (advanceShoot `DoActionWhileThen` lostest $ DoReplicateThen advanceShoot 75 @@ -82,36 +85,59 @@ shootFirstMiss tcid w cr = StrategyActions acs (ShootAt tcid) lostest (w,cr') = canSee (_crID cr') tcid w advanceShoot = ImpulsesList [[UseItem, MoveForward 3]] +fleeTime :: Int -> World -> Creature -> Strategy +fleeTime t w cr = StrategyActions Flee + [ UseTargetCID FleeFrom `DoReplicateThen` t + $ DoImpulses [ChangeStrategy WatchAndWait] + ] + +aimThenShootStrat :: Int -> World -> Creature -> Strategy +aimThenShootStrat tcid _ _ = StrategyActions (ShootAt tcid) + [ DoActionIfElse NoAction crIsAiming (DoActionThen DrawWeapon (WaitThen 50 NoAction)) + `DoActionThen` + 50 + `WaitThen` + DoImpulses [UseItem, ChangeStrategy WatchAndWait] + , AimAtCloseSlow + { _targetID = tcid + , _targetSeenAt = (0,0) -- hack + , _aimSpeed = 0.2 + , _slowAimSpeed = 0.01 + , _slowAimAngle = pi/8 + } + ] + where + lostest (w,cr') = canSee (_crID cr') tcid w + advanceShoot = ImpulsesList [[UseItem, MoveForward 3]] shootAdvanceStrat :: Int -> World -> Creature -> Strategy -shootAdvanceStrat tcid _ _ = StrategyActions acs (ShootAt tcid) +shootAdvanceStrat tcid _ _ = StrategyActions (ShootAt tcid) + [ 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 + } + ] 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 + Just (SentinelAt p _) -> StrategyActions (GetTo p) [DoActionThen (WaitThen 150 holsterIfAiming) $ DoActionThen (PathTo p) NoAction -- $ DoImpulses [ChangeStrategy WatchAndWait] - ] $ GetTo p + ] _ -> WatchAndWait where sentinelGoal (SentinelAt p dir) = True @@ -160,7 +186,7 @@ applyNewStrategies -> Creature -> Creature applyNewStrategies w cr = case cr ^? crActionPlan . crStrategy of - Just (StrategyActions acs strat) -> cr & crActionPlan . crAction .~ acs + Just (StrategyActions strat acs) -> cr & crActionPlan . crAction .~ acs & crActionPlan . crStrategy .~ strat otherwise -> cr @@ -169,7 +195,7 @@ doStrategyActions -> Creature -> Creature doStrategyActions w cr = case cr ^? crActionPlan . crStrategy of - Just (StrategyActions acs strat) -> cr & crActionPlan . crAction .~ acs + Just (StrategyActions strat acs) -> cr & crActionPlan . crAction .~ acs & crActionPlan . crStrategy .~ strat otherwise -> cr @@ -187,7 +213,7 @@ reloadOverride reloadOverride _ cr | cr ^? crInv . ix (_crInvSel cr) . wpLoadedAmmo == Just 0 && cr ^. crStance . posture == Aiming - = cr & crActionPlan . crStrategy .~ StrategyActions reloadActions Reload + = cr & crActionPlan . crStrategy .~ StrategyActions Reload reloadActions | otherwise = cr where reloadActions = @@ -195,6 +221,20 @@ reloadOverride _ cr , WaitThen 1 $ DoActionWhileThen NoAction crIsReloading (DoImpulses [ChangeStrategy WatchAndWait]) ] +reloadOverrideNoHolster + :: World + -> Creature + -> Creature +reloadOverrideNoHolster _ cr + | cr ^? crInv . ix (_crInvSel cr) . wpLoadedAmmo == Just 0 + && cr ^. crStance . posture == Aiming + = cr & crActionPlan . crStrategy .~ StrategyActions Reload reloadActions + | otherwise = cr + where + reloadActions = + [ DoActionWhileThen NoAction crIsReloading (DoImpulses [ChangeStrategy WatchAndWait]) + ] + watchUpdateStrat :: [ ((World, Creature) -> Bool, World -> Creature -> Strategy) ] -> World diff --git a/src/Dodge/Creature/Inanimate.hs b/src/Dodge/Creature/Inanimate.hs index 15dd9b0ad..e74d48aa2 100644 --- a/src/Dodge/Creature/Inanimate.hs +++ b/src/Dodge/Creature/Inanimate.hs @@ -28,6 +28,7 @@ lamp = defaultInanimate , _crHP = 100 , _crPict = \ _ -> onLayer CrLayer $ color white $ circleSolid 3 , _crRad = 3 + , _crMass = 3 } initialiseLamp :: CRUpdate @@ -37,7 +38,20 @@ initialiseLamp w (f,g) cr = ( (addLS . f , g), Just $ cr & crUpdate .~ updateLam addLS = over lightSources (IM.insert i (lightAt (_crPos cr) i)) updateLamp :: Int -> CRUpdate -updateLamp i = unrandUpdate handleLS internalUpdate +updateLamp i w (f,g) cr = ((handleLS . f, g), internalUpdate) + where + handleLS w' + | _crHP cr < 0 = explosionFlashAt cPos + $ mkSoundBreakGlass cPos w' & lightSources %~ IM.delete i + | otherwise = w' & lightSources . ix i . lsPos .~ cPos + where + cPos = _crPos cr + internalUpdate + | _crHP cr < 0 = Nothing + | otherwise = fmap doDamage $ Just cr + +updateLamp' :: Int -> CRUpdate +updateLamp' i = unrandUpdate handleLS internalUpdate where handleLS cr w | _crHP cr < 0 = explosionFlashAt cPos diff --git a/src/Dodge/Creature/Rationality.hs b/src/Dodge/Creature/Rationality.hs index 84c247311..46f2eda92 100644 --- a/src/Dodge/Creature/Rationality.hs +++ b/src/Dodge/Creature/Rationality.hs @@ -147,6 +147,12 @@ performAction cr w ac = case ac of Just tcid -> let tcr = _creatures w IM.! tcid in ([TurnTo (_crPos tcr +.+ rotateV (_crDir tcr) p)], Nothing) _ -> ([], Nothing) + FleeFrom cid -> case w ^? creatures . ix cid of + Just tcr -> ([MoveForward 3, TurnToward ((2 *.* _crPos cr) -.- _crPos tcr) (pi/4)], Nothing) + _ -> ([], Nothing) + UseTargetCID f -> case cr ^? crTarget . _Just of + Just tcid -> performAction cr w (f tcid) + _ -> ([],Nothing) _ -> ([], Nothing) where cpos = _crPos cr diff --git a/src/Dodge/Creature/State.hs b/src/Dodge/Creature/State.hs index 50329b45b..8e1b9b4ab 100644 --- a/src/Dodge/Creature/State.hs +++ b/src/Dodge/Creature/State.hs @@ -79,22 +79,24 @@ dropByState cr w = foldr (copyItemToFloor cr) w is setOldPos :: Creature -> Creature setOldPos cr = set crOldPos (_crPos cr) cr -{- +{- | Given a creature and a velocity, applies friction to that creature and evaluates a velocity to carry across frames. -} crFriction :: Creature -> Point2 -> Point2 crFriction cr vel = (0,0) +{- | In order to force a list, apply with seq -} +forceSpine :: [a] -> () +forceSpine = foldr (const id) () + doDamage :: Creature -> Creature -doDamage cr = set (crState . crDamage) [] $ over (crState . crPastDamage) (take 20 . (dams :) ) - damagedCr +doDamage cr = set (crState . crDamage) [] + $ over (crState . crPastDamage) (f . take 20 . (dams :) ) damagedCr where + f l = seq (forceSpine l) l dams = _crDamage $ _crState cr - startHP = _crHP cr damagedCr = snd $ (_crApplyDamage cr) dams cr - afterHP = _crHP damagedCr - hpLost = startHP - afterHP -- note this can be negative sumDamage :: Creature -> DamageType -> Int -> Int sumDamage cr dm x = x + _dmAmount dm diff --git a/src/Dodge/Creature/Test.hs b/src/Dodge/Creature/Test.hs index 839b492da..11f5f58e1 100644 --- a/src/Dodge/Creature/Test.hs +++ b/src/Dodge/Creature/Test.hs @@ -42,6 +42,11 @@ crHasTargetLOS (w,cr) = case cr ^? crTarget . _Just of Just i -> crCanSeeCID i (w,cr) Nothing -> False +crSafeDistFromTarg :: Float -> (World,Creature) -> Bool +crSafeDistFromTarg d (w,cr) = case cr ^? crTarget . _Just of + Just i -> dist (_crPos cr) (_crPos $ _creatures w IM.! i) > d + Nothing -> True + crStratConMatches :: Strategy -> (World,Creature) -> Bool crStratConMatches strat (_,cr) = eqConstr strat (_crStrategy $ _crActionPlan cr) diff --git a/src/Dodge/Creature/Update.hs b/src/Dodge/Creature/Update.hs index c9f626664..a72eb331d 100644 --- a/src/Dodge/Creature/Update.hs +++ b/src/Dodge/Creature/Update.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE BangPatterns #-} module Dodge.Creature.Update where import Dodge.Data @@ -7,6 +8,9 @@ import System.Random type CRUpdate = World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature) -unrandUpdate :: (Creature -> World -> World) -> (Creature -> Maybe Creature) +unrandUpdate + :: (Creature -> World -> World) + -> (Creature -> Maybe Creature) -> CRUpdate +{-# INLINE unrandUpdate #-} unrandUpdate h cF w (f,g) cr = ( ( h cr . f , g) , cF cr ) diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index fe0679952..7fcc52c40 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -478,6 +478,8 @@ data Impulse | AddGoal Goal | ArbitraryCreatureImpulse (World -> Creature -> Creature) -- deriving (Eq,Ord,Show) +infixr 9 `WaitThen` +infixr 9 `DoActionThen` data Action = Attack {_attackTargetID :: Int} @@ -560,6 +562,9 @@ data Action } | NoAction | StartSentinelPost + | UseTargetCID + {_useTargetCID :: Int -> Action + } deriving (Generic) -- deriving (Eq,Ord,Show) data Strategy @@ -570,9 +575,10 @@ data Strategy | ShootAt Int | FollowImpulses | WatchAndWait - | StrategyActions [Action] Strategy + | StrategyActions Strategy [Action] | GetTo Point2 | Reload + | Flee deriving (Generic) -- deriving (Eq,Ord,Show) data Goal diff --git a/src/Dodge/Render/Picture.hs b/src/Dodge/Render/Picture.hs index a63114348..56aa8f744 100644 --- a/src/Dodge/Render/Picture.hs +++ b/src/Dodge/Render/Picture.hs @@ -45,7 +45,10 @@ customMouseCursor w = $ pictures [ line [(-5,0),(5,0)] , line [(0,-5),(0,5)] ] testPic :: World -> [Picture] -testPic w = [blank] +testPic w = + [ setDepth (-1) . translate 0 0.8 + . scale 0.001 0.001 . text . show . length . IM.elems . IM.filter ( (== 3) . _crRad ) $ _creatures w + ] crDraw :: Creature -> Picture crDraw c = uncurry translate (_crPos c) $ rotate (_crDir c) (_crPict c c) diff --git a/src/Dodge/WallCreatureCollisions.hs b/src/Dodge/WallCreatureCollisions.hs index 48f23bcfa..14c7a10f0 100644 --- a/src/Dodge/WallCreatureCollisions.hs +++ b/src/Dodge/WallCreatureCollisions.hs @@ -39,7 +39,7 @@ colCrWall w c -- -- probably best to push check pushing through walls before creature springs -- the amount to push creatures out from walls, extra to their radius -wallBuffer = 3 +wallBuffer = 0 -- the following tests whether or not a point is on a wall, and if so pushes it -- out from the wall @@ -49,7 +49,7 @@ collideWalls rad cp1 walls cp2 = case (listToMaybe.mapMaybe (pushOutFromWall rad Nothing -> cp2 Just cp3 -> case (listToMaybe.reverse.mapMaybe (pushOutFromWall rad cp3)) walls of Nothing -> cp3 - Just cp4 -> cp1 + Just cp4 -> 0.5 *.* (cp4 +.+ cp1) -- pushes a point out from a list of walls -- if multiple new points occur, chooses the one closest to the orignal point