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

Add crab crit, rethink Action datatype slightly

Browse Source
This commit is contained in:
justin
2026-04-07 15:29:02 +01:00
parent 35d169b585
commit f0e568e694
25 changed files with 606 additions and 465 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/Action.hs
+40 -33
View File
@@ -45,9 +45,9 @@ performActions cid w =
iss
where
cr = w ^?! cWorld . lWorld . creatures . ix cid
(iss, mayas) = foldMap (performAction cr w) $ cr ^. crActionPlan . apAction
(iss, mayas) = fromMaybe ([],NoAction) $ performAction cr w <$> cr ^? crActionPlan . apAction
type ActionUpdate = ([Impulse], [Action])
type ActionUpdate = ([Impulse], Action)
{- | Performing an action on a frame creates an ActionUpdate:
gives impulses and updates/deletes the action itself.
@@ -55,54 +55,61 @@ type ActionUpdate = ([Impulse], [Action])
performAction :: Creature -> World -> Action -> ActionUpdate
performAction cr w ac = case ac of
AimAt tcid p -> performAimAt cr w tcid p
WaitThen 0 newAc -> ([], [newAc])
WaitThen t newAc -> ([], [WaitThen (t -1) newAc])
ImpulsesList (xs : xss) -> (xs, [ImpulsesList xss])
ImpulsesList _ -> ([], mempty)
DoImpulses imps -> (imps, mempty)
DoActionThen fsta afta -> case performAction cr w fsta of -- NOTE this only does ONE continuation action
(imps, nxta : _) -> (imps, [DoActionThen nxta afta])
(imps, []) -> (imps, [afta])
WaitThen 0 newAc -> ([], newAc)
WaitThen t newAc -> ([], WaitThen (t -1) newAc)
ImpulsesList (xs : xss) a -> performAction cr w a & _1 <>~ xs
& _2 %~ ImpulsesList xss
ImpulsesList _ a -> performAction cr w a
DoImpulses imps -> (imps, NoAction)
DoActionThen fsta afta -> case performAction cr w fsta of
(imps, NoAction) -> (imps, afta)
(imps, nxta) -> (imps, DoActionThen nxta afta)
DoActionWhile f act -> performAction cr w $ DoActionWhilePartial act f act
DoActionWhilePartial partAc f resetAc
| doWdCrBl f w cr -> case performAction cr w partAc of
(imps, nxta : _) -> (imps, [DoActionWhilePartial nxta f resetAc])
(imps, []) -> (imps, [DoActionWhilePartial resetAc f resetAc])
(imps, NoAction) -> (imps, DoActionWhilePartial resetAc f resetAc)
(imps, nxta ) -> (imps, DoActionWhilePartial nxta f resetAc)
| otherwise -> performAction cr w partAc
DoActionIf f ifa
| doWdCrBl f w cr -> performAction cr w ifa
| otherwise -> ([], mempty)
| otherwise -> ([], NoAction)
DoActionIfElse ifa f elsea
| doWdCrBl f w cr -> performAction cr w ifa
| otherwise -> performAction cr w elsea
DoActionWhileInterrupt repa f afta
| doWdCrBl f w cr -> (fst $ performAction cr w repa, [DoActionWhileInterrupt repa f afta])
| doWdCrBl f w cr -> (fst $ performAction cr w repa, DoActionWhileInterrupt repa f afta)
| otherwise -> performAction cr w afta
DoActions [] -> ([], mempty)
DoActions acs ->
let (imps, newAcs) = foldMap (performAction cr w) acs
in (imps, newAcs)
StartSentinelPost -> ([AddGoal $ SentinelAt (cr ^. crPos . _xy) (_crDir cr)], mempty)
-- DoActions [] -> ([], NoAction)
-- DoActions acs ->
-- let (imps, newAcs) = foldMap (performAction cr w) acs
-- in (imps, newAcs)
StartSentinelPost -> ([AddGoal $ SentinelAt (cr ^. crPos . _xy) (_crDir cr)], NoAction)
PathTo p a -> performPathTo a cr w p
EvadeAim _ _ 0 -> (mempty,NoAction)
EvadeAim p a i -> tryEvadeSideways cr w p a i
TurnToPoint p -> performTurnToA cr p
LeadTarget p -> fromMaybe ([], mempty) $ do
LeadTarget p -> fromMaybe ([], NoAction) $ do
i <- cr ^? crIntention . targetCr . _Just
tcr <- w ^? cWorld . lWorld . creatures . ix i
return ([TurnTo (tcr ^. crPos . _xy +.+ rotateV (_crDir tcr) p)], mempty)
return ([TurnTo (tcr ^. crPos . _xy +.+ rotateV (_crDir tcr) p)], NoAction)
UseSelf f -> performAction cr w $ doCrAc f cr
ArbitraryAction f -> performAction cr w (doCrWdAc f cr w)
DoImpulsesAlongside sideImp mainAc -> case performAction cr w mainAc of
(imp, [nxtac]) -> (sideImp ++ imp, [DoImpulsesAlongside sideImp nxtac])
(imp, _) -> (sideImp ++ imp, mempty)
DoImpulsesAlongside sideImp mainAc -> performAction cr w mainAc & _1 <>~ sideImp
DoReplicate t nxtac -> performAction cr w $ DoReplicatePartial nxtac t nxtac
DoReplicatePartial _ 0 pac -> performAction cr w pac
DoReplicatePartial startac t partac -> case performAction cr w partac of
(imps, [nextac]) -> (imps, [DoReplicatePartial startac t nextac])
(imps, _) -> (imps, [DoReplicatePartial startac (t -1) startac])
NoAction -> ([], mempty)
(imps, NoAction) -> (imps, DoReplicatePartial startac (t -1) startac)
(imps, nextac) -> (imps, DoReplicatePartial startac t nextac)
NoAction -> ([], NoAction)
tryEvadeSideways :: Creature -> World -> Point2 -> Float -> Int -> ActionUpdate
tryEvadeSideways _ _ p a i = jumpleft -- (mv,mempty)
where
jumpleft = (mv,EvadeAim p a (i-1))
mv = [Move (V2 0 3)]
performAimAt :: Creature -> World -> Int -> Point2 -> ActionUpdate
performAimAt cr w tcid p = ([TurnToward tpos aimSp], [AimAt tcid tpos])
performAimAt cr w tcid p = ([TurnToward tpos aimSp], AimAt tcid tpos)
where
cdir = _crDir cr
cpos = cr ^. crPos . _xy
@@ -121,20 +128,20 @@ crPathing cr = case cr ^. crStance . carriage of
performPathTo :: Action -> Creature -> World -> Point2 -> ActionUpdate
performPathTo a cr w p
| dist cpos p <= crRad (cr ^. crType) = mempty
| dist cpos p <= crRad (cr ^. crType) = (mempty,NoAction)
| fst (crPathing cr) cpos p w = gotowards p
| otherwise = case uncurry pointTowardsImpulse' (crPathing cr) cpos p w of
Just q -> gotowards q
_ -> ([], [a])
_ -> ([], a)
where
gotowards q = ( [MvTurnToward q, MvForward, RandomTurn jit] , [PathTo p a])
gotowards q = ( [MvTurnToward q, MvForward, RandomTurn jit] , PathTo p a)
cpos = cr ^. crPos . _xy
jit = _mvTurnJit $ crMvType cr
performTurnToA :: Creature -> Point2 -> ActionUpdate
performTurnToA cr p
| angleVV cdirv dirv < 0.1 = mempty
| otherwise = ([MvTurnToward p, RandomTurn jit], [TurnToPoint p])
| angleVV cdirv dirv < 0.1 = (mempty,NoAction)
| otherwise = ([MvTurnToward p, RandomTurn jit], TurnToPoint p)
where
cpos = cr ^. crPos . _xy
cdirv = unitVectorAtAngle (_crDir cr)