Add dependencies

2021-09-05 23:58:50 +01:00
parent 86311c5d41
commit 4d3c0ae38f
5 changed files with 295 additions and 0 deletions
@@ -0,0 +1,85 @@
+module Dodge.Creature.Impulse
+    ( impulsiveAIR
+    )
+    where
+import Dodge.Data
+import Dodge.Creature.Impulse.Movement
+import Dodge.Creature.Impulse.UseItem
+--import Dodge.Creature.Action.UseItem
+import Dodge.Creature.State.Data
+import Dodge.Creature.Stance.Data
+import Dodge.SoundLogic
+import Dodge.SoundLogic.Synonyms
+import Geometry
+
+import qualified Data.IntMap.Strict as IM
+import System.Random
+import Control.Lens
+import Control.Monad.Reader
+import Data.Monoid
+import Data.Bifunctor
+
+impulsiveAIR
+    :: (Creature -> Reader World Creature)
+    -> Creature
+    -> World
+    -> (Endo World , Maybe Creature)
+impulsiveAIR impf cr w = bimap Endo Just $ followImpulses w . ($ w) . runReader $ impf cr
+
+followImpulses 
+    :: World 
+    -> Creature 
+    -> (World -> World, Creature)
+followImpulses w cr
+    = foldr 
+        foldf
+        (id, cr) 
+        (_crImpulse $ _crActionPlan cr)
+  where
+    foldf imp (f,cr') = first ( . f) $ followImpulse cr' w imp
+
+followImpulse
+    :: Creature
+    -> World
+    -> Impulse
+    -> (World -> World , Creature)
+followImpulse cr w imp = case imp of
+    Move p  -> (id, crMvBy p cr)
+    MoveForward x  -> (id, crMvForward x cr)
+    Turn a  -> (id, creatureTurn a cr)
+    TurnToward p a -> (id, creatureTurnToward p a cr)
+    TurnTo p -> (id, creatureTurnTo p cr)
+    ChangePosture post -> (id, cr & crStance . posture .~ post)
+    UseItem -> (tryUseItem cr, cr)
+    SwitchToItem i -> (id, cr & crInvSel .~ i)
+    Melee cid ->
+        (hitCr cid
+        , crMvBy (10 *.* normalizeV (posFromID cid -.- cpos)) $ cr & crMeleeCooldown .~ 20) -- randomise cooldown?
+    RandomTurn a -> (id, creatureTurn (rr a) cr)
+    MakeSound sid -> ( soundOnceOrigin sid (CrSound (_crID cr)) (_crPos cr) , cr )
+    DropItem -> undefined
+    ChangeStrategy strat -> (id, cr & crActionPlan . crStrategy .~ strat)
+    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
+        Just tcr -> followImpulse cr w (f $ _crID tcr)
+        _ -> (id,cr)
+    ImpulseUseTarget f -> case cr ^? crTarget . _Just of
+        Just tcr -> followImpulse cr w (f tcr)
+        _ -> (id,cr)
+    ImpulseUseAheadPos f -> followImpulse cr w (f (_crPos cr +.+ 20 *.* unitVectorAtAngle (_crDir cr)))
+    MvForward -> (id, crMvForward speed cr)
+    MvTurnToward p -> (id, creatureTurnToward p (turnRad $ safeAngleVV (p -.- cpos) (unitVectorAtAngle cdir)) cr)
+--    _ -> (id , cr)
+  where
+    mvType = _crMvType cr
+    speed = _mvSpeed mvType
+    turnRad = _mvTurnRad mvType
+    cpos = _crPos cr
+    cdir = _crDir cr
+    posFromID cid = _crPos $ _creatures w IM.! cid
+    rr a = fst $ randomR (-a,a) $ _randGen w
+    hitCr i = over (creatures . ix i . crState . crDamage) (addDam i)
+        . soundOnce hitSound
+    addDam i dams = Blunt 100 cpos (posFromID i) (posFromID i) : dams