diff --git a/src/Dodge/Creature/Action.hs b/src/Dodge/Creature/Action.hs index 7711636fa..e8edb1764 100644 --- a/src/Dodge/Creature/Action.hs +++ b/src/Dodge/Creature/Action.hs @@ -387,3 +387,12 @@ pickUpItem flit w = case maybeInvSlot of Nothing -> w' Just j -> w' & itemPositions . ix j .~ InInv 0 invid +{- | A creature attempts to move under its own steam. +The idea is that this may or may not work, depending on the status of the creature. +For now, though, this cannot fail. -} +creatureMove :: Point2 -> Creature -> Creature +creatureMove p = crPos %~ (+.+ p) + +creatureTurn :: Float -> Creature -> Creature +creatureTurn a = crDir +~ a + diff --git a/src/Dodge/Creature/Action/UseItem.hs b/src/Dodge/Creature/Action/UseItem.hs index e0db9126d..cebf11633 100644 --- a/src/Dodge/Creature/Action/UseItem.hs +++ b/src/Dodge/Creature/Action/UseItem.hs @@ -12,6 +12,9 @@ import Data.Maybe (fromMaybe) useItem :: Int -> World -> World useItem n w = equippedItemEffect n w +crUseItem :: Creature -> World -> World +crUseItem cr = itemEffect (_crID cr) (_crInv cr IM.! _crInvSel cr) + tryUseItem :: Int -- ^ Creature id -> World diff --git a/src/Dodge/Creature/Rationality.hs b/src/Dodge/Creature/Rationality.hs new file mode 100644 index 000000000..63d008158 --- /dev/null +++ b/src/Dodge/Creature/Rationality.hs @@ -0,0 +1,26 @@ +module Dodge.Creature.Rationality + where +import Dodge.Data +import Dodge.Creature.Rationality.Data +import Dodge.Creature.Action +import Dodge.Creature.Action.UseItem + +impulsiveAI + :: (Impulse -> World -> Creature -> (World -> World, Creature)) + -> World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature) +impulsiveAI = undefined + +applyBasicImpulse + :: Impulse + -> World + -> Creature + -> (World -> World , Creature) +applyBasicImpulse imp w cr = case imp of + Move p = (id, creatureMove p cr) + Turn a = (id, creatureTurn a cr) + UseItem = (crUseItem cr, cr) + SwitchToItem i = (id, cr & crInvSel .~ i) + Wait t = (id, cr & crRationality . crImpulse . waitTime -~ 1 + _ = (id, cr) + DropItem = undefined + diff --git a/src/Dodge/Creature/Rationality/Data.hs b/src/Dodge/Creature/Rationality/Data.hs new file mode 100644 index 000000000..76e8a5031 --- /dev/null +++ b/src/Dodge/Creature/Rationality/Data.hs @@ -0,0 +1,55 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE StrictData #-} +module Dodge.Creature.Rationality.Data + where +import Dodge.Creature.Stance.Data +import Geometry.Data + +import Control.Lens +data Rationality + = NonRat + | ImpulseRat + {_crImpulse :: Impulse } + | ActionRat + {_crImpulse :: Impulse + ,_crAction :: Action + } + | StrategyRat + {_crImpulse :: Impulse + ,_crAction :: Action + ,_crStrategy :: Strategy + } + +data Impulse + = Move Point2 + | Turn Float + | UseItem + | SwitchToItem Int + | DropItem + | PickupNearby Int + | UseWorldObject Int + | Bark -- placeholder for various communication types + | UseIntrinsicAbility + | ChangePosture Posture + | Wait {_waitTime :: Int} + +data Action + = Attack Int + | PathTo Point2 + | FleeFrom Int + | HealSelf + | DefendSelf + | Protect Int + | SearchFor Int + | Search + | PickupItem Int + +data Strategy + = Flank Int + | Ambush Int + | Lure Int Point2 + | GuardArea Point2 + | Patrol [Point2] + +makeLenses ''Rationality +makeLenses ''Impulse