loop/src/Dodge/Projectile/Update.hs

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

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

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

--shellCollisionCheck :: (Projectile -> World -> World) -> Projectile -> World -> World
shellCollisionCheck :: Maybe (NewInt ItmInt) -> Projectile -> World -> World
shellCollisionCheck f pj w
    | time > 330 && circOnSomeWall oldPos 4 w = g
    | time <= 330 && anythingHitCirc 2 oldPos newPos w = g
    | time <= 0 = g
    | otherwise = w
  where
    g = explodeShell f pj w
    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 . uaParams . apLinkedProjectile . _Just
        guard $ itm == pjid
        return $ pointerToItemLocation loc . itUse . uaParams . apLinkedProjectile .~ 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) (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 . itTargeting . itTgPos . _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) -> Projectile -> World -> World
explodeShell mitid pj w =
    w
        & cWorld . lWorld . projectiles . ix pjid . prjUpdates .~ [DestroyPU mitid 30]
        & cWorld . lWorld . projectiles . ix pjid . prjDraw .~ DrawBlankProjectile
        & usePayload (_prjPayload pj) (_prjPos pj) (_prjVel pj)
        & stopSoundFrom (ShellSound pjid)
  where
    pjid = pj ^. prjID