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

Add no weapon start

Browse Source
This commit is contained in:
justin
2021-04-27 19:26:35 +02:00
parent 64b5b9e2a5
commit 6d229f8de2
20 changed files with 448 additions and 313 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/Action.hs
+227 -155
View File
@@ -1,4 +1,4 @@
{- Actions performed by creatures within the world
{- | Actions performed by creatures within the world
-}
{-# LANGUAGE BangPatterns #-}
module Dodge.Creature.Action
@@ -27,94 +27,139 @@ import System.Random
import qualified Data.IntMap.Strict as IM
import qualified Data.Map as M
moveForwardSpeed :: Float -> Int -> World -> World
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
where
p = (*.*) x $ unitVectorAtAngle $ _crDir $ _creatures w IM.! n
mvForward :: Float -> Int -> World -> World
mvForward speed cid w = stepForward cid speed $ over (creatures . ix cid . crPos) (+.+ p) w
where p = (*.*) (speed * equipFactor) $ unitVectorAtAngle $ _crDir $ _creatures w IM.! cid
equipFactor = product $ map equipSpeed $ IM.elems $ _crInv $ _creatures w IM.! cid
crStrafeLeft
:: Float -- ^ Speed
-> Creature
-> Creature
crStrafeLeft speed cr = stepForward s2 $ over crPos (+.+ p) cr
where
p = (*.*) s2 $ unitVectorAtAngle $ (_crDir cr + pi/2)
equipFactor = product $ map equipSpeed $ IM.elems $ _crInv cr
s2 = (speed * equipFactor)
crStrafeLeft :: Float -> Creature -> Creature
crStrafeLeft speed cr = stepForward' 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 -> Creature -> Creature
crStrafeRight speed cr = stepForward' 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 = stepForward 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 -> Creature -> Creature
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
where
p = (*.*) (speed * equipFactor) $ unitVectorAtAngle $ _crDir cr
equipFactor = product $ map equipSpeed $ IM.elems $ _crInv cr
crMvBy :: Point2 -> 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 $ _stance $ _crState cr) == Aiming
= fromMaybe 1 $ it ^? itAimingSpeed
| otherwise = 1
it = _crInv cr IM.! _crInvSel 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 $ _stance $ _crState cr) == Aiming
= fromMaybe 1 $ it ^? itAimingSpeed
| otherwise = 1
it = _crInv cr IM.! _crInvSel cr
stepForward :: Int -> Float -> World -> World
stepForward cid speed = over (creatures . ix cid . crState . stance . carriage) f
where f (w@Walking {}) = w {_stepToAdd = ceiling speed}
f s = s
stepForward' :: Float -> Creature -> Creature
stepForward' speed cr = over (crState . stance . carriage) f cr
where f (w@Walking {}) = w {_stepToAdd = ceiling speed}
f s = s
stepForward
:: Float -- ^ Speed
-> Creature
-> Creature
stepForward speed cr = over (crState . stance . carriage) f cr
where
f (w@Walking {}) = w {_stepToAdd = ceiling speed}
f s = s
{- Determine the speed modifier of an item. -}
equipSpeed :: Item -> Float
equipSpeed NoItem = 1
equipSpeed it | _itIdentity it == FrontArmour = 0.75
| _itIdentity it == FlameShield = 0.75
| otherwise = 1
turnTo :: Point2 -> Int -> World -> World
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)
where
cr = _creatures w IM.! n
dirToTarget = argV (p -.- _crPos cr)
turnToward :: Point2 -> Int -> World -> World
turnToward 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
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 -> Int -> World -> World
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
where
cr = _creatures w IM.! n
(r,g) = randomR (-0.1,0.1) (_randGen w)
m = diffAngles a (_crDir cr)
f = set randGen g
turnToward'' :: Float -> Point2 -> Int -> World -> World
turnToward'' turnSpeed p n w
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
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 -> Float -> Point2 -> Creature -> Creature
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
@@ -124,15 +169,23 @@ crTurnAndStrafeIn strafeSpeed turnSpeed p cr
$ crStrafeLeft strafeSpeed cr
| otherwise = over crDir (\x->normalizeAngle (x - turnAmount))
$ crStrafeRight strafeSpeed cr
where vToTarg = p -.- _crPos cr
dirToTarget = argV vToTarg
turnAmount = turnSpeed
where
vToTarg = p -.- _crPos cr
dirToTarget = argV vToTarg
turnAmount = turnSpeed
crTurnTo :: Point2 -> Creature -> Creature
crTurnTo
:: Point2 -- ^ Target position
-> Creature
-> Creature
crTurnTo p cr = set crDir dirToTarget cr
where dirToTarget = argV (p -.- _crPos cr)
crTurnTowardSpeed :: Float -> Point2 -> Creature -> Creature
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
@@ -144,7 +197,12 @@ crTurnTowardSpeed turnSpeed p cr
dirToTarget = argV vToTarg
turnAmount = turnSpeed
turnTowardSpeed :: Float -> Point2 -> Int -> World -> World
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
@@ -157,43 +215,54 @@ turnTowardSpeed turnSpeed p n w
dirToTarget = argV vToTarg
turnAmount = turnSpeed
turnLRS :: Int -> World -> World
turnLRS n w = f $ over (creatures . ix n . crDir) (+ (fromIntegral r * pi / 2)) w
where (r,g) = randomR (negate 1::Int,1) (_randGen w)
f = set randGen g
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)
turnToward' :: Point2 -> Int -> 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)
overturnToward :: Point2 -> Int -> World -> World
overturnToward p n w
| isLeftOfA dirToTarget (_crDir cr)
= over (creatures . ix n . crDir) (normalizeAngle. (+ 0.03 )) w
| otherwise = over (creatures . ix n . crDir) (\x->normalizeAngle (x - 0.03 )) w
where cr = _creatures w IM.! n
dirToTarget = argV (p -.- _crPos cr)
moveForward :: Int -> World -> World
{- 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
where
p = unitVectorAtAngle $ _crDir $ _creatures w IM.! n
moveToward :: Point2 -> Int -> World -> World
{- 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)
where
angle = errorAngleVV 5 (p -.- curPos) (unitVectorAtAngle (_crDir (_creatures w IM.! n)))
curPos = _crPos (_creatures w IM.! n)
moveBy :: Int -> Point2 -> World -> World
{- Translate a creature. -}
moveBy
:: Int -- ^ Creature id
-> Point2 -- ^ Translation
-> World
-> World
moveBy n v = over (creatures . ix n . crPos) (+.+ v)
reloadWeapon :: Int -> World -> Maybe World
reloadWeapon
:: Int -- ^ Creature id
-> World
-> Maybe World
reloadWeapon cid w =
let cr = _creatures w IM.! cid
it = _crInv cr IM.! _crInvSel cr
@@ -204,24 +273,32 @@ reloadWeapon cid w =
$ 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
Just 0 -> cr & crInv . ix (_crInvSel cr) . wpReloadState %~ (`fromMaybe` reloadT)
& crInv . ix (_crInvSel cr) . wpLoadedAmmo %~ (`fromMaybe` maxA)
_ -> cr
where reloadT = cr ^? crInv . ix (_crInvSel cr) . wpReloadTime
maxA = cr ^? crInv . ix (_crInvSel cr) . wpMaxAmmo
Just 0 -> cr & crInv . ix (_crInvSel cr) . wpReloadState %~ (`fromMaybe` reloadT)
& crInv . ix (_crInvSel cr) . wpLoadedAmmo %~ (`fromMaybe` maxA)
_ -> cr
where
reloadT = cr ^? crInv . ix (_crInvSel cr) . wpReloadTime
maxA = cr ^? crInv . ix (_crInvSel cr) . wpMaxAmmo
blinkAction :: Int -> World -> World
blinkAction n w = soundOnce teleSound $ set (creatures . ix n . crPos) p3
$ blinkShockwave n p3
$ inverseShockwaveAt cp 40 2 2 2
w
where p1 = _cameraCenter w +.+ (1 / _cameraZoom w) *.* rotateV (_cameraRot w) (_mousePos w)
cp = _crPos $ _creatures w IM.! n
p2 = collidePointWalls cp p1 $ wallsAlongLine cp p1 w
r = 1.5 * _crRad (_creatures w IM.! n)
p3 = fromMaybe p1 (fmap ((\p -> moveAmountToward p r cp) . fst) p2)
{- Teleport a creature to the mouse position -}
blinkAction
:: Int -- ^ Creature id
-> World
-> World
blinkAction n w = soundOnce teleSound
$ set (creatures . ix n . crPos) p3
$ blinkShockwave n p3
$ inverseShockwaveAt cp 40 2 2 2
w
where
p1 = _cameraCenter w +.+ (1 / _cameraZoom w) *.* rotateV (_cameraRot w) (_mousePos w)
cp = _crPos $ _creatures w IM.! n
p2 = collidePointWalls cp p1 $ wallsAlongLine cp p1 w
r = 1.5 * _crRad (_creatures w IM.! n)
p3 = fromMaybe p1 (fmap ((\p -> moveAmountToward p r cp) . fst) p2)
blinkShockwave
:: Int -- ^ Blinking creature ID.
@@ -230,19 +307,25 @@ blinkShockwave
-> World
blinkShockwave i p = makeShockwaveAt [i] p 60 1 2 cyan
moveAmountToward :: Point2 -> Float -> Point2 -> Point2
moveAmountToward
:: Point2 -- ^ Start point
-> Float -- ^ Fraction to move along
-> Point2 -- ^ End point
-> Point2
moveAmountToward p1 am p2
= p1 +.+ am *.* errorNormalizeV 44 (p2 -.- p1)
facePointAI :: Point2 -> Int -> World -> World
facePointAI p n w = set (creatures . ix n . crDir)
(argV (p -.- _crPos (_creatures w IM.! n)) )
w
reverseDir :: Int -> World -> World
reverseDir
:: Int -- ^ Creature id
-> World
-> World
reverseDir n = over (creatures . ix n . crDir) (+ pi)
turnBy :: Float -> Int -> World -> World
turnBy
:: Float -- ^ Angle change
-> Int -- ^ Creature id
-> World
-> World
turnBy a n = over (creatures . ix n . crDir) (+ a)
{-
@@ -251,60 +334,49 @@ Get your creature to drop the item under the cursor.
youDropItem :: World -> World
youDropItem w = case yourItem w of
NoItem -> w
it -> rmSelectedInvItem (_yourID w) $ over floorItems (IM.insert flid theflit)
$ updateLocation
$ soundOnce putDownSound
$ set randGen g w
where (rot, g) = randomR (-pi,pi) $ _randGen w
offset = _crRad (you w) *.* unitVectorAtAngle rot
updateLocation w = case it ^? itID of
Just (Just i) -> w & itemPositions . ix i .~ OnFloor flid
_ -> w
flid = newKey $ _floorItems w
theflit = FlIt {_flIt = set itAmount 1 it
,_flItPos = offset +.+ _crPos (you w)
,_flItRot = rot
,_flItID = flid}
it -> rmSelectedInvItem (_yourID w)
. copyItemToFloor (you w) (_crInvSel $ you w)
$ soundOnce putDownSound
w
{- Drop an item silently. -}
dropItem
:: Int -- ^ Creature id
{- Copy an inventory item to the floor. -}
copyItemToFloor
:: Creature
-> Int -- ^ Inventory position
-> World
-> World
dropItem cid i w = case _crInv cr IM.! i of
NoItem -> w
it -> rmInvItem cid i
. over floorItems (IM.insert flid theflit)
copyItemToFloor cr i w = case _crInv cr IM.! i of
NoItem -> w
it -> over floorItems (IM.insert flid theflit)
. updateLocation
$ set randGen g w
where
(rot, g) = randomR (-pi,pi) $ _randGen w
offset = _crRad cr *.* unitVectorAtAngle rot
offset = (_crRad cr + 2) *.* unitVectorAtAngle rot
updateLocation w = case it ^? itID of
Just (Just i) -> w & itemPositions . ix i .~ OnFloor flid
_ -> w
flid = newKey $ _floorItems w
theflit = FlIt
{_flIt = set itAmount 1 it
{_flIt = it
,_flItPos = offset +.+ _crPos cr
,_flItRot = rot
,_flItID = flid
}
where
cr = _creatures w IM.! cid
pickUpItem' :: FloorItem -> World -> World
pickUpItem' flit w = case maybeInvSlot of
{- Pick up a specific item. -}
pickUpItem :: FloorItem -> World -> World
pickUpItem flit w = case maybeInvSlot of
Nothing -> w
Just i -> soundOnce pickUpSound
$ updateItLocation i
$ w & floorItems %~ IM.delete (_flItID flit)
& creatures . ix 0 . crInv . ix i %~ addItem it
where
it = _flIt flit
maybeInvSlot = checkInvSlotsYou it w
updateItLocation invid w'
= case _itID it of Nothing -> w'
Just j -> w' & itemPositions . ix j .~ InInv 0 invid
Just i -> w
& soundOnce pickUpSound
& updateItLocation i
& floorItems %~ IM.delete (_flItID flit)
& creatures . ix 0 . crInv . ix i %~ addItem it
where
it = _flIt flit
maybeInvSlot = checkInvSlotsYou it w
updateItLocation invid w' = case _itID it of
Nothing -> w'
Just j -> w' & itemPositions . ix j .~ InInv 0 invid
src/Dodge/Creature/Inanimate.hs
+2 -2
View File
@@ -22,8 +22,8 @@ lamp :: Creature
lamp = defaultInanimate
{ _crUpdate = initialiseLamp
, _crHP = 500
, _crPict = \ _ -> onLayer CrLayer $ color white $ circleSolid 5
, _crRad = 5
, _crPict = \ _ -> onLayer CrLayer $ color white $ circleSolid 3
, _crRad = 3
}
initialiseLamp :: CRUpdate
src/Dodge/Creature/State.hs
-25
View File
@@ -67,31 +67,6 @@ dropByState cr w = foldr (copyItemToFloor cr) w is
DropSpecific xs -> xs
DropAmount n -> take n $ evalState (shuffle $ IM.keys $ _crInv cr) (_randGen w)
{- Copy an inventory item to the floor. -}
copyItemToFloor
:: Creature
-> Int -- ^ Inventory position
-> World
-> 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
where
(rot, g) = randomR (-pi,pi) $ _randGen w
offset = _crRad cr *.* unitVectorAtAngle rot
updateLocation w = case it ^? itID of
Just (Just i) -> w & itemPositions . ix i .~ OnFloor flid
_ -> w
flid = newKey $ _floorItems w
theflit = FlIt
{_flIt = it
,_flItPos = offset +.+ _crPos cr
,_flItRot = rot
,_flItID = flid
}
setOldPos :: Creature -> Creature
setOldPos cr = set crOldPos (_crPos cr) cr
src/Dodge/Creature/YourControl.hs
+2 -2
View File
@@ -57,13 +57,13 @@ wasdWithAiming w speed aimSpeed i cr
= set (crState . stance . carriage) Floating
cr
| isAiming
= stepForward' aimSpeed
= stepForward aimSpeed
$ over crPos (+.+ (aimSpeed *.* mov))
$ set crDir mouseDir
$ set (crState . stance . carriage) (Walking 0 0)
cr
| isMoving
= stepForward' speed
= stepForward speed
$ over ( crPos) (+.+ (speed *.* mov))
$ over ( crDir) (flip fromMaybe dir)
$ set (crState . stance . carriage) (Walking 0 0)