131 lines
4.1 KiB
Haskell
131 lines
4.1 KiB
Haskell
{-# OPTIONS_GHC -Wno-unused-imports #-}
|
|
module Dodge.Projectile.Update where
|
|
import Dodge.Data
|
|
import Dodge.Payload
|
|
import Dodge.Reloading.Action
|
|
import Dodge.EnergyBall
|
|
import Dodge.Default.Weapon
|
|
import Dodge.Item.Location
|
|
import Dodge.SoundLogic.LoadSound
|
|
import Dodge.Item.Weapon.Shell
|
|
import Dodge.Item.Weapon.Remote
|
|
import Dodge.Item.Weapon.TriggerType
|
|
import Dodge.Movement.Turn
|
|
import Dodge.Base
|
|
import Dodge.Zone
|
|
import Dodge.SoundLogic
|
|
import Dodge.WorldEvent.Cloud
|
|
import RandomHelp
|
|
import Geometry
|
|
import qualified IntMapHelp as IM
|
|
|
|
import qualified Streaming.Prelude as S
|
|
--import qualified Data.Set as S
|
|
import qualified Data.Map.Strict as M
|
|
import qualified SDL
|
|
import Data.Maybe
|
|
import Control.Lens
|
|
|
|
|
|
updateProjectile :: Proj -> World -> World
|
|
updateProjectile pj = case pj of
|
|
Shell{} -> updateShell pj . decTimMvVel pj . upsProjectile pj
|
|
RemoteShell{} -> _prjUpdate pj pj
|
|
|
|
updateShell :: Proj -> World -> World
|
|
updateShell pj w
|
|
| time > 340 = if circOnSomeWall oldPos 4 w
|
|
then doExplode
|
|
else w
|
|
| anythingHitCirc 2 oldPos newPos w = doExplode
|
|
| time > 0 = w
|
|
| otherwise = doExplode
|
|
where
|
|
time = _prjTimer pj
|
|
doExplode = w
|
|
& usePayload (_prjPayload pj) oldPos
|
|
& stopSoundFrom (ShellSound i)
|
|
& projectiles %~ IM.delete i
|
|
i = _prjID pj
|
|
oldPos = _prjPos pj
|
|
vel = _prjVel pj
|
|
newPos = oldPos +.+ vel
|
|
|
|
upsProjectile :: Proj -> World -> World
|
|
upsProjectile pj w' = foldr (\pu -> upProjectile pu pj) w' (_prjUpdates pj)
|
|
|
|
upProjectile :: ProjectileUpdate -> Proj -> World -> World
|
|
upProjectile pu pj = case pu of
|
|
PJThrust st et
|
|
| act st et -> doThrust' pj
|
|
| otherwise -> id
|
|
PJSpin t cid spinamount
|
|
| ain t -> trySpinByCID' cid spinamount pj
|
|
| otherwise -> id
|
|
PJTrack st et itid
|
|
| act st et -> pjTrack' itid pj
|
|
| otherwise -> id
|
|
PJReduceSpin x -> reduceSpinBy' x pj
|
|
PJRemoteDirection st et cid itid
|
|
| act st et -> setRemoteDir cid itid pj
|
|
| otherwise -> id
|
|
PJSetScope itid -> setRemoteScope itid (_prjPos pj)
|
|
where
|
|
time = _prjTimer pj
|
|
act st et = time >= st && time <= et
|
|
ain t = time == t
|
|
|
|
setRemoteDir :: Int -> Int -> Proj -> World -> World
|
|
setRemoteDir cid itid pj w = w & projectiles . ix i . prjDir .~ newdir
|
|
where
|
|
i = _prjID pj
|
|
newdir
|
|
| SDL.ButtonRight `M.member` _mouseButtons w
|
|
&& w ^? creatures . ix cid . crInvSel . iselPos == w ^? itemPositions . ix itid . ipInvID
|
|
= _cameraRot w + argV (_mousePos w)
|
|
| otherwise = _prjDir pj
|
|
|
|
doThrust' :: Proj -> World -> World
|
|
doThrust' pj w = w
|
|
& randGen .~ g
|
|
& 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 (addZ 20 (oldPos +.+ r1 +.+ 30 *.* normalizeV (oldPos -.- newPos)))
|
|
where
|
|
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'
|
|
:: Int -- ^ creature id
|
|
-> Int -- ^ Spin amount
|
|
-> Proj
|
|
-> World
|
|
-> World
|
|
trySpinByCID' cid i pj w = w & projectiles . ix pjid . prjSpin .~ newSpin
|
|
where
|
|
pjid = _prjID pj
|
|
dir = argV $ _prjVel pj
|
|
newSpin = case w ^? creatures . ix cid of
|
|
Just cr -> negate $ min 0.2 $ max (-0.2) $ normalizeAnglePi (dir - _crDir cr) / spinFactor
|
|
_ -> 0
|
|
spinFactor = 5 * (6 - fromIntegral i)
|
|
|
|
pjTrack' :: Int -> Proj -> World -> World
|
|
pjTrack' itid pj w = rotateToTarget pj w
|
|
where
|
|
rotateToTarget _ = fromMaybe id $ do
|
|
tpos <- w ^? itPoint . itTargeting . tgPos . _Just
|
|
return $ projectiles . ix (_prjID pj) . prjSpin .~ turnToAmount 0.15 (_prjPos pj) tpos
|
|
(argV $ _prjAcc pj)
|
|
itPoint = pointToItem $ _itemPositions w IM.! itid
|
|
|
|
reduceSpinBy' :: Float -> Proj -> World -> World
|
|
reduceSpinBy' x pj = projectiles . ix (_prjID pj) . prjSpin *~ x
|