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

Add frame clock

Browse Source
This commit is contained in:
justin
2021-09-09 13:29:09 +01:00
parent a2288110ae
commit be7b2d2cd7
27 changed files with 176 additions and 87 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/Action.hs
+14 -3
View File
@@ -69,6 +69,16 @@ performPathTo cr w p
cpos = _crPos cr
jit = _mvTurnJit $ _crMvType cr
performTurnToA :: Creature -> Point2 -> OutAction
performTurnToA cr p
| angleVV cdirv dirv < 0.1 = ([], Nothing)
| otherwise = ([MvTurnToward p,RandomTurn jit] , Just (TurnToA p))
where
cpos = _crPos cr
cdirv = unitVectorAtAngle (_crDir cr)
dirv = p -.- cpos
jit = _mvTurnJit $ _crMvType cr
{- | Performing an action means that a creature has some impulses for a frame, and
updates or deletes the action itself.
-- doAction -}
@@ -108,13 +118,14 @@ performAction cr w ac = case ac of
in (concat imps, Just . DoActions $ catMaybes newAcs)
StartSentinelPost -> ([AddGoal $ SentinelAt (_crPos cr) (_crDir cr)], Nothing)
PathTo p -> performPathTo cr w p
LeadTarget p -> case cr ^? crTarget . _Just of
TurnToA p -> performTurnToA cr p
LeadTarget p -> case cr ^? crIntention . targetCr . _Just of
Just tcr -> ([TurnTo (_crPos tcr +.+ rotateV (_crDir tcr) p)], Nothing)
_ -> ([], Nothing)
UseTarget f -> performAction cr w $ f $ cr ^? crTarget . _Just
UseTarget f -> performAction cr w $ f $ cr ^? crIntention . targetCr . _Just
UseSelf f -> performAction cr w $ f cr
UseAheadPos f -> performAction cr w (f (_crPos cr +.+ 20 *.* unitVectorAtAngle (_crDir cr)))
UseMvTargetPos f -> performAction cr w $ f $ _crMvTarget cr
UseMvTargetPos f -> performAction cr w $ f $ _mvToPoint $ _crIntention cr
ArbitraryAction f -> performAction cr w (f cr w)
DoImpulsesAlongside sideImp mainAc -> case performAction cr w mainAc of
(imp, Just nxtac) -> (sideImp ++ imp, Just $ DoImpulsesAlongside sideImp nxtac)
src/Dodge/Creature/ArmourChase.hs
+1 -1
View File
@@ -26,7 +26,7 @@ armourChaseCrit = defaultCreature
doStrategyActionsR >=>
performActionsR >=>
targetYouWhenCognizantR >=>
setTargetMv (pure . _crTarget) >=> -- should be able to remove this?
setTargetMv (pure . _targetCr . _crIntention) >=> -- should be able to remove this?
flockACCR >=>
perceptionUpdate [0] >=>
goToTarget >=>
src/Dodge/Creature/Boid.hs
+3 -3
View File
@@ -171,7 +171,7 @@ swarmUsingCenter
-> World
-> Creature
-> Creature
swarmUsingCenter updT upd w cr = case _crTarget cr of
swarmUsingCenter updT upd w cr = case _targetCr $ _crIntention cr of
Nothing -> upd cenp cr
Just tcr -> updT tcr cenp cr
where
@@ -184,7 +184,7 @@ flockChaseTarget
-> World
-> Creature
-> Creature
flockChaseTarget updT upd w cr = case _crTarget cr of
flockChaseTarget updT upd w cr = case _targetCr $ _crIntention cr of
Nothing -> upd crs cr
Just tcr -> updT tcr crs cr
where
@@ -210,7 +210,7 @@ flockToPointUsing
-> (Point2 -> Creature -> Creature -> [Impulse])
-> Creature
-> Reader World Creature
flockToPointUsing pf mvf cr = reader $ \w -> case _crTarget cr of
flockToPointUsing pf mvf cr = reader $ \w -> case _targetCr $ _crIntention cr of
Nothing -> cr
Just tcr -> cr & crActionPlan . crImpulse .~ mvf ptarg cr tcr
where
src/Dodge/Creature/ChaseCrit.hs
+1
View File
@@ -38,6 +38,7 @@ chaseCrit = defaultCreature
doStrategyActionsR >=>
performActionsR >=>
overrideMeleeCloseTargetR >=>
setViewPos >=>
setMvPos >=>
-- setTargetMv (pure . _crTarget) >=>
goToTarget >=>
src/Dodge/Creature/Impulse.hs
+2 -2
View File
@@ -62,10 +62,10 @@ followImpulse cr w imp = case imp of
AddGoal gl -> (id, cr & crActionPlan . crGoal %~ (gl :) )
ArbitraryImpulseFunction f -> (id, f w cr)
ArbitraryImpulse f -> followImpulse cr w (f cr w)
ImpulseUseTargetCID f -> case cr ^? crTarget . _Just of
ImpulseUseTargetCID f -> case cr ^? crIntention . targetCr . _Just of
Just tcr -> followImpulse cr w (f $ _crID tcr)
_ -> (id,cr)
ImpulseUseTarget f -> case cr ^? crTarget . _Just of
ImpulseUseTarget f -> case cr ^? crIntention . targetCr . _Just of
Just tcr -> followImpulse cr w (f tcr)
_ -> (id,cr)
ImpulseUseAheadPos f -> followImpulse cr w (f (_crPos cr +.+ 20 *.* unitVectorAtAngle (_crDir cr)))
src/Dodge/Creature/Intention.hs
+2
View File
@@ -0,0 +1,2 @@
module Dodge.Creature.Intention
where
src/Dodge/Creature/Memory/Data.hs
+1 -1
View File
@@ -6,7 +6,7 @@ import Geometry.Data
import Control.Lens
data MemoryState = MemoryState
newtype MemoryState = MemoryState
{ _soundsToInvestigate :: [Point2]
}
src/Dodge/Creature/Perception.hs
+2 -2
View File
@@ -1,4 +1,4 @@
{-# LANGUAGE TupleSections #-}
--{-# LANGUAGE TupleSections #-}
module Dodge.Creature.Perception
( perceptionUpdate
, newSounds
@@ -96,7 +96,7 @@ newSounds = mapMaybe f . M.elems . _playingSounds
rememberSounds :: Creature -> Reader World Creature
rememberSounds cr = do
sList <- fmap newSounds ask
sList <- asks newSounds
return $ cr & crMemory . soundsToInvestigate .~ map fst (filter (soundIsClose cr) sList)
-- return $ cr & crMemory . soundsToInvestigate .~ [V2 0 0]
src/Dodge/Creature/Perception/Data.hs
+1 -1
View File
@@ -35,7 +35,7 @@ data Vision = Eyes
{ _viFOV :: Float -> Float
, _viDist :: Float -> Float
}
data Audition = Ears
newtype Audition = Ears
{ _auDist :: Float -> Float
}
src/Dodge/Creature/Picture.hs
+29 -15
View File
@@ -10,14 +10,15 @@ module Dodge.Creature.Picture
import Dodge.Data
--import Dodge.Base
--import Dodge.Creature.Stance.Data
--import Dodge.Creature.Perception.Data
import Dodge.Creature.Perception.Data
import Dodge.Creature.State.Data
import Dodge.Creature.Stance.Data
import Dodge.Creature.Memory.Data
--import Dodge.Creature.Memory.Data
import Dodge.Creature.Test
--import Dodge.Creature.AlertLevel.Data
--import Dodge.Picture.Layer
import Dodge.Item.Data
import Dodge.Clock
import Picture
import Geometry
--import Geometry.Vector3D
@@ -25,6 +26,7 @@ import Geometry
import Control.Lens
import Data.List
import qualified Data.IntMap.Strict as IM
import qualified Data.Vector as V
basicCrPict
:: Color -- ^ Creature color
-> Creature
@@ -56,26 +58,38 @@ creatureDisplayText w cr
. color white
. rotate a
. scale theScale theScale
$ text $ creatureDisplayString cr
. text
$ clockCycle 50 (V.fromList [crDisplayAwake, crDisplayAlert]) w cr
where
campos = _cameraViewFrom w
theScale = 0.2 / _cameraZoom w
theScale = 0.15 / _cameraZoom w
cpos = _crPos cr
v = cpos -.- campos
a = argV v - 0.5 * pi
(V2 x y) = campos +.+ v +.+ _crRad cr *.* normalizeV v
creatureDisplayString :: Creature -> String
creatureDisplayString cr = show . take 1 . _soundsToInvestigate $ _crMemory cr
-- | isAsleep = "Z"
-- | isSuspicious = "?"
-- | otherwise = ""
-- where
-- isAsleep = _crAwakeLevel (_crPerception cr) == Asleep
-- imAwarenesses = _crAwarenessLevel (_crPerception cr)
-- isSuspicious = any f imAwarenesses && not (null imAwarenesses)
-- f (Suspicious _) = True
-- f _ = False
crDisplayAlert :: Creature -> String
crDisplayAlert cr
| isSuspicious = "?"
| isCognizant = "!"
| otherwise = "."
where
imAwarenesses = _crAwarenessLevel (_crPerception cr)
isSuspicious = any f imAwarenesses && not (null imAwarenesses)
isCognizant = any g imAwarenesses && not (null imAwarenesses)
f (Suspicious _) = True
f _ = False
g (Cognizant _) = True
g _ = False
crDisplayAwake :: Creature -> String
crDisplayAwake cr = case _crAwakeLevel (_crPerception cr) of
Comatose -> "-"
Asleep -> "Z"
Lethargic -> "L"
Vigilant -> "V"
Overstrung -> "O"
damageMod :: Creature -> Picture -> Picture
damageMod cr pic = piercingMod $ bluntScale pic
where
src/Dodge/Creature/ReaderUpdate.hs
+36 -12
View File
@@ -10,6 +10,7 @@ module Dodge.Creature.ReaderUpdate
, goToTarget
, flockACCR
, setMvPos
, setViewPos
)
where
import Dodge.Data
@@ -19,6 +20,7 @@ import Dodge.Creature.Test
import Dodge.Creature.Volition
import Dodge.Creature.Perception.Data
import Dodge.Base
import Dodge.Base.Collide
import Geometry
import FoldableHelp
@@ -31,7 +33,7 @@ import Data.Maybe
overrideMeleeCloseTargetR
:: Creature
-> Reader World Creature
overrideMeleeCloseTargetR cr = return $ maybe cr (tryMeleeAttack cr) (_crTarget cr)
overrideMeleeCloseTargetR cr = return $ maybe cr (tryMeleeAttack cr) (_targetCr $ _crIntention cr)
tryMeleeAttack :: Creature -> Creature -> Creature
tryMeleeAttack cr tcr
@@ -45,11 +47,17 @@ tryMeleeAttack cr tcr
cpos = _crPos cr
setMvPos :: Creature -> Reader World Creature
setMvPos cr = pure $ cr & crMvTarget .~ mpos
setMvPos cr = pure $ cr & crIntention . mvToPoint .~ mpos
where
mpos = (_crPos <$> _crTarget cr)
<|> _crMvTarget cr
<|> listToMaybe (_soundsToInvestigate $ _crMemory cr)
int = _crIntention cr
mpos = (_crPos <$> _targetCr int)
<|> _mvToPoint int
-- <|> listToMaybe (_soundsToInvestigate $ _crMemory cr)
setViewPos :: Creature -> Reader World Creature
setViewPos cr = pure $ cr & crIntention . viewPoint %~ (<|> mpos)
where
mpos = listToMaybe (_soundsToInvestigate $ _crMemory cr)
setTargetMv
:: (Creature -> Reader World (Maybe Creature)) -- ^ Function for determining target
@@ -59,10 +67,10 @@ setTargetMv targFunc cr = do
targ <- targFunc cr
case targ of
Nothing -> pure cr
Just crTarg -> pure $ cr & crMvTarget .~ Just (_crPos crTarg)
Just crTarg -> pure $ cr & crIntention . mvToPoint ?~ _crPos crTarg
flockACCR :: Creature -> Reader World Creature
flockACCR cr = do
case cr ^? crTarget . _Just of
case cr ^? crIntention . targetCr . _Just of
Nothing -> pure cr
Just tcr -> do
w <- ask
@@ -81,13 +89,29 @@ flockACCR cr = do
horShift = if isLHS tpos cpos (_crPos acr)
then r *.* horDir
else negate r *.* horDir
pure $ cr & crMvTarget .~ Just (tpos +.+ horShift)
pure $ cr & crIntention . mvToPoint ?~ tpos +.+ horShift
goToTarget :: Creature -> Reader World Creature
goToTarget cr = do
case cr ^? crMvTarget . _Just of
case cr ^? crIntention . mvToPoint . _Just of
Just p -> pure $ cr & crActionPlan . crAction .~ [PathTo p]
_ -> pure cr
_ -> viewTarget cr
viewTarget :: Creature -> Reader World Creature
viewTarget cr = do
w <- ask
case cr ^? crIntention . viewPoint . _Just of
Just p | hasLOSIndirect p (_crPos cr) w -> pure $ cr'
& crActionPlan . crAction %~ replaceNullWith (TurnToA p)
& crIntention . viewPoint .~ Nothing
| otherwise -> pure $ cr' & crActionPlan . crAction %~ replaceNullWith (PathTo p)
Nothing -> pure $ cr & crPerception . crAwakeLevel .~ Lethargic
where
cr' = cr & crPerception . crAwakeLevel .~ Vigilant
replaceNullWith :: a -> [a] -> [a]
replaceNullWith x [] = [x]
replaceNullWith _ xs = xs
doStrategyActionsR
:: Creature
@@ -138,5 +162,5 @@ listGuard (_,z) _ = z
targetYouWhenCognizantR :: Creature -> Reader World Creature
targetYouWhenCognizantR cr = reader $ \w -> case cr ^? crPerception . crAwarenessLevel . ix 0 of
Just (Cognizant _) -> cr {_crTarget = Just $! _creatures w IM.! 0}
_ -> cr & crTarget .~ Nothing
Just (Cognizant _) -> cr & crIntention . targetCr ?~ _creatures w IM.! 0
_ -> cr & crIntention . targetCr .~ Nothing
src/Dodge/Creature/SentinelAI.hs
+1 -1
View File
@@ -40,7 +40,7 @@ sentinelAI = sentinelExtraWatchUpdate
>=> reloadOverrideR
where
advanceShoot = DoImpulses [UseItem, MoveForward 3]
tcid cr = _crID <$> _crTarget cr
tcid cr = _crID <$> _targetCr (_crIntention cr)
lostest (w,cr) = maybe False (\cid -> canSee (_crID cr) cid w) (tcid cr)
sentinelFireType
src/Dodge/Creature/SetTarget.hs
+2 -2
View File
@@ -14,6 +14,6 @@ targetYouWhenCognizant
-> Creature
-> Creature
targetYouWhenCognizant w cr = case cr ^? crPerception . crAwarenessLevel . ix 0 of
Just (Cognizant _) -> cr & crTarget ?~ _creatures w IM.! 0
_ -> cr & crTarget .~ Nothing
Just (Cognizant _) -> cr & crIntention . targetCr ?~ _creatures w IM.! 0
_ -> cr & crIntention . targetCr .~ Nothing
src/Dodge/Creature/Test.hs
+6 -6
View File
@@ -56,28 +56,28 @@ crIsAimingR :: Creature -> Reader World Bool
crIsAimingR cr = return $ _posture (_crStance cr) == Aiming
crHasTarget :: (World,Creature) -> Bool
crHasTarget (_,cr) = isJust $ cr ^? crTarget . _Just
crHasTarget (_,cr) = isJust $ cr ^? crIntention . targetCr . _Just
crHasTargetR :: Creature -> Reader World Bool
crHasTargetR cr = return $ isJust $ cr ^? crTarget . _Just
crHasTargetR cr = return $ isJust $ cr ^? crIntention . targetCr . _Just
crHasTargetLOS :: (World,Creature) -> Bool
crHasTargetLOS (w,cr) = case cr ^? crTarget . _Just of
crHasTargetLOS (w,cr) = case cr ^? crIntention . targetCr . _Just of
Just i -> crCanSeeCr i (w,cr)
Nothing -> False
crHasTargetLOSR :: Creature -> Reader World Bool
crHasTargetLOSR cr = reader $ \w -> case cr ^? crTarget . _Just of
crHasTargetLOSR cr = reader $ \w -> case cr ^? crIntention . targetCr . _Just of
Just i -> crCanSeeCr i (w,cr)
Nothing -> False
crSafeDistFromTarg :: Float -> (World,Creature) -> Bool
crSafeDistFromTarg d (_,cr) = case cr ^? crTarget . _Just of
crSafeDistFromTarg d (_,cr) = case cr ^? crIntention . targetCr . _Just of
Just tcr -> dist (_crPos cr) (_crPos tcr) > d
Nothing -> True
crSafeDistFromTargR :: Float -> Creature -> Reader World Bool
crSafeDistFromTargR d cr = return $ case cr ^? crTarget . _Just of
crSafeDistFromTargR d cr = return $ case cr ^? crIntention . targetCr . _Just of
Just tcr -> dist (_crPos cr) (_crPos tcr) > d
Nothing -> True