module Dodge.Creature.Impulse ( impulsiveAIR ) where import Dodge.Data import Dodge.Data.SoundOrigin import Dodge.Creature.Impulse.Movement import Dodge.Creature.Impulse.UseItem import Dodge.Data.DamageType --import Dodge.Creature.Action.UseItem import Dodge.Creature.State.Data import Dodge.Creature.Stance.Data import Dodge.SoundLogic import Dodge.SoundLogic.LoadSound 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 -> ( soundStart (CrSound (_crID cr)) (_crPos cr) sid Nothing , 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 ^? crIntention . targetCr . _Just of Just tcr -> followImpulse cr w (f $ _crID tcr) _ -> (id,cr) ImpulseUseTarget f -> case cr ^? crIntention . targetCr . _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 cid = _crID 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) . soundStart (CrSound cid) cpos hitS Nothing addDam i dams = Blunt 100 cpos (posFromID i) (posFromID i) : dams