{- | Actions performed by creatures within the world
 -}
{-# LANGUAGE BangPatterns #-}
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 hiding (carriage)
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

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

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)

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

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 $ _crStance cr) == Aiming
                      = fromMaybe 1 $ it ^? itAimingSpeed
                 | otherwise = 1
    it = _crInv cr IM.! _crInvSel cr

stepForward 
    :: Float    -- ^ Speed
    -> Creature 
    -> Creature
stepForward speed cr = over (crStance . carriage) f cr
  where 
    f (w@Walking {}) = w {_stepToAdd = ceiling speed}
    f s = s


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)

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

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

{- Translate a creature. -}
moveBy 
    :: Int      -- ^ Creature id
    -> Point2   -- ^ Translation
    -> World 
    -> World
moveBy n v = over (creatures . ix n . crPos) (+.+ v)

reloadWeapon 
    :: Int      -- ^ Creature id
    -> 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

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

{- 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 = fromMaybe p1 (fmap ((\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
    it -> 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 :: FloorItem -> World -> World
pickUpItem flit w = case maybeInvSlot of
    Nothing -> w
    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

{- | A creature attempts to move 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. -}
creatureMove :: Point2 -> Creature -> Creature
creatureMove p = crPos %~ (+.+ p)

creatureTurn :: Float -> Creature -> Creature
creatureTurn a = crDir +~ a