justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Add file, fix lamp doDamage space leak

Browse Source
This commit is contained in:
justin
2021-05-12 20:48:55 +02:00
parent ead87af3c1
commit 9b3fbba393
13 changed files with 165 additions and 226 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/Action.hs
-2
View File
@@ -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
src/Dodge/Creature/Action/Flee.hs
+25
View File
@@ -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
src/Dodge/Creature/ActionRat.hs
+64 -24
View File
@@ -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
src/Dodge/Creature/Inanimate.hs
+15 -1
View File
@@ -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
src/Dodge/Creature/Rationality.hs
+6
View File
@@ -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
src/Dodge/Creature/State.hs
+8 -6
View File
@@ -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
src/Dodge/Creature/Test.hs
+5
View File
@@ -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)
src/Dodge/Creature/Update.hs
+5 -1
View File
@@ -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 )