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

This commit is contained in:
2025-07-25 09:12:04 +01:00
parent ff3699e6cb
commit 190068737d
17 changed files with 750 additions and 628 deletions
+1 -1
View File
@@ -6,7 +6,7 @@ module Dodge.BaseTriggerType (
module Dodge.Data.TriggerType,
) where
import Dodge.PulseLaser
import Dodge.IsPulseLaser
import Dodge.Data.ComposedItem
import Dodge.Data.DoubleTree
import Control.Lens
+7 -9
View File
@@ -23,20 +23,12 @@ useItem invid pt w = fmap (worldEventFlags . at InventoryChange ?~ ()) $ do
useItemLoc :: Creature -> LocationDT OItem -> PressType -> World -> Maybe World
useItemLoc cr loc pt w
| HeldPlatformSF <- sf
, fromMaybe False $ loc ^? locDT . dtValue . _1 . itLocation . ilIsAttached
, Aiming{} <- cr ^. crStance . posture =
return $ gadgetEffect pt loc cr w
| LaserWeaponSF <- sf
| aimuse
, fromMaybe False $ loc ^? locDT . dtValue . _1 . itLocation . ilIsAttached
, Aiming{} <- cr ^. crStance . posture =
return $ gadgetEffect pt loc cr w
| GadgetPlatformSF <- sf =
return $ gadgetEffect pt loc cr w
| UnderBarrelPlatformSF <- sf
, fromMaybe False $ loc ^? locDT . dtValue . _1 . itLocation . ilIsAttached
, Aiming{} <- cr ^. crStance . posture =
return $ gadgetEffect pt loc cr w
| RemoteDetonatorSF <- sf
, pt == InitialPress =
return $ activateDetonator ldt w
@@ -55,6 +47,12 @@ useItemLoc cr loc pt w
return $ toggleEquipmentAt invid' cr w
| otherwise = (\loc' -> useItemLoc cr loc' pt w) =<< locUp' loc
where
aimuse
| LaserWeaponSF <- sf = True
| HeldPlatformSF <- sf = True
| PulseBallSF <- sf = True
| UnderBarrelPlatformSF <- sf = True
| otherwise = False
sf = loc ^. locDT . dtValue . _2
ldt = loc ^. locDT
itm = ldt ^. dtValue . _1
+1
View File
@@ -39,6 +39,7 @@ data ItemSF -- Structural Function
| MapperSF
| LaserWeaponSF
| CapacitorSF
| PulseBallSF
deriving (Eq, Ord, Show, Read)
type CItem = (Item, ItemSF)
+1
View File
@@ -117,6 +117,7 @@ data LWorld = LWorld
, _shockwaves :: [Shockwave]
, _lasers :: [Laser]
, _pulseLasers :: [PulseLaser]
, _pulseBalls :: IM.IntMap PulseBall
, _linearShockwaves :: IM.IntMap LinearShockwave
, _tractorBeams :: [TractorBeam]
, _walls :: IM.IntMap Wall
+3
View File
@@ -21,8 +21,11 @@ data PulseBall = PulseBall
{ _pbVel :: Point2
, _pbPos :: Point2
, _pbTimer :: Int
, _pbID :: Int
}
deriving (Eq, Ord, Show, Read) --Generic, Flat)
makeLenses ''PulseLaser
makeLenses ''PulseBall
deriveJSON defaultOptions ''PulseLaser
deriveJSON defaultOptions ''PulseBall
+1
View File
@@ -38,6 +38,7 @@ data SoundOrigin
| Tap Int
| EBSound Int
| DamageHitSound Int
| PBSound Int
deriving (Eq, Ord, Show, Read) --Generic, Flat)
+1
View File
@@ -119,6 +119,7 @@ defaultLWorld =
, _shockwaves = []
, _lasers = []
, _pulseLasers = mempty
, _pulseBalls = mempty
, _tractorBeams = mempty
, _linearShockwaves = mempty
, _walls = IM.empty
+35 -3
View File
@@ -8,11 +8,11 @@ module Dodge.HeldUse (
heldEffectMuzzles,
) where
import Dodge.PulseLaser
import qualified IntMapHelp as IM
import Dodge.IsPulseLaser
import Color
import Control.Applicative
import Control.Monad
import qualified Data.IntMap.Strict as IM
import Data.Maybe
import Dodge.Base
import Dodge.BaseTriggerType
@@ -53,8 +53,12 @@ gadgetEffect pt loc
| CLICKER x <- loc ^. locDT . dtValue . _1 . itType
, Just i <- loc ^? locDT . dtValue . _1 . itUse . uInt =
useInventoryPath pt i x loc
| PulseBallSF <- loc ^. locDT . dtValue . _2 = \cr
-> creatureShootPulseBall loc cr cmuz
| otherwise = const id
cmuz = Muzzle (V2 15 0) 0 0.01 0 BasicFlare MuzzleShootBullet (UseExactly 1) 0
heldEffect :: PressType -> LocationDT OItem -> Creature -> World -> World
heldEffect = hammerCheck heldEffectMuzzles
@@ -731,7 +735,7 @@ useLoadedAmmo loc cr (_, w) (Just (mz, x, magtree)) = (,) True $
removeAmmoFromMag x mid cr . makeMuzzleFlare mz loc cr $ case _mzEffect mz of
MuzzleShootBullet -> shootBullets loc cr (mz, x, magtree) w
MuzzleLaser -> creatureShootLaser loc cr mz w
MuzzlePulseLaser -> creatureShootPulseLaser loc cr mz w
MuzzlePulseLaser -> creatureShootPulseBall loc cr mz w
MuzzleTesla -> shootTeslaArc loc cr mz w
MuzzleTractor -> shootTractorBeam cr w
MuzzleRLauncher -> createProjectileR loc magtree mz cr w
@@ -900,6 +904,34 @@ shootPulseLaser so p dir w =
}
& soundContinue so p tone440sawtoothquietS (Just 2)
creatureShootPulseBall :: LocationDT OItem -> Creature -> Muzzle -> World -> World
creatureShootPulseBall loc cr mz w = w & randGen .~ g & shootPulseBall pos dir
where
(V3 x y _, q) =
locOrient loc cr
`Q.comp` ((_mzPos mz + V2 0 offset) `v2z` 0, Q.axisAngle (V3 0 0 1) (_mzRot mz))
pos = _crPos cr + rotateV (_crDir cr) (V2 x y)
dir = _crDir cr + Q.qToAng q + a
(a, g) = randomR (- inacc, inacc) $ _randGen w
inacc = _mzInaccuracy mz
offset = case mz ^. mzRandomOffset of
0 -> 0
i -> fst . randomR (- i, i) $ _randGen w
shootPulseBall :: Point2 -> Float -> World -> World
shootPulseBall p dir w =
w
& cWorld . lWorld . pulseBalls . at i ?~
PulseBall
{ _pbPos = p
, _pbVel = 5 * unitVectorAtAngle dir
, _pbTimer = 50
, _pbID = i
}
& soundStart (PBSound i) p energyReleaseS Nothing
where
i = IM.newKey $ w ^. cWorld . lWorld . pulseBalls
removeAmmoFromMag :: Int -> Maybe Int -> Creature -> World -> World
removeAmmoFromMag x mid cr = fromMaybe id $ do
magid <- mid
+19
View File
@@ -0,0 +1,19 @@
module Dodge.IsPulseLaser (
isPulseLaser,
isPulseCapacitor,
) where
import Control.Lens
import Dodge.Data.ComposedItem
import Dodge.Data.DoubleTree
import Dodge.Data.Item
isPulseLaser :: LocationDT OItem -> Bool
isPulseLaser loc =
loc ^. locDT . dtValue . _1 . itType == HELD LASER
&& (loc ^? locDT . dtLeft . ix 0 . dtValue . _1 . itType == Just (CRAFT CAPACITOR))
isPulseCapacitor :: LocationDT OItem -> Bool
isPulseCapacitor loc =
loc ^. locDT . dtValue . _1 . itType == HELD LASER
&& (loc ^? locDT . dtLeft . ix 0 . dtValue . _1 . itType == Just (CRAFT CAPACITOR))
+2 -1
View File
@@ -47,7 +47,7 @@ itemAboveAttachables (itm,sf) = case (itm ^. itType, sf) of
itemBelowAttachables :: CItem -> [ItemSF]
itemBelowAttachables (itm,sf) = case (itm ^. itType, sf) of
(HELD LASER, _) -> getAmmoLinks itm <> [CapacitorSF]
(HELD LASER, _) -> getAmmoLinks itm <> [PulseBallSF]
(HELD TORCH, _) -> getAmmoLinks itm
(ATTACH UNDERBARRELSLOT, _) -> [UnderBarrelPlatformSF]
(_, HeldPlatformSF) -> getAmmoLinks itm <> extraWeaponLinksBelow itm
@@ -142,6 +142,7 @@ treeToPotentialFunction ldt = case ldt ^. dtValue . _1 . itType of
HELD LASER -> S.fromList [WeaponTargetingSF,LaserWeaponSF]
-- following limits items to ten ammo slots
_ | AmmoMagSF _ x <- ldt ^. dtValue . _2 -> S.fromList [AmmoMagSF i x | i <- [0..9]]
CRAFT CAPACITOR -> S.fromList [CapacitorSF,PulseBallSF]
_ -> S.singleton (ldt ^. dtValue . _2)
baseCI :: Item -> CItem
+1
View File
@@ -37,6 +37,7 @@ itemInvColor ci = case ci ^. _2 of
UnderBarrelSlotSF -> white
LaserWeaponSF -> white
CapacitorSF -> yellow
PulseBallSF -> white
--ammoTypeColor :: AmmoType -> Color
--ammoTypeColor = \case
+1 -4
View File
@@ -82,10 +82,7 @@ applyGravityPU pj w
newz = pj ^. pjZ + pj ^. pjZVel
-- consider pushing any hit creature back
shellCollisionCheck ::
Projectile ->
World ->
World
shellCollisionCheck :: Projectile -> World -> World
shellCollisionCheck pj w
| RetiredProjectile <- pj ^. pjType
, time <= 0 =
+9
View File
@@ -23,6 +23,7 @@ worldSPic cfig u =
(mempty :!: extraPics cfig u)
<> foldup propSPic (filtOn _prPos _props)
<> foldup drawProjectile (filtOn _pjPos _projectiles)
<> foldup drawPulseBall (filtOn _pbPos _pulseBalls)
<> foldup (shiftDraw _blPos _blDir (drawBlock . _blDraw)) (filtOn _blPos _blocks)
<> foldup (shiftDraw _fsPos _fsDir (const _fsSPic)) (filtOn _fsPos _foregroundShapes)
<> foldup (shiftDraw' _cpPos _cpDir _cpSPic) (filtOn _cpPos _corpses)
@@ -36,6 +37,14 @@ worldSPic cfig u =
filtOn f g = IM.filter (pointIsClose . f) (g (_lWorld (_cWorld w)))
pointIsClose = cullPoint cfig w
drawPulseBall :: PulseBall -> SPic
drawPulseBall pb =
translateSPz 20
. uncurryV translateSPxy (pb ^. pbPos)
. noShape
. setLayer BloomLayer
$ circleSolidCol green white 10
drawCreature :: Creature -> SPic
drawCreature cr = uncurryV translateSPxy (_crPos cr) . rotateSP (_crDir cr) $
case cr ^. crType of
+195 -190
View File
@@ -1,4 +1,4 @@
-- generated at 2025-06-26 07:04:16.343678574 UTC
-- generated at 2025-07-24 21:27:39.778553009 UTC
module Dodge.SoundLogic.ExternallyGeneratedSounds where
import Sound.Data
soundToVol :: SoundID -> Float
@@ -77,72 +77,73 @@ soundToVol v = case _getSoundID v of
71 -> 40
72 -> 2000
73 -> 100
74 -> 500
75 -> 40
76 -> 100
77 -> 300
74 -> 250
75 -> 500
76 -> 40
77 -> 100
78 -> 300
79 -> 100
80 -> 2000
81 -> 1000
79 -> 300
80 -> 100
81 -> 2000
82 -> 1000
83 -> 1000
84 -> 100
84 -> 1000
85 -> 100
86 -> 1000
86 -> 100
87 -> 1000
88 -> 40
89 -> 50
90 -> 1000
91 -> 500
88 -> 1000
89 -> 40
90 -> 50
91 -> 1000
92 -> 500
93 -> 100
93 -> 500
94 -> 100
95 -> 1000
96 -> 20
97 -> 500
98 -> 300
99 -> 200
100 -> 500
101 -> 1000
102 -> 200
103 -> 1000
104 -> 2000
105 -> 500
106 -> 200
107 -> 100
108 -> 1000
109 -> 300
110 -> 2000
95 -> 100
96 -> 1000
97 -> 20
98 -> 500
99 -> 300
100 -> 200
101 -> 500
102 -> 1000
103 -> 200
104 -> 1000
105 -> 2000
106 -> 500
107 -> 200
108 -> 100
109 -> 1000
110 -> 300
111 -> 2000
112 -> 100
113 -> 500
114 -> 2000
115 -> 500
116 -> 100
117 -> 300
118 -> 1000
119 -> 200
120 -> 100
121 -> 200
122 -> 1000
123 -> 2000
124 -> 200
125 -> 1000
126 -> 100
127 -> 200
128 -> 500
129 -> 100
130 -> 2000
131 -> 200
132 -> 300
133 -> 1000
134 -> 2000
112 -> 2000
113 -> 100
114 -> 500
115 -> 2000
116 -> 500
117 -> 100
118 -> 300
119 -> 1000
120 -> 200
121 -> 100
122 -> 200
123 -> 1000
124 -> 2000
125 -> 200
126 -> 1000
127 -> 100
128 -> 200
129 -> 500
130 -> 100
131 -> 2000
132 -> 200
133 -> 300
134 -> 1000
135 -> 2000
136 -> 250
137 -> 200
138 -> 100
139 -> 200
136 -> 2000
137 -> 250
138 -> 200
139 -> 100
140 -> 200
_ -> 50
soundToOnomato :: SoundID -> String
soundToOnomato v = case _getSoundID v of
@@ -220,72 +221,73 @@ soundToOnomato v = case _getSoundID v of
71 -> "TIPTOP"
72 -> "CRUH"
73 -> "CHNKCHNKCHUNK"
74 -> "CLKCLK"
75 -> "TIPTAP"
76 -> "SKWLCH"
77 -> "TNKTNKTNK"
78 -> "CHPCHPCHP"
79 -> "SLP"
80 -> "SCREE"
81 -> "DHDHL"
82 -> "BRAP"
83 -> "CRSK"
84 -> "SPLRT"
85 -> "SKWLL"
86 -> "CRNKL"
87 -> "TRNKL"
88 -> "TAPP"
89 -> "SHUHP"
90 -> "CRUMBL"
91 -> "DEDEDUM"
92 -> "TAK"
93 -> "SPLRT"
94 -> "SQLEE"
95 -> "CRISH"
96 -> "SWSH"
97 -> "BIPBIPBIP"
98 -> "BEP"
99 -> "CRSKRL"
100 -> "KRTNKL"
101 -> "CRSNK"
102 -> "SHTCK"
103 -> "TTRKL"
104 -> "UGGAUGGA"
105 -> "DUDURAH"
106 -> "TING"
107 -> "KKSQWL"
108 -> "CRMPL"
109 -> "BWEP"
110 -> "CHUGUGUG"
111 -> "BANG"
112 -> "SLPP"
113 -> "DEDA"
114 -> "WHSSH"
115 -> "CLANG"
116 -> "HNH"
117 -> "BWAH"
118 -> "CRUNK"
119 -> "SQWLTCH"
120 -> "DRR"
121 -> "WHH"
122 -> "TRNKL"
123 -> "BRAP"
124 -> "WHR"
125 -> "BLPCHCH"
126 -> "SKLE"
127 -> "ZMM"
128 -> "WRRR"
129 -> "FWUMP"
130 -> "BRAHCHCH"
131 -> "TING"
132 -> "WHRR"
133 -> "BWMP"
134 -> "BRPBRPBRP"
135 -> "WE-OH"
136 -> "WHRHH"
137 -> "THCK"
138 -> "FHP"
139 -> "QWLPH"
74 -> "DMP"
75 -> "CLKCLK"
76 -> "TIPTAP"
77 -> "SKWLCH"
78 -> "TNKTNKTNK"
79 -> "CHPCHPCHP"
80 -> "SLP"
81 -> "SCREE"
82 -> "DHDHL"
83 -> "BRAP"
84 -> "CRSK"
85 -> "SPLRT"
86 -> "SKWLL"
87 -> "CRNKL"
88 -> "TRNKL"
89 -> "TAPP"
90 -> "SHUHP"
91 -> "CRUMBL"
92 -> "DEDEDUM"
93 -> "TAK"
94 -> "SPLRT"
95 -> "SQLEE"
96 -> "CRISH"
97 -> "SWSH"
98 -> "BIPBIPBIP"
99 -> "BEP"
100 -> "CRSKRL"
101 -> "KRTNKL"
102 -> "CRSNK"
103 -> "SHTCK"
104 -> "TTRKL"
105 -> "UGGAUGGA"
106 -> "DUDURAH"
107 -> "TING"
108 -> "KKSQWL"
109 -> "CRMPL"
110 -> "BWEP"
111 -> "CHUGUGUG"
112 -> "BANG"
113 -> "SLPP"
114 -> "DEDA"
115 -> "WHSSH"
116 -> "CLANG"
117 -> "HNH"
118 -> "BWAH"
119 -> "CRUNK"
120 -> "SQWLTCH"
121 -> "DRR"
122 -> "WHH"
123 -> "TRNKL"
124 -> "BRAP"
125 -> "WHR"
126 -> "BLPCHCH"
127 -> "SKLE"
128 -> "ZMM"
129 -> "WRRR"
130 -> "FWUMP"
131 -> "BRAHCHCH"
132 -> "TING"
133 -> "WHRR"
134 -> "BWMP"
135 -> "BRPBRPBRP"
136 -> "WE-OH"
137 -> "WHRHH"
138 -> "THCK"
139 -> "FHP"
140 -> "QWLPH"
_ -> error "unitialised sound"
soundPathList :: [String]
soundPathList =
@@ -363,6 +365,7 @@ soundPathList =
, "twoStepSlow.TIPTOP.40.wav"
, "seagullCry.CRUH.2000.wav"
, "crankSlow.CHNKCHNKCHUNK.100.wav"
, "energyRelease.DMP.250.wav"
, "prime.CLKCLK.500.wav"
, "twoStep.TIPTAP.40.wav"
, "bloodShort8.SKWLCH.100.wav"
@@ -578,135 +581,137 @@ seagullCryS :: SoundID
seagullCryS = SoundID 72
crankSlowS :: SoundID
crankSlowS = SoundID 73
energyReleaseS :: SoundID
energyReleaseS = SoundID 74
primeS :: SoundID
primeS = SoundID 74
primeS = SoundID 75
twoStepS :: SoundID
twoStepS = SoundID 75
twoStepS = SoundID 76
bloodShort8S :: SoundID
bloodShort8S = SoundID 76
bloodShort8S = SoundID 77
reloadS :: SoundID
reloadS = SoundID 77
reloadS = SoundID 78
reload1S :: SoundID
reload1S = SoundID 78
reload1S = SoundID 79
slapS :: SoundID
slapS = SoundID 79
slapS = SoundID 80
tone440sawtoothS :: SoundID
tone440sawtoothS = SoundID 80
tone440sawtoothS = SoundID 81
metal3S :: SoundID
metal3S = SoundID 81
metal3S = SoundID 82
tap3S :: SoundID
tap3S = SoundID 82
tap3S = SoundID 83
glassShat4S :: SoundID
glassShat4S = SoundID 83
glassShat4S = SoundID 84
bloodShort1S :: SoundID
bloodShort1S = SoundID 84
bloodShort1S = SoundID 85
bloodShort4S :: SoundID
bloodShort4S = SoundID 85
bloodShort4S = SoundID 86
glassShat2S :: SoundID
glassShat2S = SoundID 86
glassShat2S = SoundID 87
metal1S :: SoundID
metal1S = SoundID 87
metal1S = SoundID 88
foot3S :: SoundID
foot3S = SoundID 88
foot3S = SoundID 89
pickUpS :: SoundID
pickUpS = SoundID 89
pickUpS = SoundID 90
stone5S :: SoundID
stone5S = SoundID 90
stone5S = SoundID 91
dededumS :: SoundID
dededumS = SoundID 91
dededumS = SoundID 92
tap1S :: SoundID
tap1S = SoundID 92
tap1S = SoundID 93
blood1S :: SoundID
blood1S = SoundID 93
blood1S = SoundID 94
bloodShort7S :: SoundID
bloodShort7S = SoundID 94
bloodShort7S = SoundID 95
metal4S :: SoundID
metal4S = SoundID 95
metal4S = SoundID 96
knifeS :: SoundID
knifeS = SoundID 96
knifeS = SoundID 97
computerBeepingS :: SoundID
computerBeepingS = SoundID 97
computerBeepingS = SoundID 98
tone440S :: SoundID
tone440S = SoundID 98
tone440S = SoundID 99
gut6S :: SoundID
gut6S = SoundID 99
gut6S = SoundID 100
smallGlass2S :: SoundID
smallGlass2S = SoundID 100
smallGlass2S = SoundID 101
glassShat1S :: SoundID
glassShat1S = SoundID 101
glassShat1S = SoundID 102
disconnectItemS :: SoundID
disconnectItemS = SoundID 102
disconnectItemS = SoundID 103
metal5S :: SoundID
metal5S = SoundID 103
metal5S = SoundID 104
seagullBarkTransformedS :: SoundID
seagullBarkTransformedS = SoundID 104
seagullBarkTransformedS = SoundID 105
ejectS :: SoundID
ejectS = SoundID 105
ejectS = SoundID 106
ting3S :: SoundID
ting3S = SoundID 106
ting3S = SoundID 107
blood3S :: SoundID
blood3S = SoundID 107
blood3S = SoundID 108
stone2S :: SoundID
stone2S = SoundID 108
stone2S = SoundID 109
tone440raiseS :: SoundID
tone440raiseS = SoundID 109
tone440raiseS = SoundID 110
seagullChatter1S :: SoundID
seagullChatter1S = SoundID 110
seagullChatter1S = SoundID 111
bangS :: SoundID
bangS = SoundID 111
bangS = SoundID 112
slap1S :: SoundID
slap1S = SoundID 112
slap1S = SoundID 113
dedaS :: SoundID
dedaS = SoundID 113
dedaS = SoundID 114
missileLaunchS :: SoundID
missileLaunchS = SoundID 114
missileLaunchS = SoundID 115
clang2S :: SoundID
clang2S = SoundID 115
clang2S = SoundID 116
gruntS :: SoundID
gruntS = SoundID 116
gruntS = SoundID 117
sineRaisePitchOneSecS :: SoundID
sineRaisePitchOneSecS = SoundID 117
sineRaisePitchOneSecS = SoundID 118
metal2S :: SoundID
metal2S = SoundID 118
metal2S = SoundID 119
gut5S :: SoundID
gut5S = SoundID 119
gut5S = SoundID 120
slideDoorS :: SoundID
slideDoorS = SoundID 120
slideDoorS = SoundID 121
whirdown2S :: SoundID
whirdown2S = SoundID 121
whirdown2S = SoundID 122
metal6S :: SoundID
metal6S = SoundID 122
metal6S = SoundID 123
autoGunS :: SoundID
autoGunS = SoundID 123
autoGunS = SoundID 124
whirdownSmall1S :: SoundID
whirdownSmall1S = SoundID 124
whirdownSmall1S = SoundID 125
oldMachineBootS :: SoundID
oldMachineBootS = SoundID 125
oldMachineBootS = SoundID 126
blood6S :: SoundID
blood6S = SoundID 126
blood6S = SoundID 127
buzzS :: SoundID
buzzS = SoundID 127
buzzS = SoundID 128
fireLoudS :: SoundID
fireLoudS = SoundID 128
fireLoudS = SoundID 129
tap4S :: SoundID
tap4S = SoundID 129
tap4S = SoundID 130
shotgunS :: SoundID
shotgunS = SoundID 130
shotgunS = SoundID 131
ting5S :: SoundID
ting5S = SoundID 131
ting5S = SoundID 132
whirS :: SoundID
whirS = SoundID 132
whirS = SoundID 133
sawtoothFailS :: SoundID
sawtoothFailS = SoundID 133
sawtoothFailS = SoundID 134
miniS :: SoundID
miniS = SoundID 134
miniS = SoundID 135
seagullWhistleS :: SoundID
seagullWhistleS = SoundID 135
seagullWhistleS = SoundID 136
whirdownS :: SoundID
whirdownS = SoundID 136
whirdownS = SoundID 137
connectItemS :: SoundID
connectItemS = SoundID 137
connectItemS = SoundID 138
whiteNoiseFadeInS :: SoundID
whiteNoiseFadeInS = SoundID 138
whiteNoiseFadeInS = SoundID 139
gut1S :: SoundID
gut1S = SoundID 139
gut1S = SoundID 140
+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