AI refactor

src/Dodge/Creature/Rationality.hs

@@ -1,33 +1,105 @@
 module Dodge.Creature.Rationality
     where
 import Dodge.Data
+import Dodge.Base.Collide
 import Dodge.Creature.Rationality.Data
 import Dodge.Creature.Action
 import Dodge.Creature.Action.UseItem
+import Dodge.Creature.State.Data
+import Dodge.SoundLogic
+import Geometry
 
+import Data.Maybe
+import qualified Data.IntMap.Strict as IM
 import System.Random
 import Control.Lens
 
 impulsiveAI 
-    :: (Impulse -> World -> Creature -> (World -> World, Creature))
-    -> World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature)
-impulsiveAI impulseFunc w (f,g) cr
-    = (\(f''' ,cr) -> ((f''',g),Just cr))
-    $ foldr 
-        (\imp (f' , cr') -> let (f'', cr'') = impulseFunc imp w cr' in (f'' . f', cr''))
-        (id, cr) 
-        (_crImpulse $ _crRationality cr)
+    :: (World -> Creature -> Creature) -- ^ Internal AI update, should determine impulses
+    -> World 
+    -> (World -> World,StdGen) 
+    -> Creature 
+    -> ((World -> World,StdGen), Maybe Creature)
+impulsiveAI impF w (f,g) = followImpulses w (f,g) . impF w
 
-applyBasicImpulse
+followImpulses 
+    :: World 
+    -> (World -> World,StdGen) 
+    -> Creature 
+    -> ((World -> World,StdGen), Maybe Creature)
+followImpulses w (f,g) cr
+    = (\(f''' ,cr) -> ((f''',g'),Just cr))
+    $ foldr 
+        (\imp (f' , cr') -> let (f'', cr'') = followImpulse imp w cr' in (f'' . f', cr''))
+        (f, cr) 
+        (_crImpulse $ _crRationality cr)
+  where
+    g' = snd $ next g
+
+followImpulse
     :: Impulse
     -> World
     -> Creature
     -> (World -> World , Creature)
-applyBasicImpulse imp w cr = case imp of
-    Move p  -> (id, creatureMove p cr)
+followImpulse imp w cr = 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)
     UseItem -> (crUseItem cr, cr)
     SwitchToItem i -> (id, cr & crInvSel .~ i)
-    _ -> (id, cr)
+    Melee crID -> 
+        (hitCr crID
+        , crMvBy (10 *.* normalizeV (posFromID crID -.- cpos)) $ cr & crMeleeCooldown ?~ 20) -- randomise cooldown?
+    RandomTurn a -> (id, creatureTurn (rr a) cr)
+    _ -> (id , cr)
     DropItem -> undefined
+  where
+    cpos = _crPos 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 (fromIntegral hitSound)
+    addDam i dams = (( Blunt 100 cpos (posFromID i) (posFromID i) ) : dams )
+
+actionUpdateAI
+    :: (World -> Creature -> Creature) -- ^ the function updating the actions
+    -> World
+    -> Creature
+    -> Creature
+actionUpdateAI actF w c = performActions w $ actF w c
+
+performActions :: World -> Creature -> Creature
+performActions w cr = cr
+    & crRationality . crImpulse .~ concat iss
+    & crRationality . crAction .~ catMaybes mayas
+  where
+    (iss, mayas) = unzip $ map (performAction cr w) $ cr ^. crRationality . crAction
+
+{- | Performing an action means that a creature has some impulses for a frame, and
+ updates or deletes the action itself. -}
+performAction 
+    :: Creature
+    -> World
+    -> Action
+    -> ( [Impulse] , Maybe Action )
+performAction cr w ac = case ac of
+    ShootTillEmpty -> case cr ^? crInv . ix (_crInvSel cr) . wpLoadedAmmo of
+        Just x | x > 0  -> ( [UseItem] , Just ShootTillEmpty )
+        _               -> ( []        , Nothing )
+    AimAtCloseSlow tcid p speed slowSpeed a
+        | canSee (_crID cr) tcid w && abs (normalizeAngle $ cdir - argV (tpos -.- cpos)) < a 
+            -> ([TurnToward tpos slowSpeed] , Just $ AimAtCloseSlow tcid tpos speed slowSpeed a)
+        | canSee (_crID cr) tcid w
+            -> ([TurnToward tpos speed] , Just $ AimAtCloseSlow tcid tpos speed slowSpeed a)
+        | abs (normalizeAngle (cdir - (argV (p -.- cpos)))) < a
+            -> ([TurnToward p slowSpeed] , Just $ AimAtCloseSlow tcid p speed slowSpeed a)
+        | otherwise -> ([TurnToward p speed] , Just $ AimAtCloseSlow tcid p speed slowSpeed a)
+      where
+        tpos = _crPos (_creatures w IM.! tcid)
+    ImpulsesList (xs:xss) -> (xs, Just $ ImpulsesList xss)
+    ImpulsesList _  -> ([], Nothing)
+  where
+    cpos = _crPos cr 
+    cdir = _crDir cr