{-# LANGUAGE BangPatterns #-}
module Dodge.CreatureAction 
    ( module Dodge.CreatureAction
    , useItem
    , tryUseItem
    )
    where
-- imports {{{
import Dodge.CreatureAction.UseItem

import Dodge.Data
import Dodge.Base
import Dodge.SoundLogic
import Dodge.WorldEvent
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

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

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 = _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 :: 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