loop/src/Dodge/Projectile/Update.hs

--{-# OPTIONS_GHC -Wno-unused-imports #-}
module Dodge.Projectile.Update 
    ( updateProjectile
    ) where

import Dodge.Movement.Turn
import NewInt
import Dodge.Payload
import Control.Lens
import Data.Maybe
import Dodge.Base
import Dodge.Data.World
import Dodge.EnergyBall
import Dodge.Item.Location
import Dodge.SoundLogic
import Dodge.WorldEvent.Cloud
import Geometry
import qualified IntMapHelp as IM
import RandomHelp
import Data.Foldable

updateProjectile :: Projectile -> World -> World
updateProjectile pj w = foldl' (\w' pu -> upProjectile pu pj w') w (_prjUpdates pj)

upProjectile :: ProjectileUpdate -> Projectile -> World -> World
upProjectile pu pj = case pu of
    CollisionEffectPU mscreenid -> shellCollisionEffect mscreenid pj
    TimePU -> decTimMvVel pj
    ThrustPU st et
        | act st et -> doThrust pj
        | otherwise -> id
    StartSpinPU t cid spinamount
        | time == t -> trySpinByCID cid spinamount pj
        | otherwise -> id
    RemoteDirectionPU st et mscreenid
        | act st et -> pjRemoteSetDirection mscreenid pj
        | otherwise -> id
    ReduceSpinPU x -> reduceSpinBy x (_prjID pj)
    DestroyPU mitid 0 -> destroyProjectile mitid (_prjID pj)
-- the following requires that this is at the top of the update list, which is
-- not ideal
    DestroyPU _ _ -> cWorld . lWorld . projectiles . ix (_prjID pj) . prjUpdates . ix 0 . pjuTimer -~ 1
  where
    time = _prjTimer pj
    act st et = time <= st && time >= et

shellCollisionEffect :: Maybe (NewInt ItmInt) -> Projectile -> World -> World
shellCollisionEffect mscreenid = shellCollisionCheck 
    $ \pj -> explodeShell mscreenid (_prjID pj)

shellCollisionCheck :: (Projectile -> World -> World) -> Projectile -> World -> World
shellCollisionCheck f pj w
    | time > 330 && circOnSomeWall oldPos 4 w = f pj w
    | time <= 330 && anythingHitCirc 2 oldPos newPos w = f pj w
    | time <= 0 = f pj w
    | otherwise = w
  where
    time = _prjTimer pj
    oldPos = _prjPos pj
    newPos = oldPos +.+ _prjVel pj

destroyProjectile :: Maybe (NewInt ItmInt) -> Int -> World -> World
destroyProjectile mitid pjid w = w & cWorld . lWorld . projectiles %~ IM.delete pjid
    & removelink
  where
    removelink = fromMaybe id $ do
        itid <- fmap _unNInt mitid
        loc <- w ^? cWorld . lWorld . itemLocations . ix itid
        itm <- w ^? pointerToItemLocation loc . itUse . atLinkedProjectile . _Just
        guard $ itm == pjid
        return $ pointerToItemLocation loc . itUse . atLinkedProjectile .~ Nothing
        
doThrust :: Projectile -> World -> World
doThrust pj w =
    w
        & randGen .~ g
        & cWorld . lWorld . projectiles . ix i . prjVel %~ (\v -> accel +.+ frict *.* v)
        & soundContinue (ShellSound i) newPos missileLaunchS (Just 1)
        & makeFlamelet (oldPos -.- vel) 0 (vel +.+ rotateV (pi + sparkD) accel) 3 10
        & shellTrailCloud trailage trailfadetime 
            (addZ 20 (oldPos +.+ r1 +.+ 30 *.* normalizeV (oldPos -.- newPos)))
  where
    trailage = fst . randomR (300, 500) $ _randGen w
    trailfadetime = fst . randomR (100, 300) $ _randGen w
    accel = _prjAcc pj
    i = _prjID pj
    oldPos = _prjPos pj
    vel = _prjVel pj
    newPos = oldPos +.+ vel
    (frict, g) = randomR (0.6, 0.9) $ _randGen w
    (sparkD, _) = randomR (-0.2, 0.2) $ _randGen w
    r1 = randInCirc 10 & evalState $ _randGen w

trySpinByCID ::
    -- | creature id
    Int ->
    -- | Spin amount
    Int ->
    Projectile ->
    World ->
    World
trySpinByCID cid i pj w = w & cWorld . lWorld . projectiles . ix pjid . prjSpin .~ newSpin
  where
    pjid = _prjID pj
    dir = argV $ _prjVel pj
    newSpin = case w ^? cWorld . lWorld . creatures . ix cid of
        Just cr -> negate $ min 0.2 $ max (-0.2) $ normalizeAnglePi (dir - _crDir cr) / spinFactor
        _ -> 0
    spinFactor = 5 * (6 - fromIntegral i)

-- note this only allows YOU to remotely track projectiles
pjRemoteSetDirection :: ProjectileHoming -> Projectile -> World -> World
pjRemoteSetDirection ph pj w = case ph of
    NoHoming -> w
    HomeUsingRemoteScreen screenid ->
        let newdir
                | w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . imSelectedItem
                        == w ^? cWorld . lWorld . itemLocations . ix (_unNInt screenid) . ilInvID
                    = (w ^. wCam . camRot) + argV (_mousePos (_input w))
                | otherwise = _prjDir pj
        in w & cWorld . lWorld . projectiles . ix (_prjID pj) . prjAcc 
                .~ magV (_prjAcc pj) *.* unitVectorAtAngle newdir
    HomeUsingTargeting itid -> fromMaybe w $ do
        tp <- w ^? pointerToItemID itid . itUse . tgPos . _Just
        return $ w & cWorld . lWorld . projectiles . ix (_prjID pj) . prjAcc 
                %~ vecTurnTo 0.2 (_prjPos pj) tp
        
--pjRemoteSetDirection mscreenid pj w = fromMaybe w $ do
--    screenid <- fmap _unNInt mscreenid
--    let newdir
--            | w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . imSelectedItem
--                    == w ^? cWorld . lWorld . itemLocations . ix screenid . ilInvID
--                = (w ^. wCam . camRot) + argV (_mousePos (_input w))
--            | otherwise = _prjDir pj
--        turntonewdir = magV (_prjAcc pj) *.* unitVectorAtAngle newdir
--    return $ w & cWorld . lWorld . projectiles . ix (_prjID pj) . prjAcc .~ turntonewdir

reduceSpinBy :: Float -> Int -> World -> World
reduceSpinBy x pjid = cWorld . lWorld . projectiles . ix pjid . prjSpin *~ x

decTimMvVel :: Projectile -> World -> World
decTimMvVel pj =
    cWorld . lWorld . projectiles . ix pjid
        %~ ( (prjTimer -~ 1)
                . (prjPos %~ (+.+ vel))
                . (prjAcc %~ rotateV rot)
           )
  where
    rot = _prjSpin pj
    vel = _prjVel pj
    pjid = _prjID pj

explodeShell :: Maybe (NewInt ItmInt) -> Int -> World -> World
explodeShell mitid pjid w =
    w
        & cWorld . lWorld . projectiles . ix pjid . prjUpdates .~ [DestroyPU mitid 30]
        & cWorld . lWorld . projectiles . ix pjid . prjDraw .~ DrawBlankProjectile
--        & itPoint . itUse . heldUse .~ HeldDoNothing
--        & itPoint . itUse . heldMods .~ DoNothingMod
        & usePayload (_prjPayload thepj) (_prjPos thepj)
        & stopSoundFrom (ShellSound pjid)
  where
--    itPoint = pointerToItemLocation $ w ^?! cWorld . lWorld . itemLocations . ix itid-- _itemLocations (_cWorld w) IM.! itid
    thepj = w ^?! cWorld . lWorld . projectiles . ix pjid