{- | Actions performed by creatures within the world -} module Dodge.Creature.Action ( module Dodge.Creature.Action , module Dodge.Creature.Action.UseItem , module Dodge.Creature.Action.Movement ) where import Dodge.Creature.Action.UseItem import Dodge.Creature.Action.Movement import Dodge.Creature.Stance.Data --import Dodge.Creature.State.Data import Dodge.WorldEvent.Shockwave import Dodge.Data import Dodge.Base import Dodge.SoundLogic --import Dodge.WorldEvent import Dodge.Inventory --import Dodge.LightSources 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 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 -> Maybe World startReloadingWeapon 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 {- | Start reloading if clip is empty. -} crAutoReload :: Creature -> Creature crAutoReload cr = case cr ^? crInv . ix (_crInvSel cr) . wpLoadedAmmo of Just 0 | _posture (_crStance cr) /= Aiming -> 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 {- | 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 = reflectPointWalls cp p1 $ wallsAlongLine cp p1 w r = 1.5 * _crRad (_creatures w IM.! n) p3 = maybe p1 ((\p -> moveAmountToward p r cp) . fst) p2 blinkShockwave :: Int -- ^ Blinking creature ID. -> Point2 -> World -> World blinkShockwave i p = makeShockwaveAt [i] p 60 1 2 cyan moveAmountToward :: Point2 -- ^ Start point -> Float -- ^ Fraction to move along -> Point2 -- ^ End point -> Point2 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 NoItem -> w _ -> rmSelectedInvItem (_yourID w) . copyItemToFloor (you w) (_crInvSel $ you w) $ soundOnce putDownSound 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 + 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 = it ,_flItPos = offset +.+ _crPos cr ,_flItRot = rot ,_flItID = flid } {- | 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 cid . 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 {- | 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