Delete some reified action/impulse stuff

This commit is contained in:
2025-10-15 20:37:22 +01:00
parent 4d12d6cf2b
commit fe95bf381b
5 changed files with 5 additions and 58 deletions
-1
View File
@@ -130,7 +130,6 @@ performAction cr w ac = case ac of
tcr <- w ^? cWorld . lWorld . creatures . ix i tcr <- w ^? cWorld . lWorld . creatures . ix i
return $ ([TurnTo (tcr ^. crPos . _xy +.+ rotateV (_crDir tcr) p)], Nothing) return $ ([TurnTo (tcr ^. crPos . _xy +.+ rotateV (_crDir tcr) p)], Nothing)
UseSelf f -> performAction cr w $ doCrAc f cr UseSelf f -> performAction cr w $ doCrAc f cr
UseAheadPos f -> performAction cr w (doP2Ac f (cr ^. crPos . _xy +.+ 20 *.* unitVectorAtAngle (_crDir cr)))
UseMvTargetPos f -> performAction cr w $ doMP2Ac f $ _mvToPoint $ _crIntention cr UseMvTargetPos f -> performAction cr w $ doMP2Ac f $ _mvToPoint $ _crIntention cr
ArbitraryAction f -> performAction cr w (doCrWdAc f cr w) ArbitraryAction f -> performAction cr w (doCrWdAc f cr w)
DoImpulsesAlongside sideImp mainAc -> case performAction cr w mainAc of DoImpulsesAlongside sideImp mainAc -> case performAction cr w mainAc of
-7
View File
@@ -62,18 +62,11 @@ followImpulse cr w imp = case imp of
DropItem -> undefined DropItem -> undefined
ChangeStrategy strat -> crup $ cr & crActionPlan . apStrategy .~ strat ChangeStrategy strat -> crup $ cr & crActionPlan . apStrategy .~ strat
AddGoal gl -> crup $ cr & crActionPlan . apGoal .:~ gl AddGoal gl -> crup $ cr & crActionPlan . apGoal .:~ gl
ArbitraryImpulseFunction f -> crup $ doWdCrCr f w cr
ArbitraryImpulse f -> followImpulse cr w (doCrWdImp f cr w)
ArbitraryImpulseEffect f -> (doCrWdWd f cr, cr) ArbitraryImpulseEffect f -> (doCrWdWd f cr, cr)
-- ImpulseUseTargetCID f -> fromMaybe (crup cr) $ do
-- i <- cr ^? crIntention . targetCr . _Just
-- tcr <- w ^? cWorld . lWorld . creatures . ix i
-- return $ followImpulse cr w (doIntImp f $ _crID tcr)
ImpulseUseTarget f -> fromMaybe (crup cr) $ do ImpulseUseTarget f -> fromMaybe (crup cr) $ do
i <- cr ^? crIntention . targetCr . _Just i <- cr ^? crIntention . targetCr . _Just
tcr <- w ^? cWorld . lWorld . creatures . ix i tcr <- w ^? cWorld . lWorld . creatures . ix i
return $ followImpulse cr w (doCrImp f tcr) return $ followImpulse cr w (doCrImp f tcr)
ImpulseUseAheadPos f -> followImpulse cr w (doP2Imp f (cr ^. crPos . _xy +.+ 20 *.* unitVectorAtAngle (_crDir cr)))
MvForward -> crup $ crMvForward speed (w ^. cWorld . lWorld) cr MvForward -> crup $ crMvForward speed (w ^. cWorld . lWorld) cr
MvTurnToward p -> MvTurnToward p ->
crup $ crup $
-16
View File
@@ -10,14 +10,6 @@ import Dodge.Path
import Geometry import Geometry
import Control.Lens import Control.Lens
doWdCrCr :: WdCrCr -> World -> Creature -> Creature
doWdCrCr ce = case ce of
NoCreatureEffect -> const id
doCrWdImp :: CrWdImp -> Creature -> World -> Impulse
doCrWdImp cwi = case cwi of
NoCrWdImp -> const $ const ImpulseNothing
doCrWdWd :: CrWdWd -> Creature -> World -> World doCrWdWd :: CrWdWd -> Creature -> World -> World
doCrWdWd cww = case cww of doCrWdWd cww = case cww of
CrWdWdId -> const id CrWdWdId -> const id
@@ -31,10 +23,6 @@ doCrImp ci = case ci of
NoCrImp -> const ImpulseNothing NoCrImp -> const ImpulseNothing
TurnTowardCr x -> \cr -> TurnToward (cr ^. crPos . _xy) x TurnTowardCr x -> \cr -> TurnToward (cr ^. crPos . _xy) x
doP2Imp :: P2Imp -> Point2 -> Impulse
doP2Imp p2i = case p2i of
P2ImpNo -> const ImpulseNothing
doWdCrBl :: WdCrBl -> World -> Creature -> Bool doWdCrBl :: WdCrBl -> World -> Creature -> Bool
doWdCrBl wcb = case wcb of doWdCrBl wcb = case wcb of
WdCrTrue -> const $ const True WdCrTrue -> const $ const True
@@ -64,10 +52,6 @@ doCrAc ca = case ca of
--fleeFromTarget :: Creature -> Action --fleeFromTarget :: Creature -> Action
--fleeFromTarget cr = fleeFrom cr (_targetCr (_crIntention cr)) --fleeFromTarget cr = fleeFrom cr (_targetCr (_crIntention cr))
doP2Ac :: P2Ac -> Point2 -> Action
doP2Ac p2a = case p2a of
P2NoAction -> const ActionNothing
doMP2Ac :: MP2Ac -> Maybe Point2 -> Action doMP2Ac :: MP2Ac -> Maybe Point2 -> Action
doMP2Ac mp2a = case mp2a of doMP2Ac mp2a = case mp2a of
MP2NoAction -> const ActionNothing MP2NoAction -> const ActionNothing
+1 -15
View File
@@ -43,20 +43,9 @@ data Impulse
| MakeSound SoundID | MakeSound SoundID
| ChangeStrategy Strategy | ChangeStrategy Strategy
| AddGoal Goal | AddGoal Goal
| ArbitraryImpulseFunction WdCrCr
| ArbitraryImpulse CrWdImp
| ArbitraryImpulseEffect CrWdWd | ArbitraryImpulseEffect CrWdWd
-- | ImpulseUseTargetCID | ImpulseUseTarget { _impulseUseTarget :: CrImp }
-- { _impulseUseTargetCID :: IntImp
-- }
| ImpulseUseTarget
{ _impulseUseTarget :: CrImp
}
| ImpulseUseAheadPos
{ _impulseUseAheadPos :: P2Imp
}
| ImpulseNothing | ImpulseNothing
--deriving (Eq, Ord, Show, Read) --Generic, Flat)
deriving (Eq, Ord, Show) --Generic, Flat) deriving (Eq, Ord, Show) --Generic, Flat)
data RandImpulse data RandImpulse
@@ -152,9 +141,6 @@ data Action
| UseSelf | UseSelf
{ _useSelf :: CrAc { _useSelf :: CrAc
} }
| UseAheadPos
{ _useAheadPos :: P2Ac
}
| UseMvTargetPos | UseMvTargetPos
{ _useMvTargetPos :: MP2Ac { _useMvTargetPos :: MP2Ac
} }
+4 -19
View File
@@ -8,25 +8,16 @@ module Dodge.Data.CreatureEffect where
import Data.Aeson import Data.Aeson
import Data.Aeson.TH import Data.Aeson.TH
data WdCrCr = NoCreatureEffect
deriving (Eq, Ord, Show, Read) --Generic, Flat)
data CrWdImp = NoCrWdImp
deriving (Eq, Ord, Show, Read) --Generic, Flat)
data CrWdWd = CrWdWdId data CrWdWd = CrWdWdId
deriving (Eq, Ord, Show, Read) --Generic, Flat) deriving (Eq, Ord, Show, Read) --Generic, Flat)
--data IntImp = NoIntImp
-- deriving (Eq, Ord, Show, Read) --Generic, Flat)
data CrImp data CrImp
= NoCrImp = NoCrImp
| TurnTowardCr Float -- turn amount | TurnTowardCr Float -- turn amount
deriving (Eq, Ord, Show, Read) --Generic, Flat) deriving (Eq, Ord, Show, Read) --Generic, Flat)
data P2Imp = P2ImpNo --data P2Imp = P2ImpNo
deriving (Eq, Ord, Show, Read) --Generic, Flat) -- deriving (Eq, Ord, Show, Read) --Generic, Flat)
data WdCrBl data WdCrBl
= WdCrTrue = WdCrTrue
@@ -45,9 +36,6 @@ data CrBl
data CrAc = CrTurnAround data CrAc = CrTurnAround
deriving (Eq, Ord, Show, Read) --Generic, Flat) deriving (Eq, Ord, Show, Read) --Generic, Flat)
data P2Ac = P2NoAction
deriving (Eq, Ord, Show, Read) --Generic, Flat)
data MP2Ac = MP2NoAction data MP2Ac = MP2NoAction
deriving (Eq, Ord, Show, Read) --Generic, Flat) deriving (Eq, Ord, Show, Read) --Generic, Flat)
@@ -57,15 +45,12 @@ data CrWdAc
| ChooseMovementLtAuto | ChooseMovementLtAuto
deriving (Eq, Ord, Show, Read) --Generic, Flat) deriving (Eq, Ord, Show, Read) --Generic, Flat)
deriveJSON defaultOptions ''WdCrCr --deriveJSON defaultOptions ''WdCrCr
deriveJSON defaultOptions ''CrWdImp --deriveJSON defaultOptions ''CrWdImp
deriveJSON defaultOptions ''CrWdWd deriveJSON defaultOptions ''CrWdWd
--deriveJSON defaultOptions ''IntImp
deriveJSON defaultOptions ''CrImp deriveJSON defaultOptions ''CrImp
deriveJSON defaultOptions ''P2Imp
deriveJSON defaultOptions ''CrBl deriveJSON defaultOptions ''CrBl
deriveJSON defaultOptions ''WdCrBl deriveJSON defaultOptions ''WdCrBl
deriveJSON defaultOptions ''CrAc deriveJSON defaultOptions ''CrAc
deriveJSON defaultOptions ''P2Ac
deriveJSON defaultOptions ''MP2Ac deriveJSON defaultOptions ''MP2Ac
deriveJSON defaultOptions ''CrWdAc deriveJSON defaultOptions ''CrWdAc