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

Assorted changes, cleanup menu selection text

Browse Source
This commit is contained in:
justin
2022-04-25 23:27:39 +01:00
parent 67e6c4a5bd
commit fa8d8b5899
22 changed files with 217 additions and 108 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/Action.hs
+17 -3
View File
@@ -18,6 +18,7 @@ module Dodge.Creature.Action
)
where
import Dodge.Inventory.Add
--import Dodge.ShortShow
import Dodge.Path
import Dodge.Default
import Dodge.WallCreatureCollisions
@@ -65,14 +66,27 @@ performAimAt cr w tcid p = ([TurnToward tpos aimSp], Just $ AimAt tcid tpos)
performPathTo :: Creature -> World -> Point2 -> OutAction
performPathTo cr w p
| dist cpos p < 5 = ([], Nothing)
| hasLOS cpos p w = ([MvTurnToward p,MvForward,RandomTurn jit] , Just (PathTo p))
| otherwise = case pointTowardsImpulse cpos p w of
Just q -> ([MvTurnToward q,MvForward,RandomTurn jit] , Just (PathTo p))
| isWalkable cpos p w = ([MvTurnToward p,MvForward,RandomTurn jit] , Just (PathTo p))
| otherwise = case pointTowardsImpulse p cpos w of
Just q -> ([MvTurnToward q
,MvForward
,RandomTurn jit
,ArbitraryImpulseEffect . const
$ debugPicture .~ drawPathList cpos p w
]
, Just (PathTo p))
_ -> ([],Nothing)
where
cpos = _crPos cr
jit = _mvTurnJit $ _crMvType cr
drawPathList :: Point2 -> Point2 -> World -> Picture
drawPathList x y w = case makePathBetweenPs x y w of
Nothing -> setLayer DebugLayer $ color red $ line [x,y]
Just [] -> setLayer DebugLayer $ color green $ line [x,y]
Just as -> setLayer DebugLayer $ color orange (line as)
<> color blue (line [head as,x]) <> color yellow (line [last as, y])
performTurnToA :: Creature -> Point2 -> OutAction
performTurnToA cr p
| angleVV cdirv dirv < 0.1 = ([], Nothing)
src/Dodge/Creature/ChaseCrit.hs
+4 -11
View File
@@ -35,9 +35,9 @@ chaseCrit = defaultCreature
, performActions
, const overrideMeleeCloseTarget
, const setViewPos
, const setMvPos
, goToTarget
, perceptionUpdate [0]
, setMvPos
, chaseCritMv
, chaseCritPerceptionUpdate [0]
, targetYouWhenCognizant
, const (crMeleeCooldown %~ max 0 . subtract 1)
]
@@ -47,12 +47,5 @@ chaseCrit = defaultCreature
, _crMeleeCooldown = 0
, _crFaction = ColorFaction green
, _crVocalization = Vocalization seagullChatterS 50 0
, _crMvType = ChaseMvType
{ _mvSpeed = 3
, _mvTurnRad = f
, _mvTurnJit = 0.2
}
, _crMvType = defaultChaseMvType
}
where
f x | x > pi / 4 = 0.2
| otherwise = 0.05
src/Dodge/Creature/Impulse.hs
+1
View File
@@ -67,6 +67,7 @@ followImpulse cr w imp = case imp of
AddGoal gl -> crup $ cr & crActionPlan . crGoal .:~ gl
ArbitraryImpulseFunction f -> crup $ f w cr
ArbitraryImpulse f -> followImpulse cr w (f cr w)
ArbitraryImpulseEffect f -> (f cr, cr)
ImpulseUseTargetCID f -> case cr ^? crIntention . targetCr . _Just of
Just tcr -> followImpulse cr w (f $ _crID tcr)
_ -> crup cr
src/Dodge/Creature/Perception.hs
+40 -4
View File
@@ -1,11 +1,13 @@
--{-# LANGUAGE TupleSections #-}
module Dodge.Creature.Perception
( perceptionUpdate
, chaseCritPerceptionUpdate
, newSounds
) where
import Dodge.Data
import Dodge.Creature.Vocalization
import Dodge.Base.Collide
import Dodge.RandomHelp
--import Dodge.SoundLogic
import Geometry.Vector
--import Geometry.Data
@@ -13,6 +15,7 @@ import Geometry.Data
import Sound.Data
--import StrictHelp
import Control.Monad.State
import Data.Maybe
import Control.Lens
import qualified Data.IntMap.Strict as IM
@@ -25,10 +28,16 @@ perceptionUpdate
-> Creature
perceptionUpdate is w = rememberSounds w . basicAwarenessUpdate . basicAttentionUpdate is w
chaseCritPerceptionUpdate :: [Int] -> World -> Creature -> Creature
chaseCritPerceptionUpdate is w =
rememberSounds w . chaseCritAwarenessUpdate w . basicAttentionUpdate is w
{- | Update a creatures awareness based upon the creatures' current direction
of attention -}
basicAwarenessUpdate :: Creature -> Creature
basicAwarenessUpdate cr = case _crAttentionDir $ _crPerception cr of
Fixated i -> cr & crPerception . crAwarenessLevel
%~ (IM.insert i (Cognizant 10000) . IM.mapMaybe decreaseAwareness)
AttentiveTo is -> cr
& crPerception . crAwarenessLevel
%~ (IM.mapMaybe decreaseAwareness . IM.unionWith combineAwareness is)
@@ -41,8 +50,29 @@ basicAwarenessUpdate cr = case _crAttentionDir $ _crPerception cr of
Just sid -> crActionPlan . crImpulse .~ [Bark sid]
Nothing -> id
| otherwise = id
Fixated i -> cr & crPerception . crAwarenessLevel
%~ ( IM.insert i (Cognizant 10000) . IM.mapMaybe decreaseAwareness)
chaseCritAwarenessUpdate :: World -> Creature -> Creature
chaseCritAwarenessUpdate w cr = case _crAttentionDir $ _crPerception cr of
Fixated i -> cr & crPerception . crAwarenessLevel
%~ (IM.insert i (Cognizant 10000) . IM.mapMaybe decreaseAwareness)
AttentiveTo is -> cr
& crPerception . crAwarenessLevel
%~ (IM.mapMaybe decreaseAwareness . IM.unionWith combineAwareness is)
& maybeBark
where
oldAwareness = _crAwarenessLevel $ _crPerception cr
newAwareness = (IM.mapMaybe decreaseAwareness . IM.unionWith combineAwareness is) oldAwareness
becomesCognizant = any isCognizant $ IM.unionWith cogRaised oldAwareness newAwareness
randBool = takeOne [False,True] & evalState $ _randGen w
maybeBark
| becomesCognizant && randBool =
crActionPlan . crStrategy .~ StrategyActions WarningCry
[DoImpulses [Bark $ fromJust $ vocalizationTest cr]
`DoActionThen` 20
`WaitThen` DoImpulses [ChangeStrategy $ CloseToMelee 0]
, AimAt 0 (_crPos $ _creatures w IM.! 0)
]
| otherwise = id
cogRaised :: AwarenessLevel -> AwarenessLevel -> AwarenessLevel
cogRaised Suspicious{} Cognizant{} = Cognizant 100
@@ -76,7 +106,7 @@ basicAttentionUpdate
-> Creature
-> Creature
basicAttentionUpdate cids w cr = cr & crPerception . crAttentionDir .~
AttentiveTo (IM.mapMaybe (newExtraAwareness cr w) $ IM.fromList $ zip cids cids)
AttentiveTo (IM.mapMaybe (newExtraAwareness cr w) $ IM.fromList $ zip cids cids)
newExtraAwareness
:: Creature -- ^ source creature
@@ -110,7 +140,13 @@ newSounds = mapMaybe f . M.elems . _playingSounds
rememberSounds :: World -> Creature -> Creature
rememberSounds w cr = cr
& crMemory . soundsToInvestigate .~ map fst (filter (soundIsClose cr) (newSounds w))
& crMemory . soundsToInvestigate .~ closesounds
& awakeupdate
where
awakeupdate | null closesounds = id
| otherwise = crPerception . crAwakeLevel .~ Vigilant
closesounds = map fst (filter (soundIsClose cr) (newSounds w))
soundIsClose :: Creature -> (Point2,Float) -> Bool
soundIsClose cr (pos,vol) = vol > (_auDist . _crAudition $ _crPerception cr) (dist pos (_crPos cr))
src/Dodge/Creature/ReaderUpdate.hs
+17 -3
View File
@@ -9,6 +9,7 @@ module Dodge.Creature.ReaderUpdate
, overrideInternal
, goToTarget
, flockACC
, chaseCritMv
, setMvPos
, setViewPos
) where
@@ -38,11 +39,16 @@ tryMeleeAttack cr tcr
where
cpos = _crPos cr
setMvPos :: Creature -> Creature
setMvPos cr = cr & crIntention . mvToPoint .~ mpos
setMvPos :: World -> Creature -> Creature
setMvPos w cr = cr & crIntention . mvToPoint .~ mpos
where
int = _crIntention cr
mpos = (_crPos <$> _targetCr int)
mtpos = do
tpos <- _crPos <$> _targetCr int
if hasLOS (_crPos cr) tpos w
then Just tpos
else Nothing
mpos = mtpos
<|> _mvToPoint int
-- <|> listToMaybe (_soundsToInvestigate $ _crMemory cr)
@@ -80,6 +86,14 @@ flockACC w cr = case cr ^? crIntention . targetCr . _Just of
else negate r *.* horDir
in cr & crIntention . mvToPoint ?~ tpos +.+ horShift
chaseCritMv :: World -> Creature -> Creature
chaseCritMv w cr = case _crStrategy (_crActionPlan cr) of
StrategyActions _ _ -> cr
WarningCry -> cr
_ -> case cr ^? crIntention . mvToPoint . _Just of
Just p -> cr & crActionPlan . crAction .~ [PathTo p]
_ -> viewTarget w cr
goToTarget :: World -> Creature -> Creature
goToTarget w cr =
case cr ^? crIntention . mvToPoint . _Just of
src/Dodge/Creature/State.hs
+13 -11
View File
@@ -129,27 +129,29 @@ movementSideEff cr w
(randAng,_) = randomR (0,2*pi) $ _randGen w
heldItemUpdate :: Int -> Item -> Item
heldItemUpdate invid = (itIsHeld .~ True) . invItemUpdate invid
heldItemUpdate invid = (itUse %~ useUpdate) . (itIsHeld .~ True) . (itInvPos ?~ invid)
invItemUpdate :: Int -> Item -> Item
invItemUpdate invid = (itUse %~ useupdate) . (itIsHeld .~ False) . (itInvPos ?~ invid)
where
useupdate = (useHammer . hammerPosition %~ moveHammerUp)
invItemUpdate invid = (itUse %~ useUpdate) . (itIsHeld .~ False) . (itInvPos ?~ invid)
useUpdate :: ItemUse -> ItemUse
useUpdate = (useHammer . hammerPosition %~ moveHammerUp)
. (useDelay . warmTime %~ decreaseToZero)
. (useDelay . rateTime %~ decreaseToZero)
useEquipment :: Creature -> Int -> World -> World
useEquipment cr i = _eqUse (_itUse $ _crInv cr IM.! i) cr i
invSideEff :: Creature -> World -> World
invSideEff cr w = weaponReloadSounds cr
. flip (IS.foldr useeq) (_crInvEquipped cr)
-- . doHeldItemTargeting cr
. flip (IS.foldr $ useEquipment cr) (_crInvEquipped cr)
$ IM.foldrWithKey f w (_crInv cr)
where
useeq i = _eqUse (_itUse $ _crInv cr IM.! i) cr i
f i it w' = case it ^? itEffect . itInvEffect of
Nothing -> w' & doitemupdate
Just g -> g (_itEffect it) cr i w' & doitemupdate
f i it w' = doitemupdate w' & case it ^? itEffect . itInvEffect of
Nothing -> id
Just g -> g (heldItemUpdate i it) cr -- this is done twice!
where
doitemupdate
doitemupdate
| i == _crInvSel cr = doItemTargeting i cr . (itpointer %~ heldItemUpdate i)
| otherwise = doItemTargeting i cr . (itpointer %~ invItemUpdate i)
itpointer = creatures . ix (_crID cr) . crInv . ix i