justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Move towards adding in pulse laser "rifle" (like UT shock rifle)

Browse Source
This commit is contained in:
justin
2025-07-25 09:12:04 +01:00
parent ff3699e6cb
commit 190068737d
17 changed files with 750 additions and 628 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Update.hs
+80 -43
View File
@@ -7,14 +7,6 @@ Description : Simulation update
-}
module Dodge.Update (updateUniverse) where
import Dodge.Item.Weapon.LaserPath
import Dodge.Cloud
import Dodge.Creature.Radius
import Dodge.Creature.Mass
import Dodge.Damage
import RandomHelp
import Dodge.Data.CrWlID
import Dodge.ListDisplayParams
import Color
import Control.Applicative
import Control.Monad
@@ -24,8 +16,13 @@ import Data.Maybe
import Data.Monoid
import Dodge.Base
import Dodge.Bullet
import Dodge.Cloud
import Dodge.CrGroupUpdate
import Dodge.Creature.Mass
import Dodge.Creature.Radius
import Dodge.Creature.Update
import Dodge.Damage
import Dodge.Data.CrWlID
import Dodge.Data.Universe
import Dodge.Debug
import Dodge.DisplayInventory
@@ -34,8 +31,10 @@ import Dodge.DrWdWd
import Dodge.EnergyBall
import Dodge.Flame
import Dodge.Inventory
import Dodge.Item.Weapon.LaserPath
import Dodge.Laser.Update
import Dodge.LinearShockwave.Update
import Dodge.ListDisplayParams
import Dodge.Machine.Update
import Dodge.Menu
import Dodge.ModificationEffect
@@ -62,12 +61,14 @@ import Dodge.Update.Scroll
import Dodge.Update.WallDamage
import Dodge.WallCreatureCollisions
import Dodge.WorldEffect
import Dodge.WorldEvent.ThingsHit
import Dodge.Zoning.Cloud
import Dodge.Zoning.Creature
import Geometry
import qualified IntMapHelp as IM
import LensHelp
import NewInt
import RandomHelp
import SDL
import Sound.Data
import StrictHelp
@@ -87,7 +88,7 @@ updateUniverseFirst :: Universe -> Universe
updateUniverseFirst u =
u
& uvWorld . input . clickWorldPos %~ M.union (setClickWorldPos u)
& uvWorld . input . smoothScrollAmount
& uvWorld . input . smoothScrollAmount
%~ calcSmoothScroll (u ^. uvWorld . input . scrollAmount)
& over (uvWorld . input) updateScrollTestValue
& updateDebugMessageOffset
@@ -159,15 +160,18 @@ updateUniverseLast u =
updateUniverseMid :: Universe -> Universe
updateUniverseMid u = case _uvScreenLayers u of
(OptionScreen{_scOptionFlag = LoadingScreen} : _) -> u
-- (sl@OptionScreen{_scOptionFlag = GameOverOptions} : _) -> u & updateUseInputOnScreen sl
-- (sl@OptionScreen{_scOptionFlag = GameOverOptions} : _) -> u & updateUseInputOnScreen sl
(sl : _) -> u & uvWorld . unpauseClock .~ 0 & updateUseInputOnScreen sl
[] ->
(uvWorld . unpauseClock +~ 1) .
timeFlowUpdate . updateUseInputInGame .
over
(uvWorld . unpauseClock +~ 1)
. timeFlowUpdate
. updateUseInputInGame
. over
uvWorld
(updateMouseInGame (u ^. uvConfig))
$ over uvWorld (updateCamera (u ^. uvConfig))
$ over
uvWorld
(updateCamera (u ^. uvConfig))
u
timeFlowUpdate :: Universe -> Universe
@@ -263,18 +267,23 @@ functionalUpdate u =
. over uvWorld (updateIMl' (_doors . _lWorld . _cWorld) updateDoor)
. over uvWorld doWorldEvents
. over uvWorld updateDelayedEvents
. over uvWorld (updateIMl (_modifications . _lWorld . _cWorld)
(doModificationEffect . _mdUpdate))
. over
uvWorld
( updateIMl
(_modifications . _lWorld . _cWorld)
(doModificationEffect . _mdUpdate)
)
. over uvWorld updateSparks
. over uvWorld updateRadarSweeps
. over uvWorld updateFlames
. over uvWorld updateShockwaves
. over uvWorld updateBullets
. over uvWorld updateEnergyBalls -- energybs can be created by bullets,
-- so should probably be updated before bullets
. over uvWorld updateEnergyBalls -- energybs can be created by bullets,
-- so should probably be updated before bullets
. over uvWorld updateRadarBlips
-- . over uvWorld updateBeams
. over uvWorld updateLasers
. over uvWorld (updateIMl' (_pulseBalls . _lWorld . _cWorld) updatePulseBall)
. over uvWorld updatePulseLasers
. over uvWorld updateTeslaArcs
. over uvWorld updateTractorBeams
@@ -292,7 +301,7 @@ functionalUpdate u =
. over (uvWorld . cWorld . lWorld . creatures) (fmap setOldPos)
. over uvWorld updateCreatureGroups
. over uvWorld updateWallDamages
-- . over uvWorld updateSeenWalls
-- . over uvWorld updateSeenWalls
. over uvWorld checkTermDist
. over uvWorld updateRBList
. over uvWorld updateCloseObjects
@@ -308,8 +317,9 @@ functionalUpdate u =
$ over uvWorld updatePastWorlds u
updateAimPos :: Universe -> Universe
updateAimPos u = u & uvWorld . cWorld . lWorld . lAimPos
.~ mouseWorldPos (u ^. uvWorld . input) (u ^. uvWorld . wCam)
updateAimPos u =
u & uvWorld . cWorld . lWorld . lAimPos
.~ mouseWorldPos (u ^. uvWorld . input) (u ^. uvWorld . wCam)
updateDoor :: Door -> World -> World
updateDoor dr = doDrWdWd (_drMech dr) dr
@@ -344,12 +354,12 @@ updateMouseContextGame cfig u = case u ^. uvWorld . input . mouseContext of
isrotatedrag = do
t1 <- w ^. input . mouseButtons . at ButtonLeft
t2 <- w ^. input . mouseButtons . at ButtonRight
guard $ t1 > t2
guard $ t1 > t2
return MouseGameRotate
aimcontext
-- | Just t1 <- w ^. input . mouseButtons . at ButtonLeft
-- , Just t2 <- w ^. input . mouseButtons . at ButtonRight
-- , t1 > t2 = MouseGameRotate
-- | Just t1 <- w ^. input . mouseButtons . at ButtonLeft
-- , Just t2 <- w ^. input . mouseButtons . at ButtonRight
-- , t1 > t2 = MouseGameRotate
| ButtonRight `M.member` (w ^. input . mouseButtons) = MouseAiming
| otherwise = MouseInGame
mpos = w ^. input . mousePos
@@ -427,9 +437,9 @@ advanceScrollAmount =
. (uvWorld . input . smoothScrollAmount %~ advanceSmoothScroll)
updatePastWorlds :: World -> World
updatePastWorlds w = w
& pastWorlds %~ (forceFoldable . take 100 . ((w ^. cWorld . lWorld) :))
updatePastWorlds w =
w
& pastWorlds %~ (forceFoldable . take 100 . ((w ^. cWorld . lWorld) :))
doWorldEvents :: World -> World
doWorldEvents w =
@@ -441,14 +451,39 @@ doWorldEvents w =
updateLasers :: World -> World
updateLasers w = w' & cWorld . lWorld . flares <>~ concat ls
where
(w', ls) = mapAccumR updateLaser
(w & cWorld . lWorld . lasers .~ [])
(w ^. cWorld . lWorld . lasers)
(w', ls) =
mapAccumR
updateLaser
(w & cWorld . lWorld . lasers .~ [])
(w ^. cWorld . lWorld . lasers)
updatePulseLasers :: World -> World
updatePulseLasers w = f w & cWorld . lWorld . pulseLasers .~ pzs
where
(Endo f, pzs) = foldMap updatePulseLaser (w ^. cWorld . lWorld . pulseLasers)
(Endo f, pzs) = foldMap updatePulseLaser (w ^. cWorld . lWorld . pulseLasers)
updatePulseBall :: PulseBall -> World -> World
updatePulseBall pb w
| Just (_, ecrwl) <- thit =
w & cWorld . lWorld . pulseBalls . at (pb ^. pbID) .~ Nothing
| pb ^. pbTimer <= 0 =
w & cWorld . lWorld . pulseBalls . at (pb ^. pbID) .~ Nothing
| otherwise =
w
& cWorld . lWorld . pulseBalls . ix (pb ^. pbID) . pbTimer -~ 1
& cWorld . lWorld . pulseBalls . ix (pb ^. pbID) . pbPos .~ ep
& pbFlicker pb
where
sp = pb ^. pbPos
ep = sp + pb ^. pbVel
thit = thingHit sp ep w
pbFlicker :: PulseBall -> World -> World
pbFlicker pt =
cWorld . lWorld . lights
.:~ LSParam (addZ 5 $ _pbPos pt) d (0.5 * xyzV4 chartreuse)
where
d = 4 * fromIntegral (10 + abs ((_pbTimer pt `mod` 20) - 10))
zoneClouds :: World -> World
zoneClouds w = w & clZoning .~ foldl' (flip zoneCloud) mempty (w ^. cWorld . lWorld . clouds)
@@ -594,21 +629,23 @@ updateTeslaArc w pt
updatePulseLaser :: PulseLaser -> (Endo World, [PulseLaser])
updatePulseLaser pz = case pz ^. pzTimer of
i | i <= 0 -> (Endo id,[])
5 -> (Endo f,[pz & pzTimer -~ 1])
_ -> (Endo g,[pz & pzTimer -~ 1])
where
f w = damThingHitWith
(\p2 -> Lasering (pz ^. pzDamage) p2 (xp - sp))
thHit w
& cWorld . lWorld . flares <>~ drawLaser cyan (sp: ps)
i | i <= 0 -> (Endo id, [])
5 -> (Endo f, [pz & pzTimer -~ 1])
_ -> (Endo g, [pz & pzTimer -~ 1])
where
f w =
damThingHitWith
(\p2 -> Lasering (pz ^. pzDamage) p2 (xp - sp))
thHit
w
& cWorld . lWorld . flares <>~ drawLaser cyan (sp : ps)
where
(thHit, ps) = reflectLaserAlong phasev sp xp w
phasev = _pzPhaseV pz
sp = _pzPos pz
dir = _pzDir pz
xp = sp +.+ 800 *.* unitVectorAtAngle dir
g w = w & cWorld . lWorld . flares <>~ drawLaser cyan (sp: ps)
g w = w & cWorld . lWorld . flares <>~ drawLaser cyan (sp : ps)
where
(_, ps) = reflectLaserAlong phasev sp xp w
@@ -620,7 +657,6 @@ randWallReflect a wl = randPeaked a1 outa a2
a1 = nearestAngleRep outa $ argV (x - y)
a2 = if a1 < outa then a1 + pi else a1 - pi
updateTractorBeams :: World -> World
updateTractorBeams = updateObjCatMaybes tractorBeams updateTractorBeam
@@ -818,7 +854,8 @@ clClSpringVel a v b
pa = _clPos a
pb = _clPos b
radDist = 10
--radDist = (_clRad a + _clRad b) / 2
--radDist = (_clRad a + _clRad b) / 2
dustSpringVel :: Dust -> Point3 -> Dust -> Point3
dustSpringVel a v b