{-# LANGUAGE TupleSections #-}
{- | Actions performed by creatures within the world
 -}
module Dodge.Creature.Action 
    ( performActionsR
    , stripNoItems
    , setMinInvSize
    , dropUnselected
    , dropExcept
    , startReloadingWeapon
    , blinkAction
    , sizeSelf
    , crAutoReload
    , copyInvItemToFloor
    , youDropItem
    , pickUpItem
    )
    where
import Dodge.Path
import Dodge.Default
import Dodge.WallCreatureCollisions
import Dodge.Creature.Stance.Data
import Dodge.WorldEvent.Shockwave
import Dodge.Data
import Dodge.Base
import Dodge.Zone
import Dodge.Base.Collide
import Dodge.SoundLogic
--import Dodge.WorldEvent
import Dodge.Inventory
import Dodge.FloorItem
--import Dodge.LightSources
import Geometry
import Picture
import qualified IntMapHelp as IM

import Control.Lens
--import Control.Monad
--import Control.Applicative
import Data.Maybe
import Data.List (findIndex)
import Control.Monad.Reader
--import qualified Data.Map as M
performActions :: World -> Creature -> Creature
performActions w cr = cr
    & crActionPlan . crImpulse .~ concat iss
    & crActionPlan . crAction .~ catMaybes mayas
  where
    (iss, mayas) = unzip $ map (performAction cr w) $ cr ^. crActionPlan . crAction

performActionsR :: Creature -> Reader World Creature
performActionsR cr = reader $ \w -> performActions w cr

type OutAction = ( [Impulse] , Maybe Action )

performAimAt :: Creature -> World -> Int -> Point2 -> OutAction
performAimAt cr w tcid p = ([TurnToward tpos aimSp], Just $ AimAt tcid tpos)
  where
    cdir = _crDir cr
    cpos = _crPos cr
    canSee' = canSee (_crID cr) tcid w
    aimSp = case cr ^? crMvType . mvAimSpeed of
        Just f -> f $ safeAngleVV (unitVectorAtAngle cdir) (tpos - cpos)
        Nothing -> error "creature without aiming type"
    tpos | canSee' = _crPos (_creatures w IM.! tcid)
         | otherwise = p

performPathTo :: Creature -> World -> Point2 -> OutAction
performPathTo cr w p
    | dist cpos p < 5 = ([], Nothing)
    | hasLOS cpos p w = ([MvTurnToward p,MvForward,RandomTurn jit] , Just (PathTo p))
    | otherwise       = case pointTowardsImpulse cpos p w of
        Just q -> ([MvTurnToward q,MvForward,RandomTurn jit] , Just (PathTo p))
        _ -> ([],Nothing)
  where
    cpos = _crPos cr
    jit = _mvTurnJit $ _crMvType cr

performTurnToA :: Creature -> Point2 -> OutAction
performTurnToA cr p
    | angleVV cdirv dirv < 0.1 = ([], Nothing)
    | otherwise = ([MvTurnToward p,RandomTurn jit] , Just (TurnToA p))
  where
    cpos = _crPos cr
    cdirv = unitVectorAtAngle (_crDir cr)
    dirv = p -.- cpos
    jit = _mvTurnJit $ _crMvType cr

{- | Performing an action means that a creature has some impulses for a frame, and
 updates or deletes the action itself. 
-- doAction -}
performAction 
    :: Creature
    -> World
    -> Action
    -> OutAction
performAction cr w ac = case ac of
    AimAt tcid p -> performAimAt cr w tcid p
    WaitThen 0 newAc -> ([] , Just newAc)
    WaitThen t newAc -> ([] , Just (WaitThen (t-1) newAc))
    ImpulsesList (xs:xss) -> (xs, Just $ ImpulsesList xss)
    ImpulsesList _  -> ([], Nothing)
    DoImpulses imps -> (imps, Nothing)
    DoActionThen fsta afta -> case performAction cr w fsta of
        (imps , Just nxta) -> (imps, Just (DoActionThen nxta afta))
        (imps , Nothing  ) -> (imps, Just afta)
    DoActionWhile f act -> performAction cr w $ DoActionWhilePartial act f act
    DoActionWhilePartial partAc f resetAc
        | f (w,cr) -> case performAction cr w partAc of
            (imps, Just nxta) -> (imps, Just $ DoActionWhilePartial nxta f resetAc)
            (imps, Nothing)   -> (imps, Just $ DoActionWhilePartial resetAc f resetAc)
        | otherwise -> performAction cr w partAc
    DoActionIf f ifa
        | f (w,cr) -> performAction cr w ifa
        | otherwise -> ([],Nothing)
    DoActionIfElse ifa f elsea
        | f (w,cr)  -> performAction cr w ifa
        | otherwise -> performAction cr w elsea
    DoActionWhileInterrupt repa f afta
        | f (w,cr)  -> (fst $ performAction cr w repa, Just $ DoActionWhileInterrupt repa f afta)
        | otherwise -> performAction cr w afta
    DoActions [] -> ([], Nothing)
    DoActions acs -> 
        let (imps, newAcs) = unzip $ map (performAction cr w) acs
        in (concat imps, Just . DoActions $ catMaybes newAcs)
    StartSentinelPost -> ([AddGoal $ SentinelAt (_crPos cr) (_crDir cr)], Nothing)
    PathTo p -> performPathTo cr w p
    TurnToA p -> performTurnToA cr p
    LeadTarget p -> case cr ^? crIntention . targetCr . _Just of
        Just tcr -> ([TurnTo (_crPos tcr +.+ rotateV (_crDir tcr) p)], Nothing)
        _        -> ([], Nothing)
    UseTarget f -> performAction cr w $ f $ cr ^? crIntention . targetCr . _Just
    UseSelf f   -> performAction cr w $ f cr
    UseAheadPos f -> performAction cr w (f (_crPos cr +.+ 20 *.* unitVectorAtAngle (_crDir cr)))
    UseMvTargetPos f -> performAction cr w $ f $ _mvToPoint $ _crIntention cr
    ArbitraryAction f -> performAction cr w (f cr w)
    DoImpulsesAlongside sideImp mainAc -> case performAction cr w mainAc of
        (imp, Just nxtac) -> (sideImp ++ imp, Just $ DoImpulsesAlongside sideImp nxtac)
        (imp, _)          -> (sideImp ++ imp, Nothing)
    DoReplicate t nxtac -> performAction cr w $ DoReplicatePartial nxtac t nxtac
    DoReplicatePartial _   0 pac -> performAction cr w pac
    DoReplicatePartial sac t pac -> case performAction cr w pac of
        (imps , Just nac) -> (imps, Just $ DoReplicatePartial sac t nac)
        (imps , _)        -> (imps, Just $ DoReplicatePartial sac (t-1) sac)
    NoAction -> ([],Nothing)

startReloadingWeapon 
    :: Creature      
    -> World 
    -> Maybe World
startReloadingWeapon cr w = 
    let cid = _crID cr
        it = _crInv cr IM.! _crInvSel cr
        itRef = creatures . ix cid . crInv . ix (_crInvSel cr)
    in case it of 
        Weapon {_wpAmmo = LoadableAmmo {_wpMaxAmmo=maxA,_wpLoadedAmmo=lA ,_wpReloadState=rS,_wpReloadTime=rT}}
            | lA < maxA && rS == 0 -> Just $ set ( itRef . wpAmmo . wpLoadedAmmo) maxA
                                            $ set ( itRef . wpAmmo . wpReloadState) rT w
        _                          -> Nothing
{- | Start reloading if clip is empty. -}
crAutoReload :: Creature -> Creature
crAutoReload cr = case cr ^? crInv . ix (_crInvSel cr) . wpAmmo . wpLoadedAmmo of
    Just 0 | _posture (_crStance cr) /= Aiming
            -> cr & crInv . ix (_crInvSel cr) . wpAmmo . wpReloadState %~ (`fromMaybe` reloadT)
        & crInv . ix (_crInvSel cr) . wpAmmo . wpLoadedAmmo  %~ (`fromMaybe` maxA)
    _      -> cr
  where 
    reloadT = cr ^? crInv . ix (_crInvSel cr) . wpAmmo . wpReloadTime
    maxA    = cr ^? crInv . ix (_crInvSel cr) . wpAmmo . wpMaxAmmo
{- | Teleport a creature to the mouse position -}
blinkAction 
    :: Creature
    -> World 
    -> World
blinkAction cr w 
    = soundMultiFrom [TeleSound 0,TeleSound 1] p3 teleS Nothing
    . over distortions (distortionBulge ++)
    . set (creatures . ix cid . crPos) p3
    . blinkShockwave cid p3
    $ inverseShockwaveAt cpos 40 2 2 w
  where
    distR = 120
    distortionBulge = 
        [RadialDistortion p3   (p3 +.+ V2 distR 0)   (p3 +.+ V2 0 distR)   0.1
        ,RadialDistortion cpos (cpos +.+ V2 distR 0) (cpos +.+ V2 0 distR) 1.9
        ]
    cid  = _crID cr
    p1 = mouseWorldPos w
    cpos = _crPos cr
    p2 = reflectPointWalls cpos p1 $ wallsAlongLine cpos p1 w
    r  = 1.5 * _crRad cr
    p3 = maybe p1 (mvPointTowardAtSpeed r cpos . fst) p2

blinkShockwave 
    :: Int      -- ^ Blinking creature ID.
    -> Point2 
    -> World 
    -> World
blinkShockwave i p = makeShockwaveAt [i] p 60 1 2 cyan 

setMinInvSize :: Int -> Creature -> World -> World
setMinInvSize n cr = creatures . ix (_crID cr) . crInv %~ f 
  where
    f inv = IM.unionWith const inv $ IM.fromList $ [0..n-1] <&> (, NoItem)

stripNoItems :: Creature -> World -> World
stripNoItems cr = organiseInvKeys (_crID cr) .
    ( creatures . ix (_crID cr) . crInv %~ IM.mapMaybe f )
  where
    f NoItem = Nothing
    f x      = Just x

organiseInvKeys :: Int -> World -> World
organiseInvKeys cid w = w & creatures . ix cid %~
    ( ( crInvSel .~ newSelKey ) . (crInv .~ newInv ) )
  where
    cr  = _creatures w IM.! cid
    pairs = IM.toList (_crInv cr)
    newSelKey = fromMaybe 0 $ findIndex ( (== _crInvSel cr) . fst) pairs
    newInv = IM.fromAscList $ zip [0..] $ map snd pairs

dropUnselected :: Creature -> World -> World
dropUnselected cr w = foldr (dropItem cr) w . IM.keys 
    $ _crInvSel cr `IM.delete` _crInv cr 

dropExcept :: Creature -> Int -> World -> World
dropExcept cr invid w = foldr (dropItem cr) w . IM.keys 
    $ invid `IM.delete` _crInv cr 

dropItem :: Creature -> Int -> World -> World
dropItem cr invid = rmInvItem cid invid . copyInvItemToFloor cr invid . mayberemoveequip
  where
    cid = _crID cr
    mayberemoveequip = case _crLeftInvSel cr of
        Just i | i == invid -> creatures . ix cid . crLeftInvSel .~ Nothing
        _ -> id

{- | Get your creature to drop the item under the cursor.  -}
youDropItem :: World -> World
youDropItem w = case yourItem w ^? itCurseStatus of
    Just Uncursed -> w
        & dropItem cr (_crInvSel cr) 
        & soundStart (CrSound (_crID cr)) (_crPos cr) whiteNoiseFadeOutS Nothing
    _ -> w
  where
    cr = you w
{- | Copy an inventory item to the floor. -}
copyInvItemToFloor :: Creature -> Int -> World -> World
copyInvItemToFloor cr i w = case _crInv cr IM.! i of
    NoItem  -> w
    it      -> copyItemToFloor (_crPos cr) it w

    

{- | Pick up a specific item. -}
pickUpItem 
    :: Int  -- ^ Creature id
    -> FloorItem 
    -> World 
    -> World
pickUpItem cid flit w = case maybeInvSlot of
    Nothing -> w
    Just i  -> w
        & soundStart (CrSound cid) (_flItPos flit) pickUpS Nothing
        & 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

sizeSelf :: Float -> Creature -> World -> Maybe World
sizeSelf x cr w 
    -- | _crPos cr1 == _crPos cr2 = Just $ w
    | not (crOnWall cr1 w) = Just $ w
        & soundMultiFrom [TeleSound 0,TeleSound 1] cpos teleS Nothing
        & over distortions (distortionBulge :)
        & creatures . ix cid %~ 
            ( (crRad .~ 10 * x) 
            . (crMvType . mvSpeed .~ yourDefaultSpeed * x)
            . (crStance . strideLength .~ ceiling (fromIntegral yourDefaultStrideLength * x))
            )
    | otherwise = Nothing
  where
    cr1 = colCrWall w (cr {_crRad = 10* x})
    --cr2 = colCrWall w cr1
    distR = 120
    distortionBulge 
        | _crRad cr < 10*x  = raddist 1.9
        | otherwise         = raddist 0.1
    raddist = RadialDistortion cpos (cpos +.+ V2 distR 0) (cpos +.+ V2 0 distR)
    cid  = _crID cr
    cpos = _crPos cr