Split UseItem module
This commit is contained in:
@@ -0,0 +1,277 @@
|
||||
{-# LANGUAGE BangPatterns #-}
|
||||
module Dodge.CreatureAction
|
||||
( module Dodge.CreatureAction
|
||||
, useItemContinuous
|
||||
, tryUseItem
|
||||
)
|
||||
where
|
||||
-- imports {{{
|
||||
import Dodge.CreatureAction.UseItem
|
||||
|
||||
import Dodge.Data
|
||||
import Dodge.Base
|
||||
import Dodge.SoundLogic
|
||||
import Dodge.WorldActions
|
||||
import Dodge.Inventory
|
||||
|
||||
import Geometry
|
||||
import Picture
|
||||
|
||||
import Control.Lens
|
||||
import Control.Monad
|
||||
import Control.Applicative
|
||||
|
||||
import Data.Maybe
|
||||
import Data.List
|
||||
|
||||
import System.Random
|
||||
|
||||
import qualified Data.IntMap.Strict as IM
|
||||
import qualified Data.Map as M
|
||||
-- }}}
|
||||
|
||||
moveForwardSpeed :: Float -> Int -> World -> World
|
||||
moveForwardSpeed x n w = over (creatures . ix n . crPos) (+.+ p) w
|
||||
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 -> 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)
|
||||
|
||||
crMvForward :: Float -> 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 -> 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
|
||||
|
||||
equipSpeed NoItem = 1
|
||||
equipSpeed it | _itIdentity it == FrontArmour = 0.75
|
||||
| _itIdentity it == FlameShield = 0.75
|
||||
| otherwise = 1
|
||||
|
||||
turnTo :: Point2 -> Int -> World -> World
|
||||
turnTo p n w = set (creatures . ix n . crDir) dirToTarget 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)
|
||||
= 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 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
|
||||
|
||||
turnToward'' :: Float -> Point2 -> Int -> World -> World
|
||||
turnToward'' 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 -> Float -> Point2 -> 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 -> Creature -> Creature
|
||||
crTurnTo p cr = set crDir dirToTarget cr
|
||||
where dirToTarget = argV (p -.- _crPos cr)
|
||||
|
||||
crTurnTowardSpeed :: Float -> Point2 -> 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 -> Point2 -> Int -> 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
|
||||
|
||||
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 -> 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
|
||||
moveForward n w = over (creatures . ix n . crPos) (+.+ p) w
|
||||
where p = unitVectorAtAngle $ _crDir $ _creatures w IM.! n
|
||||
|
||||
moveToward :: Point2 -> Int -> 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)
|
||||
|
||||
moveBy :: Int -> Point2 -> World -> World
|
||||
moveBy n v = over (creatures . ix n . crPos) (+.+ v)
|
||||
|
||||
reloadWeapon :: Int -> World -> Maybe World
|
||||
reloadWeapon cid w =
|
||||
let cr = _creatures w IM.! cid
|
||||
it = _crInv cr IM.! _crInvSel cr
|
||||
itRef = creatures . ix cid . crInv . ix (_crInvSel cr)
|
||||
in case it of
|
||||
Weapon {_wpMaxAmmo=maxA,_wpLoadedAmmo=lA,_wpReloadState=rS,_wpReloadTime=rT}
|
||||
| lA < maxA && rS == 0 -> Just $ set ( itRef . wpLoadedAmmo) maxA
|
||||
$ set ( itRef . wpReloadState) rT w
|
||||
_ -> Nothing
|
||||
|
||||
|
||||
|
||||
createItemAt :: Point2 -> FloorItem -> World -> World
|
||||
createItemAt p it w = over floorItems (IM.insert i (set flItPos p
|
||||
$ set flItID i it)) w
|
||||
where i = newKey (_floorItems w)
|
||||
|
||||
blinkAction :: Int -> World -> World
|
||||
blinkAction n w = soundOnce teleSound $ set (creatures . ix n . crPos) p3
|
||||
$ blinkShockwave p3
|
||||
$ inverseShockwaveAt cp 40 2 2 2
|
||||
w
|
||||
where p1 = _cameraPos 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 :: Point2 -> World -> World
|
||||
blinkShockwave p = makeShockwaveAt p 40 1 2 cyan
|
||||
|
||||
moveAmountToward :: Point2 -> Float -> Point2 -> 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 n = over (creatures . ix n . crDir) (+ pi)
|
||||
|
||||
turnBy :: Float -> Int -> World -> World
|
||||
turnBy a n = over (creatures . ix n . crDir) (+ a)
|
||||
|
||||
dropItem :: World -> World
|
||||
dropItem w = case yourItem w of
|
||||
NoItem -> w
|
||||
it -> rmInvItem (_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}
|
||||
|
||||
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
|
||||
|
||||
Reference in New Issue
Block a user