loop/src/Dodge/Creature/Action.hs

{- | 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