Cleanup impulses/actions
This commit is contained in:
+67
-59
@@ -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
|
||||||
|
|||||||
@@ -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,8 +33,9 @@ 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)
|
||||||
@@ -45,9 +46,12 @@ followImpulse cid w imp = case imp of
|
|||||||
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)
|
||||||
|
)
|
||||||
|
RandomTurn a ->
|
||||||
|
let (aa, g) = rr a
|
||||||
in (randGen .~ g) (crup (crDir +~ aa))
|
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
|
||||||
@@ -74,4 +78,4 @@ followImpulse cid w imp = case imp of
|
|||||||
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)
|
||||||
|
|||||||
@@ -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
|
||||||
|
|||||||
@@ -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
|
||||||
|
|||||||
Reference in New Issue
Block a user