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

Cleanup impulses/actions

Browse Source
This commit is contained in:
justin
2025-10-18 16:00:08 +01:00
parent 4ee389efb1
commit 11c7b25fe9
4 changed files with 95 additions and 83 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/Boid.hs
+67 -59
View File
@@ -4,7 +4,7 @@ import Data.Maybe
import Linear import Linear
import Dodge.Creature.Radius import Dodge.Creature.Radius
import Control.Lens import Control.Lens
import Control.Monad.Reader --import Control.Monad.Reader
import Dodge.Base import Dodge.Base
import Dodge.Data.World import Dodge.Data.World
import Geometry import Geometry
@@ -208,13 +208,21 @@ flockPointTarget ::
World -> World ->
Creature -> Creature ->
Creature Creature
flockPointTarget f targFunc w cr = case targFunc cr w of flockPointTarget _ _ _ = id
Nothing -> cr --flockPointTarget ::
Just crTarg -> cr -- & crActionPlan . apImpulse .~ mvPointMeleeTarg p cr crTarg -- (Creature -> IM.IntMap Creature -> Creature -> Point2) ->
where -- -- | Function for determining target
is = _swarm $ _crGroup cr -- (Creature -> World -> Maybe Creature) ->
crs = IM.restrictKeys (w ^. cWorld . lWorld . creatures) is -- World ->
p = f crTarg crs cr -- Creature ->
-- Creature
--flockPointTarget f targFunc w cr = case targFunc cr w of
-- Nothing -> cr
-- Just crTarg -> cr & crActionPlan . apImpulse .~ mvPointMeleeTarg p cr crTarg
-- where
-- is = _swarm $ _crGroup cr
-- crs = IM.restrictKeys (w ^. cWorld . lWorld . creatures) is
-- p = f crTarg crs cr
--flockToPointUsing :: --flockToPointUsing ::
-- (Creature -> Point2 -> Creature -> Point2) -> -- (Creature -> Point2 -> Creature -> Point2) ->
@@ -229,60 +237,60 @@ flockPointTarget f targFunc w cr = case targFunc cr w of
-- -- crGroupCenter $ _creatureGroups (_cWorld w) IM.! _crGroupID (_crGroup cr) -- -- crGroupCenter $ _creatureGroups (_cWorld w) IM.! _crGroupID (_crGroup cr)
-- ptarg = pf tcr cenp cr -- ptarg = pf tcr cenp cr
flockToPointUsing' :: --flockToPointUsing' ::
(Creature -> Point2 -> Creature -> Point2) -> -- (Creature -> Point2 -> Creature -> Point2) ->
(Point2 -> Creature -> Creature -> [Impulse]) -> -- (Point2 -> Creature -> Creature -> [Impulse]) ->
World -> -- World ->
Creature -> -- Creature ->
Creature -- Creature
flockToPointUsing' pf mvf w cr = fromMaybe cr $ do --flockToPointUsing' pf mvf w cr = fromMaybe cr $ do
i <- _targetCr $ _crIntention cr -- i <- _targetCr $ _crIntention cr
tcr <- w ^? cWorld . lWorld . creatures . ix i -- tcr <- w ^? cWorld . lWorld . creatures . ix i
let ptarg = pf tcr cenp cr -- let ptarg = pf tcr cenp cr
return $ cr -- & crActionPlan . apImpulse .~ mvf ptarg cr tcr -- return $ cr -- & crActionPlan . apImpulse .~ mvf ptarg cr tcr
where -- where
cenp = w ^?! cWorld . lWorld . creatureGroups . ix (cr ^?! crGroup . crGroupID) . crGroupCenter -- cenp = w ^?! cWorld . lWorld . creatureGroups . ix (cr ^?! crGroup . crGroupID) . crGroupCenter
flockFunc :: --flockFunc ::
(Creature -> Point2 -> Creature -> Point2) -> -- (Creature -> Point2 -> Creature -> Point2) ->
-- | Function for determining target -- -- | Function for determining target
(Creature -> World -> Maybe Creature) -> -- (Creature -> World -> Maybe Creature) ->
Creature -> -- Creature ->
Reader World Creature -- Reader World Creature
flockFunc f targFunc cr = reader $ \w -> case targFunc cr w of --flockFunc f targFunc cr = reader $ \w -> case targFunc cr w of
Nothing -> cr -- Nothing -> cr
Just crTarg -> cr -- & crActionPlan . apImpulse .~ mvPointMeleeTarg p cr crTarg -- Just crTarg -> cr -- & crActionPlan . apImpulse .~ mvPointMeleeTarg p cr crTarg
where -- where
cenp = w ^?! cWorld . lWorld . creatureGroups . ix (cr ^?! crGroup . crGroupID) . crGroupCenter -- cenp = w ^?! cWorld . lWorld . creatureGroups . ix (cr ^?! crGroup . crGroupID) . crGroupCenter
p = f crTarg cenp cr -- p = f crTarg cenp cr
flockCenterFunc :: --flockCenterFunc ::
(Creature -> Point2 -> Creature -> Point2) -> -- (Creature -> Point2 -> Creature -> Point2) ->
-- | Function for determining target -- -- | Function for determining target
(Creature -> World -> Maybe Creature) -> -- (Creature -> World -> Maybe Creature) ->
Creature -> -- Creature ->
Reader World Creature -- Reader World Creature
flockCenterFunc f targFunc cr = reader $ \w -> case targFunc cr w of --flockCenterFunc f targFunc cr = reader $ \w -> case targFunc cr w of
Nothing -> cr -- Nothing -> cr
Just crTarg -> cr -- & crActionPlan . apImpulse .~ mvPointMeleeTarg p cr crTarg -- Just crTarg -> cr -- & crActionPlan . apImpulse .~ mvPointMeleeTarg p cr crTarg
where -- where
cenp = w ^?! cWorld . lWorld . creatureGroups . ix (cr ^?! crGroup . crGroupID) . crGroupCenter -- cenp = w ^?! cWorld . lWorld . creatureGroups . ix (cr ^?! crGroup . crGroupID) . crGroupCenter
p = f crTarg cenp cr -- p = f crTarg cenp cr
flockPointTargetR :: --flockPointTargetR ::
(Creature -> IM.IntMap Creature -> Creature -> Point2) -> -- (Creature -> IM.IntMap Creature -> Creature -> Point2) ->
-- | Function for determining target -- -- | Function for determining target
(Creature -> World -> Maybe Creature) -> -- (Creature -> World -> Maybe Creature) ->
Creature -> -- Creature ->
Reader World Creature -- Reader World Creature
flockPointTargetR f targFunc cr = reader $ \w -> case targFunc cr w of --flockPointTargetR f targFunc cr = reader $ \w -> case targFunc cr w of
Nothing -> cr -- Nothing -> cr
Just crTarg -> cr -- & crActionPlan . apImpulse .~ mvPointMeleeTarg p cr crTarg -- Just crTarg -> cr -- & crActionPlan . apImpulse .~ mvPointMeleeTarg p cr crTarg
where -- where
is = _swarm $ _crGroup cr -- is = _swarm $ _crGroup cr
--crs = IM.restrictKeys (_creatures (_cWorld w)) is -- --crs = IM.restrictKeys (_creatures (_cWorld w)) is
crs = IM.restrictKeys (w ^. cWorld . lWorld . creatures) is -- crs = IM.restrictKeys (w ^. cWorld . lWorld . creatures) is
p = f crTarg crs cr -- p = f crTarg crs cr
meleeHeadingMove :: meleeHeadingMove ::
-- | max turn speed -- | max turn speed
src/Dodge/Creature/Impulse.hs
+22 -18
View File
@@ -2,14 +2,12 @@
module Dodge.Creature.Impulse (followImpulses) where module Dodge.Creature.Impulse (followImpulses) where
import Dodge.Creature.Action
import Data.Maybe
import NewInt
import Linear
import Dodge.Creature.MoveType
import Data.Foldable
import Control.Monad.State import Control.Monad.State
import Data.Foldable
import Data.Maybe
import Dodge.Creature.Action
import Dodge.Creature.Impulse.Movement import Dodge.Creature.Impulse.Movement
import Dodge.Creature.MoveType
--import Dodge.Creature.Impulse.UseItem --import Dodge.Creature.Impulse.UseItem
import Dodge.Creature.Vocalization import Dodge.Creature.Vocalization
import Dodge.CreatureEffect import Dodge.CreatureEffect
@@ -19,12 +17,14 @@ import Dodge.RandImpulse
import Dodge.SoundLogic import Dodge.SoundLogic
import Geometry import Geometry
import LensHelp import LensHelp
import Linear
import NewInt
import System.Random import System.Random
followImpulses :: Int -> World -> World followImpulses :: Int -> World -> World
followImpulses cid w = let (is,cr) = performActions w (w ^?! cWorld . lWorld . creatures . ix cid) followImpulses cid w =
in foldl' (followImpulse cid) (w & cWorld . lWorld . creatures . ix cid .~ cr) let (is, cr) = performActions w (w ^?! cWorld . lWorld . creatures . ix cid)
(reverse is) in foldl' (followImpulse cid) (w & cWorld . lWorld . creatures . ix cid .~ cr) is
-- note SwitchToItem doesn't necessarily update the root item correctly -- note SwitchToItem doesn't necessarily update the root item correctly
followImpulse :: Int -> World -> Impulse -> World followImpulse :: Int -> World -> Impulse -> World
@@ -33,22 +33,26 @@ followImpulse cid w imp = case imp of
RandomImpulse rimp -> RandomImpulse rimp ->
let (newimp, newgen) = runState (doRandImpulse rimp) (_randGen w) let (newimp, newgen) = runState (doRandImpulse rimp) (_randGen w)
in randGen .~ newgen $ followImpulse cid w newimp in randGen .~ newgen $ followImpulse cid w newimp
Bark sid -> soundStart (CrMouth cid) cpos sid Nothing Bark sid ->
$ w & clens %~ resetCrVocCoolDown w soundStart (CrMouth cid) cpos sid Nothing $
w & clens %~ resetCrVocCoolDown w
Move p -> crup $ crMvBy p (w ^. cWorld . lWorld) Move p -> crup $ crMvBy p (w ^. cWorld . lWorld)
MoveForward x -> crup $ crMvForward x (w ^. cWorld . lWorld) MoveForward x -> crup $ crMvForward x (w ^. cWorld . lWorld)
MoveNoStride p -> crup $ crMvByNoStride p (w ^. cWorld . lWorld) MoveNoStride p -> crup $ crMvByNoStride p (w ^. cWorld . lWorld)
Turn a -> crup $ crDir +~ a Turn a -> crup $ crDir +~ a
TurnToward p a -> crup $ creatureTurnToward p a TurnToward p a -> crup $ creatureTurnToward p a
TurnTo p -> crup $ creatureTurnTo p TurnTo p -> crup $ creatureTurnTo p
ChangePosture post -> crup $ crStance . posture .~ post ChangePosture post -> crup $ crStance . posture .~ post
UseItem -> undefined UseItem -> undefined
SwitchToItem i -> crup $ crManipulation . manObject .~ SelectedItem (NInt i) (NInt i) mempty SwitchToItem i -> crup $ crManipulation . manObject .~ SelectedItem (NInt i) (NInt i) mempty
Melee cid' -> Melee cid' ->
hitCr cid' $ crup ( hitCr cid' $
(crMvAbsolute (w ^. cWorld . lWorld) (10 *.* normalizeV (posFromID cid' -.- cpos))) . (crType . meleeCooldown .~ 20)) crup
RandomTurn a -> let (aa,g) = rr a ( (crMvAbsolute (w ^. cWorld . lWorld) (10 *.* normalizeV (posFromID cid' -.- cpos))) . (crType . meleeCooldown .~ 20)
in (randGen .~ g) (crup (crDir +~ aa)) )
RandomTurn a ->
let (aa, g) = rr a
in (randGen .~ g) (crup (crDir +~ aa))
MakeSound sid -> soundStart (CrSound (_crID cr)) (cr ^. crPos . _xy) sid Nothing w MakeSound sid -> soundStart (CrSound (_crID cr)) (cr ^. crPos . _xy) sid Nothing w
DropItem -> undefined DropItem -> undefined
ChangeStrategy strat -> crup $ crActionPlan . apStrategy .~ strat ChangeStrategy strat -> crup $ crActionPlan . apStrategy .~ strat
@@ -73,5 +77,5 @@ followImpulse cid w imp = case imp of
posFromID cid' = w ^?! cWorld . lWorld . creatures . ix cid' . crPos . _xy posFromID cid' = w ^?! cWorld . lWorld . creatures . ix cid' . crPos . _xy
rr a = randomR (- a, a) $ _randGen w rr a = randomR (- a, a) $ _randGen w
hitCr i = hitCr i =
cWorld . lWorld . creatures . ix i . crDamage cWorld . lWorld . creatures . ix i . crDamage
.:~ Blunt 100 (posFromID i) (posFromID i-cpos) .:~ Blunt 100 (posFromID i) (posFromID i - cpos)
src/Dodge/Creature/SentinelAI.hs
+1 -1
View File
@@ -6,7 +6,7 @@ module Dodge.Creature.SentinelAI (
import Control.Lens import Control.Lens
import Data.Maybe import Data.Maybe
import Dodge.Creature.Action --import Dodge.Creature.Action
import Dodge.Creature.ChainUpdates import Dodge.Creature.ChainUpdates
import Dodge.Creature.Perception import Dodge.Creature.Perception
import Dodge.Creature.ReaderUpdate import Dodge.Creature.ReaderUpdate
src/Dodge/Room/Tutorial.hs
+5 -5
View File
@@ -1,6 +1,6 @@
module Dodge.Room.Tutorial where module Dodge.Room.Tutorial where
--import Dodge.Room.LongDoor import Dodge.Room.LongDoor
import Dodge.Layout import Dodge.Layout
import Dodge.Item.Held.Utility import Dodge.Item.Held.Utility
import Control.Monad import Control.Monad
@@ -43,10 +43,10 @@ tutAnoTree = do
foldMTRS foldMTRS
[ tToBTree "TutStartRez" . return . cleatOnward <$> tutRezBox [ tToBTree "TutStartRez" . return . cleatOnward <$> tutRezBox
, corDoor , corDoor
-- , corDoor , corDoor
-- , tToBTree "t" . return . cleatOnward <$> slowDoorRoom , tToBTree "t" . return . cleatOnward <$> slowDoorRoom
-- , corDoor , corDoor
-- , corDoor , corDoor
, tutHub , tutHub
, tutLight , tutLight
, tutDrop , tutDrop