Add (ugly) support for fractional volumes

This commit is contained in:
2022-04-05 09:26:57 +01:00
parent 31d5bcd0bb
commit bca1236a85
12 changed files with 228 additions and 38 deletions
+5
View File
@@ -67,6 +67,9 @@ itemCombinations =
, po [FLAMETHROWER,PUMP] flameTorrent
, p [o PRISM,o TRANSFORMER,o PIPE] lasGun
, p [o LASGUN,o PRISM] lasGunSway
, p [o LASGUN,o HARDWARE] lasGunSwing
, p [o LASGUN,o PIPE] lasGunPulse
, p [o LASGUN,o TRANSFORMER,o PRISM] (lasGunWide 2)
, p [o TRANSFORMER,p 2 CAN] sparkGun
@@ -180,6 +183,8 @@ batteryGuns =
[ teslaGun
, sparkGun
, lasGun
, lasGunSway
, lasGunSwing
] ++
[ lasGunWide i | i <- [1..10]
] ++
+3
View File
@@ -50,6 +50,9 @@ data CombineType
| SPARKGUN
| TESLAGUN
| LASGUN
| LASPULSE
| LASGUNSWING
| LASGUNSWAY
| LASGUNWIDE Int
| LASGUNFOCUS Int
| SONICGUN
+1 -1
View File
@@ -44,7 +44,7 @@ chaseCrit = defaultCreature
, targetYouWhenCognizant
, const (crMeleeCooldown %~ max 0 . subtract 1)
]
, _crHP = 1500
, _crHP = 150
, _crPict = basicCrPict green
, _crInv = IM.fromList [(0,medkit 200)]
, _crMeleeCooldown = 0
+14 -1
View File
@@ -503,6 +503,14 @@ data Particle
{ _ptDraw :: Particle -> Picture
, _ptUpdate :: World -> Particle -> (World, Maybe Particle)
}
| LaserParticle
{ _ptDraw :: Particle -> Picture
, _ptUpdate :: World -> Particle -> (World, Maybe Particle)
, _ptRange :: Float
, _ptDamage :: Int
, _ptColor :: Color
, _ptPhaseV :: Float
}
| LinearParticle
{ _ptDraw :: Particle -> Picture
, _ptUpdate :: World -> Particle -> (World, Maybe Particle)
@@ -626,7 +634,12 @@ data ItemParams
, _shellSpinAmount :: Int
, _shellThrustDelay :: Int
}
| Refracting {_phaseV :: Float}
| Refracting
{ _phaseV :: Float
, _lasColor :: Color
, _lasCycle :: Int
, _lasDamage :: Int
}
| Attracting {_attractionPower :: Point2}
| BulletShooter -- this should possibly be moved into ammo type
{ _muzVel :: Float
+3 -8
View File
@@ -5,9 +5,7 @@ import Dodge.Item.Weapon.InventoryDisplay
import Dodge.Default
import Dodge.Default.Wall
import Dodge.Picture.Layer
import Dodge.Item.Weapon.BatteryGuns
import Dodge.Creature.Test
import Dodge.Wall.Reflect
import Dodge.Wall
import Dodge.Magnet
import Picture
@@ -118,15 +116,12 @@ shieldWall crid = defaultWall
,_wlStructure = CreaturePart crid shieldWallDamage
}
-- TODO the reflection should be controled by the particle
shieldWallDamage :: Damage -> Wall -> Int -> World -> World
shieldWallDamage dm wl crid w = case _dmType dm of
Lasering ->
w & instantParticles .:~ lasRayAt 5 (da +.+ normalizeV (df -.- da)) (reflDirWall df da wl)
shieldWallDamage dm _ crid w = case _dmType dm of
-- Lasering -> w
_ | isMovementDam dm -> w & creatures . ix crid . crState . crDamage .:~ dm
_ -> w
where
df = _dmFrom dm
da = _dmAt dm
createShieldWall :: Creature -> Int -> World -> World
createShieldWall cr invid w = case _itEffectID $ _itEffect it of
+127 -18
View File
@@ -1,7 +1,10 @@
module Dodge.Item.Weapon.BatteryGuns
( lasGun
, lasGunWide
, lasGunSway
, lasGunSwing
, lasGunFocus
, lasGunPulse
, sparkGun
, teslaGun
, tractorGun
@@ -93,32 +96,126 @@ teslaGunPic _ = noPic $ colorSH blue $
where
xa = 1
xb = 9
lasGunPulse :: Item
lasGunPulse = lasGun
& itName .~ "PULSELAS"
& itType .~ LASPULSE
& itUse . useMods .~
[ ammoCheckI
, withItem $ \it -> withTempLight 1 (100 * frac it) (xyzV4 (_lasColor $ _itParams it))
, withItem $ \it -> withSoundForVol (frac it) tone440sawtoothquietS 2
, withItemUpdate itup
$ \it -> withMuzPos $ flareCircleAt (_lasColor $ _itParams it) (frac it * 0.8)
, useAmmoAmount 1
]
where
itup it = it
& itParams . lasCycle %~ (\i -> (i+1) `mod` 20)
& itParams . lasDamage .~ ceiling ((22 :: Float) * frac it)
& itParams . lasColor .~ frac it * orange
frac it = 0.5 * (1 + sin (pi * fromIntegral (_lasCycle $ _itParams it) * 0.1))
lasGunWide :: Int -> Item
lasGunWide n = lasGun
lasGunWide n = lasGun
& itName .~ "PARALELLAS"++show n
& itType .~ LASGUNWIDE n
& itUse . useMods .~
& itParams . lasColor .~ orange
& itParams . lasDamage .~ 2
& itUse .~ ( ruseInstant shootLaser NoHammer
[ ammoCheckI
, withTempLight 1 100 (V3 1 1 0)
, withItem $ \it -> withTempLight 1 100 (xyzV4 (_lasColor $ _itParams it))
, withItem $ \it -> withMuzPos $ flareCircleAt (_lasColor $ _itParams it) 0.8
, withSoundForI tone440sawtoothquietS 2
, duplicateOffsets xs
, useAmmoAmount 1
, duplicateOffsets xs
]
& useAim . aimSpeed .~ 0.4
& useAim . aimRange .~ 1
& useAim . aimStance .~ TwoHandTwist
)
where
xs = [ 3 * (fromIntegral x - fromIntegral (n-1) /2) | x <- [0..n-1] ]
n' = 9 * n
xs = [ 0.25 * (fromIntegral x - fromIntegral (n'-1) /2) | x <- [0..n'-1] ]
lasGunWidePulse :: Int -> Item
lasGunWidePulse n = lasGun
& itName .~ "PARALELLASPULSE"++show n
& itType .~ LASGUNWIDE n
& itParams . lasColor .~ orange
& itParams . lasDamage .~ 2
& itUse .~ ( ruseInstant shootLaser NoHammer
[ ammoCheckI
, withItem $ \it -> withTempLight 1 100 (xyzV4 (_lasColor $ _itParams it))
, withItem $ \it -> withMuzPos $ flareCircleAt (_lasColor $ _itParams it) 0.8
, withSoundForI tone440sawtoothquietS 2
, useAmmoAmount 1
, duplicateOffsets xs
]
& useAim . aimSpeed .~ 0.4
& useAim . aimRange .~ 1
& useAim . aimStance .~ TwoHandTwist
)
where
n' = 9 * n
xs = [ 0.25 * (fromIntegral x - fromIntegral (n'-1) /2) | x <- [0..n'-1] ]
lasGunSway :: Item
lasGunSway = lasGun
& itName .~ "SWAYLAS"
& itType .~ LASGUNSWAY
& itParams . lasColor .~ orange
& itParams . lasDamage .~ 11
& itUse .~ ( ruseInstant shootLaser NoHammer
[ ammoCheckI
, withItem $ \it -> withTempLight 1 100 (xyzV4 (_lasColor $ _itParams it))
, withItem $ \it -> withMuzPos $ flareCircleAt (_lasColor $ _itParams it) 0.8
, withSoundForI tone440sawtoothquietS 2
, useAmmoAmount 1
, withItemUpdate itup $ \it -> duplicateOffsets (x it)
]
& useAim . aimSpeed .~ 0.4
& useAim . aimRange .~ 1
& useAim . aimStance .~ TwoHandTwist
)
where
itup = itParams . lasCycle %~ (\i -> (i+1) `mod` 40)
x it = [ 15 * sin (pi * fromIntegral x' * 0.05) ]
where
x' = _lasCycle $ _itParams it
lasGunFocus :: Int -> Item
lasGunFocus n = lasGun
lasGunFocus n = lasGunWide n
& itName .~ "FOCALAS"++show n
& itType .~ LASGUNFOCUS n
& itParams . lasColor .~ red
& itUse . useMods .~
[ ammoCheckI
, withTempLight 1 100 (V3 1 1 0)
, withItem $ \it -> withTempLight 1 100 (xyzV4 (_lasColor $ _itParams it))
, withItem $ \it -> withMuzPos $ flareCircleAt (_lasColor $ _itParams it) 0.8
, withSoundForI tone440sawtoothquietS 2
, duplicateOffsetsFocus xs
, useAmmoAmount 1
, duplicateOffsetsFocus xs
]
where
xs = [ 3 * (fromIntegral x - fromIntegral (n-1) /2) | x <- [0..n-1] ]
n' = 9 * n
xs = [ 0.25 * (fromIntegral x - fromIntegral (n'-1) /2) | x <- [0..n'-1] ]
lasGunSwing :: Item
lasGunSwing = lasGun
& itName .~ "SWINGLAS"
& itType .~ LASGUNSWING
& itParams . lasColor .~ orange
& itUse . useMods .~
[ ammoCheckI
, withItem $ \it -> withTempLight 1 100 (xyzV4 (_lasColor $ _itParams it))
, withItem $ \it -> withMuzPos $ flareCircleAt (_lasColor $ _itParams it) 0.8
, withSoundForI tone440sawtoothquietS 2
, useAmmoAmount 1
, withItemUpdate itup $ \it -> duplicateOffsetsFocus (x it)
]
where
itup = itParams . lasCycle %~ (\i -> (i+1) `mod` 200)
x it = [-y,y]
where
y = 15 * sin (pi * fromIntegral x' * 0.01)
x' = _lasCycle $ _itParams it
lasGun :: Item
lasGun = defaultAutoBatteryGun
{ _itName = "LASGUN"
@@ -130,14 +227,20 @@ lasGun = defaultAutoBatteryGun
}
, _itUse = ruseInstant shootLaser NoHammer
[ ammoCheckI
, withTempLight 1 100 (V3 1 1 0)
, withItem $ \it -> withTempLight 1 100 (xyzV4 (_lasColor $ _itParams it))
, withSoundForI tone440sawtoothquietS 2
, withItem $ \it -> withMuzPos $ flareCircleAt (_lasColor $ _itParams it) 0.8
, useAmmoAmount 1
]
& useAim . aimSpeed .~ 0.4
& useAim . aimRange .~ 1
& useAim . aimStance .~ TwoHandTwist
, _itParams = Refracting {_phaseV = 1}
, _itParams = Refracting
{ _phaseV = 1
, _lasColor = yellow
, _lasCycle = 0
, _lasDamage = 11
}
, _itTweaks = Tweakable
{ _tweakParams = IM.fromList [(0,lasGunTweak)]
, _tweakSel = 0
@@ -294,17 +397,21 @@ updateArc :: ItemParams
updateArc = createNewArc
shootLaser :: Item -> Creature -> World -> World
shootLaser it cr = (instantParticles .:~ lasRayAt phasev pos dir)
. flareCircleAt yellow 0.8 (pos `v2z` 20)
shootLaser it cr = instantParticles .:~ lasRayAt (_lasColor $ _itParams it) dam phasev pos dir
where
pos = _crPos cr +.+ aimingMuzzlePos cr it *.* unitVectorAtAngle dir
dir = _crDir cr
phasev = _phaseV . _itParams $ _crInv cr IM.! _crInvSel cr
dam = _lasDamage $ _itParams it
lasRayAt :: Float -> Point2 -> Float -> Particle
lasRayAt phasev pos dir = Particle
lasRayAt :: Color -> Int -> Float -> Point2 -> Float -> Particle
lasRayAt col dam phasev pos dir = LaserParticle
{ _ptDraw = const blank
, _ptUpdate = mvLaser phasev pos dir
, _ptRange = 800
, _ptDamage = dam
, _ptPhaseV = phasev
, _ptColor = col
}
mvLaser :: Float -- ^ Phase velocity, controls deflection through windows
-> Point2
@@ -313,15 +420,17 @@ mvLaser :: Float -- ^ Phase velocity, controls deflection through windows
-> Particle
-> (World, Maybe Particle)
mvLaser phasev pos dir w pt
= ( damThingHitWith (\p1 p2 p3 -> Damage Lasering 11 p1 p2 p3 NoDamageEffect) pos xp thHit w
= ( damThingHitWith (\p1 p2 p3 -> Damage Lasering dam p1 p2 p3 NoDamageEffect) pos xp thHit w
, Just pt {_ptDraw = const pic ,_ptUpdate = ptSimpleTime 0 }
)
where
dam = _ptDamage pt
xp = pos +.+ 800 *.* unitVectorAtAngle dir
(thHit, ps) = reflectLaserAlong phasev [] pos xp w
col = _ptColor pt
pic = setLayer 1 $ pictures
[ setDepth 19 . color (brightX 0 0.5 yellow) $ thickLine 20 (pos:ps)
, setDepth 19.5 . color (brightX 10 1 yellow) $ thickLine 3 (pos:ps)
[ setDepth 19 . color (brightX 0 0.5 col) $ thickLine 20 (pos:ps)
, setDepth 19.5 . color (brightX 10 1 col) $ thickLine 3 (pos:ps)
]
aTractorBeam :: Item -> Creature -> World -> World
aTractorBeam _ cr w = w & props . at i ?~ tractorBeamAt i spos outpos dir power
+6 -1
View File
@@ -2,6 +2,7 @@ module Dodge.Item.Weapon.LaserPath
( reflectLaserAlong
) where
import Dodge.Data
import Dodge.Wall.Reflect
--import Dodge.Creature.HandPos
import Dodge.WorldEvent
--import Dodge.Default
@@ -18,12 +19,16 @@ import Data.Tuple
-- not sure why we need to keep a list of seen walls, but seems to loop
-- infinitely when removed
-- this needs to be tested with both reflections and refractions
reflectLaserAlong :: Float -> [Wall] -> Point2 -> Point2 -> World
-> (Maybe (Point2,Either Creature Wall),[Point2])
reflectLaserAlong phasev seenWl sp ep w = case find (notseen seenWl)
$ thingsHitExceptCrLongLine Nothing sp ep w of
Just (p,Right wl)
| _wlOpacity wl == SeeThrough -> second (p:) $ reflectLaserAlong phasev (wl:seenWl) p (refract sp ep wl p) w
| _wlReflect wl -> second (p:) $ reflectLaserAlong phasev (wl:seenWl) p
(p +.+ 800 *.* unitVectorAtAngle (reflDirWall sp p wl)) w
| _wlOpacity wl == SeeThrough -> second (p:) $ reflectLaserAlong phasev (wl:seenWl) p
(refract sp ep wl p) w
| otherwise -> (Just (p,Right wl), [p])
Just (p,obj) -> (Just (p,obj), [p])
Nothing -> (Nothing, [ep])
+34 -2
View File
@@ -7,9 +7,12 @@ module Dodge.Item.Weapon.TriggerType
, useAmmoUpTo
, lockInvFor
, withMuzFlareI
, withMuzPos
, withOldDir
, trigDoAlso
, withTempLight
, withItem
, withItemUpdate
, ammoUseCheck
, rateIncAB
, torqueBefore
@@ -23,6 +26,7 @@ module Dodge.Item.Weapon.TriggerType
, withSoundItemChoiceStart
, withSoundContinue
, withSoundForI
, withSoundForVol
, withSmoke
, withThickSmokeI
, withThinSmokeI
@@ -60,7 +64,7 @@ import Dodge.Reloading
import Dodge.WorldEvent
import Dodge.RandomHelp
import Dodge.Inventory.Lock
--import Dodge.Creature.HandPos
import Dodge.Creature.HandPos
--import Dodge.Default
import Dodge.Base
import Sound.Data
@@ -229,6 +233,17 @@ withSoundForI soundid playTime f item cr
= soundContinue (CrWeaponSound (_crID cr) 0) (_crPos cr) soundid (Just playTime)
. f item cr
{- | Adds a sound to a creature based world effect.
The sound is emitted from the creature's position. -}
withSoundForVol
:: Float -- ^ volume
-> SoundID -- ^ Sound id
-> Int -- ^ Frames to play
-> ChainEffect
withSoundForVol vol soundid playTime f item cr
= soundContinueVol vol (CrWeaponSound (_crID cr) 0) (_crPos cr) soundid (Just playTime)
. f item cr
afterRecoil
:: Float -- ^ Recoil amount
-> ChainEffect
@@ -347,6 +362,10 @@ shootL f cr invid w
&& _rateTime (_useDelay (_itUse item)) == 0
&& _ammoLoaded (_itConsumption item) > 0
reloadCondition = _ammoLoaded (_itConsumption item) == 0
withItem :: (Item -> ChainEffect) -> ChainEffect
withItem g f it = g it f it
withItemUpdate :: (Item -> Item) -> (Item -> ChainEffect) -> ChainEffect
withItemUpdate up g f it cr = g it f it cr . (creatures . ix (_crID cr) . crInv . ix (_crInvSel cr) %~ up)
withTempLight :: Int -> Float -> V3 Float -> ChainEffect
withTempLight time rad col eff item cr = eff item cr
. over tempLightSources (theTLS :)
@@ -368,6 +387,14 @@ withMuzFlareI f it cr w = makeTlsTimeRadColPos 2 100 (V3 1 1 0.5) flashPos
flashPos = addZ 0 (_crPos cr) +.+.+ rotate3z cdir (muzzleOffset +.+.+ V3 5 0 20)
muzzleOffset = V3 (_muzPos (_dimPortage (_itDimension it))) 0 0
cdir = _crDir cr
withMuzPos :: (Point3 -> World -> World) -> ChainEffect
withMuzPos g f it cr w = g (pos `v2z` 20)
$ f it cr w
where
pos = _crPos cr +.+ aimingMuzzlePos cr it *.* unitVectorAtAngle dir
dir = _crDir cr
{- | Applies the effect to a randomly rotated creature,
- rotation amount given by inaccuracy in itParams -}
applyInaccuracy :: ChainEffect
@@ -541,7 +568,12 @@ duplicateOffsetsFocus xs eff item cr w = foldr f w poss
poss = map (rotateV (_crDir cr) . V2 0 ) xs
f pos = eff item $ cr
& crPos %~ (+.+ pos)
& crDir .~ argV (mouseWorldPos w -.- (_crPos cr +.+ pos))
& crDir .~ thedir pos
thedir pos
| dist (mouseWorldPos w) (_crPos cr) < aimingMuzzlePos cr item
= argV (_crPos cr +.+ aimingMuzzlePos cr item *.* unitVectorAtAngle (_crDir cr)
-.- (_crPos cr +.+ pos))
| otherwise = argV (mouseWorldPos w -.- (_crPos cr +.+ pos))
duplicateOffsets :: [Float] -> ChainEffect
duplicateOffsets xs eff item cr w = foldr f w poss
+32 -5
View File
@@ -8,6 +8,7 @@ module Dodge.SoundLogic (
-- * Manipulation of individual sounds
soundStart
, soundContinue
, soundContinueVol
, soundFromGeneral
, soundMultiFrom
, stopSoundFrom
@@ -44,15 +45,16 @@ pauseSound w = w
resumeSound :: Universe -> Universe
resumeSound w = w
soundWithStatus
:: PlayStatus
soundWithStatusVolume
:: Float -- ^ Volume factor, 0 - 1
-> PlayStatus
-> SoundOrigin -- ^ \"Creator\" of sound
-> Point2 -- ^ Position of sound
-> SoundID -- ^ ID of sound to be played
-> Maybe Int -- ^ Frames to play sound for, Nothing for until finished
-> World
-> World
soundWithStatus status so pos sType mtime w = over toPlaySounds (M.insertWith f so sound) w
soundWithStatusVolume vol status so pos sType mtime w = over toPlaySounds (M.insertWith f so sound) w
where
sound = Sound
{ _soundChunkID = sType
@@ -62,13 +64,24 @@ soundWithStatus status so pos sType mtime w = over toPlaySounds (M.insertWith f
,_isLooping = isJust mtime
}
, _soundChannel = Nothing
, _soundAngDist = Just (a,0)
, _soundAngDist = Just (a,floor (225 * (1 - vol)))
, _soundPos = pos
, _soundVolume = soundToVol sType
, _soundVolume = soundToVol sType * vol
, _soundVolumeFraction = vol
}
f _ s = s {_soundTime = mtime }
a = soundAngle pos w
soundWithStatus
:: PlayStatus
-> SoundOrigin -- ^ \"Creator\" of sound
-> Point2 -- ^ Position of sound
-> SoundID -- ^ ID of sound to be played
-> Maybe Int -- ^ Frames to play sound for, Nothing for until finished
-> World
-> World
soundWithStatus = soundWithStatusVolume 1
soundStart
:: SoundOrigin -- ^ \"Creator\" of sound
-> Point2 -- ^ Position of sound
@@ -86,6 +99,17 @@ soundContinue
-> World
soundContinue = soundWithStatus ToContinueStart
-- this needs to all be cleaned up, moved to general sounds
soundContinueVol
:: Float -- ^ volume
-> SoundOrigin -- ^ \"Creator\" of sound
-> Point2 -- ^ Position of sound
-> SoundID -- ^ ID of sound to be played
-> Maybe Int -- ^ Frames to play sound for, Nothing for until finished
-> World
-> World
soundContinueVol vol = soundWithStatusVolume vol ToContinueStart
soundFromGeneral
:: SoundOrigin -- ^ \"Creator\" of sound
-> (World -> Point2) -- ^ Position of sound
@@ -106,6 +130,7 @@ soundFromGeneral so fpos sType mtime w = over toPlaySounds (M.insertWith f so so
, _soundAngDist = Just (a,0)
, _soundPos = fpos w
, _soundVolume = soundToVol sType
, _soundVolumeFraction = 1
}
f _ s = s {_soundTime = mtime }
a = soundAngle (fpos w) w
@@ -149,6 +174,7 @@ soundMultiFrom [so] pos sType mtime w
, _soundAngDist = Just (a,0)
, _soundPos = pos
, _soundVolume = soundToVol sType
, _soundVolumeFraction = 1
}
a = soundAngle pos w
soundMultiFrom (so:sos) pos sType mtime w
@@ -166,6 +192,7 @@ soundMultiFrom (so:sos) pos sType mtime w
, _soundAngDist = Just (a,0)
, _soundPos = pos
, _soundVolume = soundToVol sType
, _soundVolumeFraction = 1
}
a = soundAngle pos w
{- | Sets '_soundTime' to 0. -}
+1 -1
View File
@@ -41,7 +41,7 @@ muzFlareAt col tranv dir w = w & instantParticles .:~ theFlare
flareCircleAt :: Color -> Float -> Point3 -> World -> World
flareCircleAt col alphax tranv = instantParticles .:~ Particle
{ _ptDraw = const . setLayer 1 . translate3 tranv
$ circleSolidCol (withAlpha 0 0) (withAlpha alphax col) 30
$ circleSolidCol (withAlpha 0 0) (withAlpha alphax col) 50
, _ptUpdate = ptSimpleTime 1
}
+1 -1
View File
@@ -87,7 +87,7 @@ tryPlay sd s = do
Mix.halt i
Mix.playOn i timesToPlay (sd IM.! _getSoundID (_soundChunkID s))
return $ s
& soundChannel ?~ i
& soundChannel ?~ i
& soundStatus . playStatus .~ JustStartedPlaying
where
timesToPlay | _isLooping (_soundStatus s) = Mix.Forever
+1
View File
@@ -33,6 +33,7 @@ data Sound = Sound
, _soundAngDist :: Maybe (Int16,Word8) -- why do BOTH of
, _soundPos :: Point2 -- these exist?
, _soundVolume :: Float
, _soundVolumeFraction :: Float -- this needs cleaning up/combining
, _soundChunkID :: SoundID
}
deriving (Eq,Ord,Show)