loop/src/Dodge/Projectile/Update.hs

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

import Control.Monad
import Data.Foldable
import Data.List (delete)
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 LensHelp
import NewInt
import RandomHelp

updateProjectile :: Projectile -> World -> World
updateProjectile pj w = 
    decTimMvVel pj .
        shellCollisionCheck
            pj $
    foldl' (flip $ upProjectile pj) w (_pjUpdates pj)

upProjectile :: Projectile -> ProjectileUpdate -> World -> World
upProjectile pj pu = case pu of
--    TimePU -> decTimMvVel pj
    ThrustPU st et
        | act st et -> doThrust pj (pj ^? pjType . rkSmoke . _Just)
        | otherwise -> id
    StartSpinPU t cid spinamount
        | time == t -> trySpinByCID cid spinamount pj
        | otherwise -> id
    RemoteDirectionPU st et
        | act st et -> pjRemoteSetDirection (pj ^? pjType . rkHoming) pj
        | otherwise -> id
    ReduceSpinPU x -> reduceSpinBy x (_pjID pj)
--    DestroyPU mitid 0 -> destroyProjectile mitid (_pjID pj)
    -- the following requires that this is at the top of the update list, which is
    -- not ideal
--    DestroyPU _ _ -> cWorld . lWorld . projectiles . ix (_pjID pj) . pjUpdates . ix 0 . pjuTimer -~ 1
    ApplyGravityPU -> applyGravityPU pj
  where
    time = _pjTimer pj
    act st et = time <= st && time >= et

applyGravityPU :: Projectile -> World -> World
applyGravityPU pj w
    | newz <= 0 && abs (pj ^. pjZVel) < 1 =
        w
            & topj . pjVel %~ decvel
            & topj . pjSpin %~ decspin
    | newz < 0 =
        w & topj . pjZ .~ 0
            & topj . pjZVel %~ bouncez
            & topj . pjVel %~ decvel
            & topj . pjSpin %~ decspin
            & soundStart (ShellSound (pj ^. pjID)) (pj ^. pjPos) click1S Nothing
    | otherwise =
        w & topj . pjZ .~ newz
            & topj . pjZVel -~ 0.5
  where
    topj = cWorld . lWorld . projectiles . ix (pj ^. pjID)
    bouncez z
        | z < -1 = -0.5 * z
        | otherwise = 0
    decvel v
        | magV v > 1 = rotateV (5 * pj ^. pjSpin) $ 0.8 * v
        | otherwise = 0
    decspin x
        | abs x < 0.01 = 0
        | otherwise = x * 0.9
    newz = pj ^. pjZ + pj ^. pjZVel

-- consider using thingHit, pushing any hit creature back
shellCollisionCheck ::
    Projectile ->
    World ->
    World
shellCollisionCheck pj w
    | RetiredProjectile <- pj ^. pjType 
    , time <= -30 
        = destroyProjectile (pj ^. pjScreenID) (_pjID pj) w
    | RetiredProjectile <- pj ^. pjType = w
    | anythingHitCirc 2 oldPos (oldPos + _pjVel pj) w = g
    | time <= 0 = g
    | otherwise = w
  where
    g = explodeShell pj w
    time = _pjTimer pj
    oldPos = _pjPos 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 -> Maybe RocketSmoke -> World -> World
doThrust pj smoke w =
    w
        & randGen .~ g
        & cWorld . lWorld . projectiles . ix i . pjVel %~ (\v -> accel +.+ frict *.* v)
        & soundContinue (ShellSound i) newPos missileLaunchS (Just 1)
--        & makeFlamelet (oldPos -.- vel) (vel + 2 * rotateV (pi + sparkD) accel) 3 10
        & makeFlamelet (oldPos -.- vel) (vel +.+ rotateV (pi + sparkD) accel) 3 10
        & shellTrailCloud
            lifetime
            trailfadetime
            (addZ 20 (oldPos +.+ r1 +.+ 30 *.* normalizeV (oldPos -.- newPos)))
  where
    lifetime = fst . randomR lt $ _randGen w
    lt
        | smoke == Just ReducedRocketSmoke = (50, 200)
        | otherwise = (300, 500)
    trailfadetime = fst . randomR (100, 300) $ _randGen w
    accel = rotateV (pj ^. pjDir) (V2 3 0)
    i = _pjID pj
    oldPos = _pjPos pj
    vel = _pjVel 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 . pjSpin .~ newSpin
  where
    pjid = _pjID pj
    dir = argV $ _pjVel 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 :: Maybe RocketHoming -> Projectile -> World -> World
pjRemoteSetDirection ph pj w = case ph of
    Just (HomeUsingRemoteScreen screenid)
        | lw ^? creatures . ix 0 . crManipulation . manObject . imSelectedItem
            == lw ^? itemLocations . ix (_unNInt screenid) . ilInvID ->
            w & cWorld . lWorld . projectiles . ix (_pjID pj) . pjDir
                .~ (w ^. wCam . camRot) + argV (w ^. input . mousePos)
    Just (HomeUsingTargeting itid)
        | Just tp <- w ^? pointerToItemID itid . itTargeting . itTgPos . _Just ->
            w & cWorld . lWorld . projectiles . ix (_pjID pj) . pjDir
                %~ turnTo 0.2 (_pjPos pj) tp
    _ -> w
  where
    lw = w ^. cWorld . lWorld

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

decTimMvVel :: Projectile -> World -> World
decTimMvVel pj =
    cWorld . lWorld . projectiles . ix (_pjID pj)
        %~ ( (pjTimer -~ 1)
                . (pjPos +~ _pjVel pj)
                . (pjDir +~ _pjSpin pj)
           )

explodeShell ::
    Projectile ->
    World ->
    World
explodeShell pj w =
    w
        & cWorld . lWorld . projectiles . ix pjid . pjUpdates .~ []
        & cWorld . lWorld . projectiles . ix pjid . pjType .~ RetiredProjectile
        & usePayload (_pjPayload pj) (_pjPos pj) (_pjVel pj)
        & stopSoundFrom (ShellSound pjid)
        & updatedetonator
  where
    updatedetonator = fromMaybe id $ do
        detid <- pj ^. pjDetonatorID
        return $ pointerToItemID detid . itUse . uaParams . apProjectiles %~ delete pjid
    pjid = pj ^. pjID