From bca1236a8504821bd12e5758a4733951f9fa59b1 Mon Sep 17 00:00:00 2001 From: justin Date: Tue, 5 Apr 2022 09:26:57 +0100 Subject: [PATCH] Add (ugly) support for fractional volumes --- src/Dodge/Combine/Combinations.hs | 5 + src/Dodge/Combine/Data.hs | 3 + src/Dodge/Creature/ChaseCrit.hs | 2 +- src/Dodge/Data.hs | 15 ++- src/Dodge/Item/Equipment.hs | 11 +- src/Dodge/Item/Weapon/BatteryGuns.hs | 145 +++++++++++++++++++++++---- src/Dodge/Item/Weapon/LaserPath.hs | 7 +- src/Dodge/Item/Weapon/TriggerType.hs | 36 ++++++- src/Dodge/SoundLogic.hs | 37 ++++++- src/Dodge/WorldEvent/Flash.hs | 2 +- src/Sound.hs | 2 +- src/Sound/Data.hs | 1 + 12 files changed, 228 insertions(+), 38 deletions(-) diff --git a/src/Dodge/Combine/Combinations.hs b/src/Dodge/Combine/Combinations.hs index 94caf93e3..d7f2d7fd6 100644 --- a/src/Dodge/Combine/Combinations.hs +++ b/src/Dodge/Combine/Combinations.hs @@ -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] ] ++ diff --git a/src/Dodge/Combine/Data.hs b/src/Dodge/Combine/Data.hs index 8f0be09f2..2aa5c28de 100644 --- a/src/Dodge/Combine/Data.hs +++ b/src/Dodge/Combine/Data.hs @@ -50,6 +50,9 @@ data CombineType | SPARKGUN | TESLAGUN | LASGUN + | LASPULSE + | LASGUNSWING + | LASGUNSWAY | LASGUNWIDE Int | LASGUNFOCUS Int | SONICGUN diff --git a/src/Dodge/Creature/ChaseCrit.hs b/src/Dodge/Creature/ChaseCrit.hs index 2e168db32..eba240094 100644 --- a/src/Dodge/Creature/ChaseCrit.hs +++ b/src/Dodge/Creature/ChaseCrit.hs @@ -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 diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 352dc52f0..7fb94dcfb 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -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 diff --git a/src/Dodge/Item/Equipment.hs b/src/Dodge/Item/Equipment.hs index e6ce07916..0a8f7d568 100644 --- a/src/Dodge/Item/Equipment.hs +++ b/src/Dodge/Item/Equipment.hs @@ -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 diff --git a/src/Dodge/Item/Weapon/BatteryGuns.hs b/src/Dodge/Item/Weapon/BatteryGuns.hs index 82101b415..f2c632295 100644 --- a/src/Dodge/Item/Weapon/BatteryGuns.hs +++ b/src/Dodge/Item/Weapon/BatteryGuns.hs @@ -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 diff --git a/src/Dodge/Item/Weapon/LaserPath.hs b/src/Dodge/Item/Weapon/LaserPath.hs index 68fa62e52..068c565fe 100644 --- a/src/Dodge/Item/Weapon/LaserPath.hs +++ b/src/Dodge/Item/Weapon/LaserPath.hs @@ -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]) diff --git a/src/Dodge/Item/Weapon/TriggerType.hs b/src/Dodge/Item/Weapon/TriggerType.hs index 8973a5c50..654b8a251 100644 --- a/src/Dodge/Item/Weapon/TriggerType.hs +++ b/src/Dodge/Item/Weapon/TriggerType.hs @@ -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 diff --git a/src/Dodge/SoundLogic.hs b/src/Dodge/SoundLogic.hs index 8fbbded42..882c70565 100644 --- a/src/Dodge/SoundLogic.hs +++ b/src/Dodge/SoundLogic.hs @@ -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. -} diff --git a/src/Dodge/WorldEvent/Flash.hs b/src/Dodge/WorldEvent/Flash.hs index d7b797619..63e9ec896 100644 --- a/src/Dodge/WorldEvent/Flash.hs +++ b/src/Dodge/WorldEvent/Flash.hs @@ -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 } diff --git a/src/Sound.hs b/src/Sound.hs index 9b16ec0fe..86c2a3623 100644 --- a/src/Sound.hs +++ b/src/Sound.hs @@ -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 diff --git a/src/Sound/Data.hs b/src/Sound/Data.hs index 69a2466b1..06792f58b 100644 --- a/src/Sound/Data.hs +++ b/src/Sound/Data.hs @@ -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)