AI refactor
This commit is contained in:
@@ -30,20 +30,11 @@ import System.Random
|
||||
import qualified Data.IntMap.Strict as IM
|
||||
import qualified Data.Map as M
|
||||
|
||||
moveForwardSpeed
|
||||
:: Float -- ^ Speed
|
||||
-> Int -- ^ Creature id
|
||||
-> World
|
||||
-> World
|
||||
moveForwardSpeed x n w = over (creatures . ix n . crPos) (+.+ p) w
|
||||
where
|
||||
p = (*.*) x $ unitVectorAtAngle $ _crDir $ _creatures w IM.! n
|
||||
|
||||
crStrafeLeft
|
||||
:: Float -- ^ Speed
|
||||
-> Creature
|
||||
-> Creature
|
||||
crStrafeLeft speed cr = stepForward s2 $ over crPos (+.+ p) cr
|
||||
crStrafeLeft speed cr = advanceStepCounter s2 $ over crPos (+.+ p) cr
|
||||
where
|
||||
p = (*.*) s2 $ unitVectorAtAngle $ (_crDir cr + pi/2)
|
||||
equipFactor = product $ map equipSpeed $ IM.elems $ _crInv cr
|
||||
@@ -53,42 +44,12 @@ crStrafeRight
|
||||
:: Float -- ^ Speed
|
||||
-> Creature
|
||||
-> Creature
|
||||
crStrafeRight speed cr = stepForward s2 $ over crPos (+.+ p) cr
|
||||
crStrafeRight speed cr = advanceStepCounter s2 $ over crPos (+.+ p) cr
|
||||
where
|
||||
p = (*.*) s2 $ unitVectorAtAngle $ (_crDir cr - pi/2)
|
||||
equipFactor = product $ map equipSpeed $ IM.elems $ _crInv cr
|
||||
s2 = (speed * equipFactor)
|
||||
|
||||
crMvForward
|
||||
:: Float -- ^ Speed
|
||||
-> Creature
|
||||
-> Creature
|
||||
crMvForward speed cr = over crPos (+.+ p) cr
|
||||
where
|
||||
p = (*.*) (speed * equipFactor) $ unitVectorAtAngle $ _crDir cr
|
||||
equipFactor = product $ map equipSpeed $ IM.elems $ _crInv cr
|
||||
|
||||
crMvBy
|
||||
:: Point2 -- ^ Movement translation vector
|
||||
-> Creature
|
||||
-> Creature
|
||||
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 $ _crStance cr) == Aiming
|
||||
= fromMaybe 1 $ it ^? itAimingSpeed
|
||||
| otherwise = 1
|
||||
it = _crInv cr IM.! _crInvSel cr
|
||||
|
||||
stepForward
|
||||
:: Float -- ^ Speed
|
||||
-> Creature
|
||||
-> Creature
|
||||
stepForward speed cr = over (crStance . carriage) f cr
|
||||
where
|
||||
f (w@Walking {}) = w {_stepToAdd = ceiling speed}
|
||||
f s = s
|
||||
|
||||
|
||||
turnTo
|
||||
@@ -233,32 +194,7 @@ turnToward p n w
|
||||
where
|
||||
cr = _creatures w IM.! n
|
||||
dirToTarget = argV (p -.- _crPos cr)
|
||||
|
||||
{- Move a creature forward in the direction it is facing. -}
|
||||
moveForward
|
||||
:: Int -- ^ Creature id
|
||||
-> World
|
||||
-> World
|
||||
moveForward n w = over (creatures . ix n . crPos) (+.+ p) w
|
||||
where
|
||||
p = unitVectorAtAngle $ _crDir $ _creatures w IM.! n
|
||||
|
||||
{- Move a creature forward, faster if it is facing a target point -}
|
||||
moveToward
|
||||
:: Point2 -- ^ Target point
|
||||
-> Int -- ^ Creature id
|
||||
-> World
|
||||
-> World
|
||||
moveToward p n w
|
||||
| angle < 10 = moveForwardSpeed 0.1 n w
|
||||
| angle < 20 = moveForwardSpeed 0.02 n w
|
||||
| angle < 40 = moveForwardSpeed 0.01 n w
|
||||
| otherwise = w
|
||||
where
|
||||
angle = errorAngleVV 5 (p -.- curPos) (unitVectorAtAngle (_crDir (_creatures w IM.! n)))
|
||||
curPos = _crPos (_creatures w IM.! n)
|
||||
|
||||
{- Translate a creature. -}
|
||||
{- | Translate a creature. -}
|
||||
moveBy
|
||||
:: Int -- ^ Creature id
|
||||
-> Point2 -- ^ Translation
|
||||
@@ -280,7 +216,7 @@ reloadWeapon cid w =
|
||||
$ set ( itRef . wpReloadState) rT w
|
||||
_ -> Nothing
|
||||
|
||||
{- Start reloading if clip is empty. -}
|
||||
{- | Start reloading if clip is empty. -}
|
||||
crAutoReload :: Creature -> Creature
|
||||
crAutoReload cr = case cr ^? crInv . ix (_crInvSel cr) . wpLoadedAmmo of
|
||||
Just 0 -> cr & crInv . ix (_crInvSel cr) . wpReloadState %~ (`fromMaybe` reloadT)
|
||||
@@ -290,7 +226,7 @@ crAutoReload cr = case cr ^? crInv . ix (_crInvSel cr) . wpLoadedAmmo of
|
||||
reloadT = cr ^? crInv . ix (_crInvSel cr) . wpReloadTime
|
||||
maxA = cr ^? crInv . ix (_crInvSel cr) . wpMaxAmmo
|
||||
|
||||
{- Teleport a creature to the mouse position -}
|
||||
{- | Teleport a creature to the mouse position -}
|
||||
blinkAction
|
||||
:: Int -- ^ Creature id
|
||||
-> World
|
||||
@@ -334,10 +270,7 @@ turnBy
|
||||
-> World
|
||||
-> World
|
||||
turnBy a n = over (creatures . ix n . crDir) (+ a)
|
||||
|
||||
{-
|
||||
Get your creature to drop the item under the cursor.
|
||||
-}
|
||||
{- | Get your creature to drop the item under the cursor. -}
|
||||
youDropItem :: World -> World
|
||||
youDropItem w = case yourItem w of
|
||||
NoItem -> w
|
||||
@@ -345,8 +278,7 @@ youDropItem w = case yourItem w of
|
||||
. copyItemToFloor (you w) (_crInvSel $ you w)
|
||||
$ soundOnce putDownSound
|
||||
w
|
||||
|
||||
{- Copy an inventory item to the floor. -}
|
||||
{- | Copy an inventory item to the floor. -}
|
||||
copyItemToFloor
|
||||
:: Creature
|
||||
-> Int -- ^ Inventory position
|
||||
@@ -354,9 +286,7 @@ copyItemToFloor
|
||||
-> World
|
||||
copyItemToFloor cr i w = case _crInv cr IM.! i of
|
||||
NoItem -> w
|
||||
it -> over floorItems (IM.insert flid theflit)
|
||||
. updateLocation
|
||||
$ set randGen g w
|
||||
it -> over floorItems (IM.insert flid theflit) . updateLocation $ set randGen g w
|
||||
where
|
||||
(rot, g) = randomR (-pi,pi) $ _randGen w
|
||||
offset = (_crRad cr + 2) *.* unitVectorAtAngle rot
|
||||
@@ -370,16 +300,19 @@ copyItemToFloor cr i w = case _crInv cr IM.! i of
|
||||
,_flItRot = rot
|
||||
,_flItID = flid
|
||||
}
|
||||
|
||||
{- Pick up a specific item. -}
|
||||
pickUpItem :: FloorItem -> World -> World
|
||||
pickUpItem flit w = case maybeInvSlot of
|
||||
{- | Pick up a specific item. -}
|
||||
pickUpItem
|
||||
:: Int -- ^ Creature id
|
||||
-> FloorItem
|
||||
-> World
|
||||
-> World
|
||||
pickUpItem cid flit w = case maybeInvSlot of
|
||||
Nothing -> w
|
||||
Just i -> w
|
||||
& soundOnce pickUpSound
|
||||
& updateItLocation i
|
||||
& floorItems %~ IM.delete (_flItID flit)
|
||||
& creatures . ix 0 . crInv . ix i %~ addItem it
|
||||
& creatures . ix cid . crInv . ix i %~ addItem it
|
||||
where
|
||||
it = _flIt flit
|
||||
maybeInvSlot = checkInvSlotsYou it w
|
||||
@@ -387,12 +320,48 @@ 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.
|
||||
{- | Creature attempts to moves 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)
|
||||
crMvBy
|
||||
:: Point2 -- ^ Movement translation vector
|
||||
-> Creature
|
||||
-> Creature
|
||||
crMvBy p' cr = advanceStepCounter (magV p) $ over crPos (+.+ p) cr
|
||||
where
|
||||
p = (*.*) (equipFactor * aimingFactor) $ rotateV (_crDir cr) p'
|
||||
equipFactor = product $ map equipSpeed $ IM.elems $ _crInv cr
|
||||
aimingFactor | (_posture $ _crStance cr) == Aiming
|
||||
= fromMaybe 1 $ it ^? itAimingSpeed
|
||||
| otherwise = 1
|
||||
it = _crInv cr IM.! _crInvSel cr
|
||||
|
||||
crMvForward
|
||||
:: Float -- ^ Speed
|
||||
-> Creature
|
||||
-> Creature
|
||||
crMvForward speed cr = crMvBy (speed,0) cr
|
||||
|
||||
|
||||
advanceStepCounter
|
||||
:: Float -- ^ Speed
|
||||
-> Creature
|
||||
-> Creature
|
||||
advanceStepCounter speed cr = over (crStance . carriage) f cr
|
||||
where
|
||||
f (w@Walking {}) = w {_stepToAdd = ceiling speed}
|
||||
f s = s
|
||||
|
||||
creatureTurn :: Float -> Creature -> Creature
|
||||
creatureTurn a = crDir +~ a
|
||||
|
||||
creatureTurnToward :: Point2 -> Float -> Creature -> Creature
|
||||
creatureTurnToward p turnSpeed cr
|
||||
| vToTarg == (0,0) = cr -- this should deal with the angleVV error
|
||||
| errorAngleVV 3 vToTarg (unitVectorAtAngle (_crDir cr)) <= turnSpeed
|
||||
= cr & crDir .~ dirToTarget
|
||||
| isLeftOfA dirToTarget (_crDir cr) = cr & crDir +~ turnSpeed
|
||||
| otherwise = cr & crDir -~ turnSpeed
|
||||
where
|
||||
vToTarg = p -.- _crPos cr
|
||||
dirToTarget = argV vToTarg
|
||||
|
||||
Reference in New Issue
Block a user