Continue ai refactor

src/Dodge/AIs.hs

@@ -796,7 +796,7 @@ launcherAI inRange outRange w (f,g) cr =
         (TurnTo p:_) -> ( (f,g') , replaceImpulse [] . crTurnTo p $ cr)
         (TurnByFor a 0:_) -> ( (f,g') , replaceImpulse [] . over crDir (+a) $ cr)
         (TurnByFor a i:_) -> ( (f,g') , replaceImpulse [TurnByFor a (i-1)] . over crDir (+a) $ cr)
-        (SetPosture pture:_) -> ((f,g), replaceImpulse [] $ set (crState . stance . posture) pture cr)
+        (SetPosture pture:_) -> ((f,g), replaceImpulse [] $ set (crStance . posture) pture cr)
         (MoveByFor p 0:_) -> ((f,g'), replaceImpulse [] . crMvBy p $ cr)
         (MoveByFor p i:_) -> ((f,g'), replaceImpulse [MoveByFor p (i-1)] . crMvBy p $ cr)
         (Fire:_) | pointHitsWalls cpos (cpos +.+ 40 *.* unitVectorAtAngle (_crDir cr)) 

src/Dodge/Creature.hs

@@ -17,6 +17,7 @@ import Dodge.Creature.YourControl
 import Dodge.Creature.Inanimate
 import Dodge.Creature.State
 import Dodge.Creature.Picture
+import Dodge.Creature.Rationality
 import Dodge.Item
 import Dodge.Picture.Layer
 import Dodge.Creature.Picture
@@ -65,6 +66,17 @@ smallChaseCrit = defaultCreature
     }
 chaseCrit :: Creature
 chaseCrit = defaultCreature
+    { _crUpdate = stateUpdate $ impulsiveAI $ applyBasicImpulse
+    , _crHP = 300
+    , _crPict = basicCrPict green
+    , _crState = defaultState 
+        {_goals = [[Wait]]
+        ,_faction = ChaseCritters
+        }
+    , _crInv = IM.empty 
+    }
+chaseCrit' :: Creature
+chaseCrit' = defaultCreature
     { _crUpdate = stateUpdate chaseAI
     , _crHP = 300
     , _crPict = basicCrPict green

src/Dodge/Creature/Action.hs

@@ -76,7 +76,7 @@ crMvBy p' cr = stepForward (magV p) $ over crPos (+.+ p) cr
   where 
     p =  (*.*) (equipFactor * aimingFactor) $ rotateV (_crDir cr) p'
     equipFactor = product $ map equipSpeed $ IM.elems $ _crInv cr
-    aimingFactor | (_posture $ _stance $ _crState cr) == Aiming
+    aimingFactor | (_posture $ _crStance cr) == Aiming
                       = fromMaybe 1 $ it ^? itAimingSpeed
                  | otherwise = 1
     it = _crInv cr IM.! _crInvSel cr
@@ -85,7 +85,7 @@ stepForward
     :: Float    -- ^ Speed
     -> Creature 
     -> Creature
-stepForward speed cr = over (crState . stance . carriage) f cr
+stepForward speed cr = over (crStance . carriage) f cr
   where 
     f (w@Walking {}) = w {_stepToAdd = ceiling speed}
     f s = s

src/Dodge/Creature/ChooseTarget.hs

@@ -0,0 +1,9 @@
+module Dodge.Creature.ChooseTarget
+    where
+import Dodge.Data
+import Dodge.Base
+
+targetYouLOS :: Creature -> World -> Maybe Creature
+targetYouLOS cr w 
+    | hasLOS (_crPos cr) (_crPos $ you w) w = Just $ you w
+    | otherwise = Nothing

src/Dodge/Creature/ImpulseRat.hs

@@ -0,0 +1,26 @@
+module Dodge.Creature.ImpulseRat
+    where
+import Dodge.Data
+import Dodge.Creature.ChooseTarget
+import Dodge.Creature.Rationality.Data
+import Geometry
+
+chaseImpulse'
+    :: (Creature -> World -> Maybe Creature)    -- ^ Function for determining target
+    -> Creature 
+    -> World 
+    -> [Impulse]
+chaseImpulse' targFunc cr w = case targFunc cr w of
+    Nothing -> []
+    Just crTarg -> chaseTarg cr crTarg
+
+chaseTarg :: Creature -> Creature -> [Impulse]
+chaseTarg cr crT
+    | dist tpos cpos < combinedRad + 5 
+            && abs ((_crDir cr) - argV (tpos -.- cpos)) < pi/4
+        = [Melee (_crID crT)]
+    | otherwise = [MoveForward 3 , TurnToward 0.05 tpos]
+  where
+    cpos = _crPos cr
+    tpos = _crPos crT
+    combinedRad = _crRad cr + _crRad crT

src/Dodge/Creature/Rationality.hs

@@ -5,10 +5,18 @@ import Dodge.Creature.Rationality.Data
 import Dodge.Creature.Action
 import Dodge.Creature.Action.UseItem
 
+import System.Random
+import Control.Lens
+
 impulsiveAI 
     :: (Impulse -> World -> Creature -> (World -> World, Creature))
     -> World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature)
-impulsiveAI = undefined
+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)
 
 applyBasicImpulse
     :: Impulse
@@ -16,11 +24,10 @@ applyBasicImpulse
     -> Creature
     -> (World -> World , Creature)
 applyBasicImpulse imp w cr = case imp of
-    Move p  = (id, creatureMove p cr)
+    Move p  -> (id, creatureMove p cr)
-    Turn a  = (id, creatureTurn a cr)
+    Turn a  -> (id, creatureTurn a cr)
-    UseItem = (crUseItem cr, cr)
+    UseItem -> (crUseItem cr, cr)
-    SwitchToItem i = (id, cr & crInvSel .~ i)
+    SwitchToItem i -> (id, cr & crInvSel .~ i)
-    Wait t = (id, cr & crRationality . crImpulse . waitTime -~ 1
+    _ -> (id, cr)
-    _ = (id, cr)
+    DropItem -> undefined
-    DropItem = undefined
     

src/Dodge/Creature/Rationality/Data.hs

@@ -9,20 +9,21 @@ import Control.Lens
 data Rationality
     = NonRat
     | ImpulseRat
-        {_crImpulse :: Impulse }
+        {_crImpulse :: [Impulse] }
     | ActionRat
-        {_crImpulse :: Impulse
+        {_crImpulse :: [Impulse]
         ,_crAction  :: Action
         }
     | StrategyRat
-        {_crImpulse     :: Impulse
+        {_crImpulse     :: [Impulse]
         ,_crAction      :: Action
         ,_crStrategy    :: Strategy
         }
-
 data Impulse
     = Move Point2
+    | MoveForward Float
     | Turn Float
+    | TurnToward Float Point2
     | UseItem
     | SwitchToItem Int
     | DropItem
@@ -30,8 +31,8 @@ data Impulse
     | UseWorldObject Int
     | Bark -- placeholder for various communication types
     | UseIntrinsicAbility
+    | Melee Int
     | ChangePosture Posture
-    | Wait {_waitTime :: Int}
 
 data Action
     = Attack Int

src/Dodge/Creature/State.hs

@@ -99,7 +99,7 @@ sumDamage cr dm x = x + _dmAmount dm
 movementSideEff :: Creature -> World -> World
 movementSideEff cr w
     | hasJetPack 
-        = case cr ^? crState . stance . carriage of
+        = case cr ^? crStance . carriage of
             Just (Boosting v) 
                 -> makeFlameletTimed 
                             (oldPos +.+ (_crRad cr + 3) *.* (unitVectorAtAngle $ _crDir cr + pi))
@@ -110,7 +110,7 @@ movementSideEff cr w
                     $ set randGen g
                         w
             _   -> w
-    | otherwise = case cr ^? crState . stance . carriage of
+    | otherwise = case cr ^? crStance . carriage of
                     Just (Walking x y) -> takeStep x y w
                     _ -> w
         where hasJetPack = any (\it -> it ^? itIdentity == Just JetPack) $ _crInv cr
@@ -154,12 +154,12 @@ updateMovement g cr
     | isFrictionless cr 
         = (over crPos (+.+ momentum) $ setOldPos cr, g')
     | otherwise 
-        = case cr ^? crState . stance . carriage of
+        = case cr ^? crStance . carriage of
             Just (Walking x y) 
-                -> (set (crState . stance . carriage) (Walking ((x+y)`mod`120) 0)
+                -> (set (crStance . carriage) (Walking ((x+y)`mod`120) 0)
                     $ setOldPos
                     cr, g)
-            _  -> (set (crState . stance . carriage) (Walking 0 0)
+            _  -> (set (crStance . carriage) (Walking 0 0)
                     $ setOldPos
                     cr, g)
   where
@@ -170,7 +170,7 @@ updateMovement g cr
     (randAng,g') = randomR (0,2*pi) g
 
 isFrictionless :: Creature -> Bool
-isFrictionless cr = case cr ^? crState . stance . carriage of
+isFrictionless cr = case cr ^? crStance . carriage of
     Just (Boosting _) -> True
     Just (Floating)   -> True
     _                 -> False

src/Dodge/Creature/State/Data.hs

@@ -11,7 +11,6 @@ import Control.Lens
 
 data CreatureState = CrSt 
     { _goals    :: [[Impulse]]
-    , _stance  :: Stance
     , _faction :: Faction
     , _crDamage  :: [DamageType]
     , _crPastDamage :: [[DamageType]]

src/Dodge/Creature/YourControl.hs

@@ -37,45 +37,45 @@ wasdWithAiming w speed aimSpeed i cr
         -- = over crPos (+.+ (speed *.* mov)) 
         = over crPos (+.+ (speed *.* unitVectorAtAngle mouseDir)) 
           . set crDir mouseDir 
-          $ set (crState . stance . carriage) (Boosting mov)
+          $ set (crStance . carriage) (Boosting mov)
           cr
     | any (\it -> it ^? itIdentity == Just JetPack) (_crInv cr) && isMoving && isAiming
         = set crDir mouseDir 
-          $ set (crState . stance . carriage) Floating
+          $ set (crStance . carriage) Floating
           cr
     | any (\it -> it ^? itIdentity == Just JetPack) (_crInv cr) && isMoving
         = over crPos (+.+ (speed *.* mov)) 
           . over crDir (flip fromMaybe dir) 
-          $ set (crState . stance . carriage) (Boosting mov)
+          $ set (crStance . carriage) (Boosting mov)
           cr
     | any (\it -> it ^? itIdentity == Just JetPack) (_crInv cr) && isAiming
-        = set (crState . stance . carriage) Floating
+        = set (crStance . carriage) Floating
           $ set crDir mouseDir 
           cr
     |  any (\it -> it ^? itIdentity == Just JetPack) $ _crInv cr
-        = set (crState . stance . carriage) Floating
+        = set (crStance . carriage) Floating
           cr
     | isAiming
         = stepForward aimSpeed
           $ over crPos (+.+ (aimSpeed *.* mov)) 
           $ set crDir mouseDir 
-          $ set (crState . stance . carriage) (Walking 0 0)
+          $ set (crStance . carriage) (Walking 0 0)
           cr
     | isMoving
         = stepForward speed
           $ over crPos (+.+ (speed *.* mov)) 
           $ over crDir (`fromMaybe` dir) 
-          $ set (crState . stance . carriage) (Walking 0 0)
+          $ set (crStance . carriage) (Walking 0 0)
           cr
     | otherwise
         = over crDir (`fromMaybe` dir) 
-          $ set (crState . stance . carriage) Standing
+          $ set (crStance . carriage) Standing
                         cr
   where 
     (mov',dir') = wasdComp (view keys w) w
     (mov,dir)   = (rotateV (_cameraRot w) mov',fmap (_cameraRot w +) dir')
     isMoving    = mov' /= (0,0)
-    isAiming    = _posture (_stance $ _crState cr) == Aiming
+    isAiming    = _posture (_crStance cr) == Aiming
     mouseDir = case w ^? creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
                               . itAttachment of
         Just (Just ItScope{_scopePos = p}) -> normalizeAngle $ argV
@@ -100,9 +100,9 @@ wasdComp ks w = f $ foldr ( (+.+) . wasdM w ) (0,0) ks
 mouseActionsCr :: S.Set SDL.MouseButton -> Creature -> Creature
 mouseActionsCr keys cr 
     | rbPressed 
-        = set ( crState . stance . posture) Aiming cr
+        = set ( crStance . posture) Aiming cr
     | otherwise
-        = set ( crState . stance . posture) AtEase cr
+        = set ( crStance . posture) AtEase cr
     where lbPressed = SDL.ButtonLeft `S.member` keys
           rbPressed = SDL.ButtonRight `S.member` keys
 

src/Dodge/Data.hs

@@ -18,6 +18,7 @@ import Dodge.Picture.Layer.Data
 import Dodge.Creature.Data
 import Dodge.Creature.State.Data
 import Dodge.Creature.Stance.Data
+import Dodge.Creature.Rationality.Data
 import Dodge.Data.Menu
 import Dodge.Data.SoundOrigin
 import Dodge.Data.DamageType
@@ -148,6 +149,8 @@ data Creature = Creature
     , _crState      :: CreatureState
     , _crCorpse     :: Picture
     , _crApplyDamage :: [DamageType] -> Creature -> (World -> World,Creature)
+    , _crStance     :: Stance
+    , _crRationality :: Rationality
     }
 data WorldState 
     = DoorNumOpen Int 

src/Dodge/Default.hs

@@ -10,6 +10,7 @@ import Dodge.Item.Weapon.ExtraEffect
 import Dodge.Data
 import Dodge.Creature.Stance.Data
 import Dodge.Creature.State.Data
+import Dodge.Creature.Rationality.Data
 import Dodge.Data.Menu
 import Dodge.SoundLogic
 import Dodge.Base
@@ -88,10 +89,11 @@ defaultCreature = Creature
     , _crState  = defaultState
     , _crCorpse = onLayer CorpseLayer $ color (greyN 0.5) $ circleSolid 10
     , _crApplyDamage = defaultApplyDamage
+    , _crStance = Stance {_carriage=Walking 0 0,_posture=AtEase}
+    , _crRationality = ImpulseRat []
     }
 defaultState = CrSt 
     { _goals = []
-    , _stance = Stance {_carriage=Walking 0 0,_posture=AtEase}
     , _faction = NoFaction
     , _crDamage = []
     , _crPastDamage = []