justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Remove duplicated creature movement code

Browse Source
This commit is contained in:
justin
2021-05-21 14:20:45 +02:00
parent 114335fdbe
commit 322894c513
8 changed files with 87 additions and 264 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/Action.hs
-236
View File
@@ -29,176 +29,6 @@ import System.Random
import qualified Data.IntMap.Strict as IM
--import qualified Data.Map as M
crStrafeLeft
:: Float -- ^ Speed
-> Creature
-> Creature
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
s2 = speed * equipFactor
crStrafeRight
:: Float -- ^ Speed
-> Creature
-> Creature
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
turnTo
:: Point2 -- ^ Target point
-> Int -- ^ Creature id
-> World
-> World
turnTo p n w = set (creatures . ix n . crDir) dirToTarget w
where
cr = _creatures w IM.! n
dirToTarget = argV (p -.- _crPos cr)
turnTowardRandomise
:: Point2 -- ^ Target point
-> Int -- ^ Creature id
-> World
-> World
turnTowardRandomise p n w
| isLeftOfA dirToTarget (_crDir cr)
= f $ over (creatures . ix n . crDir)
(normalizeAngle . (+ (0.03 + r*m))) w
| otherwise = f $ over (creatures . ix n . crDir)
(\x->normalizeAngle (x - (0.03 + r*m))) w
where
cr = _creatures w IM.! n
dirToTarget = argV (p -.- _crPos cr)
(r,g) = randomR (-0.1,0.1) (_randGen w)
m = diffAngles dirToTarget (_crDir cr)
f = set randGen g
turnTowardAngle
:: Float -- ^ Angle
-> Int -- ^ Creature id
-> World
-> World
turnTowardAngle a n w
| isLeftOfA a (_crDir cr) = f $ over (creatures . ix n . crDir)
(normalizeAngle . (+ (0.03 + r*m))) w
| otherwise = f $ over (creatures . ix n . crDir)
(\x->normalizeAngle (x - (0.03 + r*m))) w
where
cr = _creatures w IM.! n
(r,g) = randomR (-0.1,0.1) (_randGen w)
m = diffAngles a (_crDir cr)
f = set randGen g
turnTowardWithSpeed
:: Float -- ^ Turn speed
-> Point2 -- ^ Target point
-> Int -- ^ Creature id
-> World
-> World
turnTowardWithSpeed turnSpeed p n w
| isLeftOfA dirToTarget (_crDir cr)
= f $ over (creatures . ix n . crDir) (normalizeAngle. (+ (turnSpeed + r))) w
| otherwise = f $ over (creatures . ix n . crDir) (\x->normalizeAngle (x - (turnSpeed + r))) w
where
cr = _creatures w IM.! n
dirToTarget = argV (p -.- _crPos cr)
(r,g) = randomR (-0.1,0.1) (_randGen w)
f = set randGen g
crTurnAndStrafeIn
:: Float -- ^ Strafe speed
-> Float -- ^ Turn speed
-> Point2 -- ^ Target position
-> Creature
-> Creature
crTurnAndStrafeIn strafeSpeed turnSpeed p cr
| vToTarg == (0,0) = cr -- this should deal with the angleVV error
| errorAngleVV 3 vToTarg (unitVectorAtAngle (_crDir cr)) <= turnSpeed
= set crDir dirToTarget cr
| isLeftOfA dirToTarget (_crDir cr)
= over crDir (normalizeAngle . (+ turnAmount ))
$ crStrafeLeft strafeSpeed cr
| otherwise = over crDir (\x->normalizeAngle (x - turnAmount))
$ crStrafeRight strafeSpeed cr
where
vToTarg = p -.- _crPos cr
dirToTarget = argV vToTarg
turnAmount = turnSpeed
crTurnTo
:: Point2 -- ^ Target position
-> Creature
-> Creature
crTurnTo p cr = set crDir dirToTarget cr
where dirToTarget = argV (p -.- _crPos cr)
crRandomTurn
:: RandomGen g
=> Float -- ^ Max possible angle, supposed to be positive
-> Creature
-> g
-> (Creature, g)
crRandomTurn a cr g =
let (r, g') = randomR (negate a, a) g
in (cr & crDir +~ r, g')
crTurnTowardSpeed
:: Float -- ^ Turn speed
-> Point2 -- ^ Target position
-> Creature
-> Creature
crTurnTowardSpeed turnSpeed p cr
| vToTarg == (0,0) = cr -- this should deal with the angleVV error
| errorAngleVV 3 vToTarg (unitVectorAtAngle (_crDir cr)) <= turnSpeed
= set crDir dirToTarget cr
| isLeftOfA dirToTarget (_crDir cr)
= over crDir (normalizeAngle . (+ turnAmount )) cr
| otherwise = over crDir (\x->normalizeAngle (x - turnAmount)) cr
where vToTarg = p -.- _crPos cr
dirToTarget = argV vToTarg
turnAmount = turnSpeed
turnTowardSpeed
:: Float -- ^ Turn speed
-> Point2 -- ^ Target position
-> Int -- ^ Creature id
-> World
-> World
turnTowardSpeed turnSpeed p n w
| vToTarg == (0,0) = w -- this should deal with the angleVV error
| errorAngleVV 3 vToTarg (unitVectorAtAngle (_crDir cr)) <= turnSpeed
= set (creatures . ix n . crDir) dirToTarget w
| isLeftOfA dirToTarget (_crDir cr)
= over (creatures . ix n . crDir) (normalizeAngle . (+ turnAmount )) w
| otherwise = over (creatures . ix n . crDir) (\x->normalizeAngle (x - turnAmount)) w
where cr = _creatures w IM.! n
vToTarg = p -.- _crPos cr
dirToTarget = argV vToTarg
turnAmount = turnSpeed
turnToward
:: Point2 -- ^ Target position
-> Int -- ^ Creature id
-> World
-> World
turnToward p n w
| isLeftOfA dirToTarget (_crDir cr) = over (creatures . ix n . crDir) (+ 0.03) w
| otherwise = over (creatures . ix n . crDir) (\x-> x - 0.03) w
where
cr = _creatures w IM.! n
dirToTarget = argV (p -.- _crPos cr)
{- | Translate a creature. -}
moveBy
:: Int -- ^ Creature id
-> Point2 -- ^ Translation
-> World
-> World
moveBy n v = over (creatures . ix n . crPos) (+.+ v)
startReloadingWeapon
:: Int -- ^ Creature id
-> World
@@ -212,7 +42,6 @@ startReloadingWeapon cid w =
| lA < maxA && rS == 0 -> Just $ set ( itRef . wpLoadedAmmo) maxA
$ set ( itRef . wpReloadState) rT w
_ -> Nothing
{- | Start reloading if clip is empty. -}
crAutoReload :: Creature -> Creature
crAutoReload cr = case cr ^? crInv . ix (_crInvSel cr) . wpLoadedAmmo of
@@ -223,7 +52,6 @@ crAutoReload cr = case cr ^? crInv . ix (_crInvSel cr) . wpLoadedAmmo of
where
reloadT = cr ^? crInv . ix (_crInvSel cr) . wpReloadTime
maxA = cr ^? crInv . ix (_crInvSel cr) . wpMaxAmmo
{- | Teleport a creature to the mouse position -}
blinkAction
:: Int -- ^ Creature id
@@ -256,18 +84,6 @@ moveAmountToward
moveAmountToward p1 am p2
= p1 +.+ am *.* errorNormalizeV 44 (p2 -.- p1)
reverseDir
:: Int -- ^ Creature id
-> World
-> World
reverseDir n = over (creatures . ix n . crDir) (+ pi)
turnBy
:: Float -- ^ Angle change
-> Int -- ^ Creature id
-> World
-> World
turnBy a n = over (creatures . ix n . crDir) (+ a)
{- | Get your creature to drop the item under the cursor. -}
youDropItem :: World -> World
youDropItem w = case yourItem w of
@@ -317,56 +133,4 @@ pickUpItem cid flit w = case maybeInvSlot of
updateItLocation invid w' = case _itID it of
Nothing -> w'
Just j -> w' & itemPositions . ix j .~ InInv 0 invid
{- | 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. -}
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 = crMvBy (speed,0)
advanceStepCounter
:: Float -- ^ Speed
-> Creature
-> Creature
advanceStepCounter speed = crStance . carriage %~ f
where
f w@Walking{} = w{_stepToAdd = ceiling speed}
f s = s
creatureTurn :: Float -> Creature -> Creature
creatureTurn a = crDir +~ a
creatureTurnTo :: Point2 -> Creature -> Creature
creatureTurnTo p cr
| vToTarg == (0,0) = cr -- this should deal with the angleVV error
| otherwise = cr & crDir .~ dirToTarget
where
vToTarg = p -.- _crPos cr
dirToTarget = argV vToTarg
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 (normalizeAngle dirToTarget) (normalizeAngle $ _crDir cr) = cr & crDir +~ turnSpeed
| otherwise = cr & crDir -~ turnSpeed
where
vToTarg = p -.- _crPos cr
dirToTarget = argV vToTarg