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

Stop all sound when stopping time

Browse Source
This commit is contained in:
justin
2022-10-28 14:36:16 +01:00
parent d3233c7daa
commit 0150655c6d
16 changed files with 99 additions and 96 deletions
Download Patch File Download Diff File Expand all files Collapse all files
appDodge/Main.hs
+2 -2
View File
@@ -105,9 +105,9 @@ updateRenderSplit u = do
return $! updateUniverse u
playSoundUnlessRewinding :: Universe -> IO (M.Map SoundOrigin Sound)
playSoundUnlessRewinding u = case w ^. timeFlow of
playSoundUnlessRewinding u = case w ^. cWorld . timeFlow of
NormalTimeFlow -> playSoundAndUpdate (_soundData $ _preloadData u) (_playingSounds w) (_toPlaySounds w)
_ -> return M.empty
_ -> stopAllSounds >> return M.empty
where
w = _uvWorld u
src/Dodge/Clock.hs
+1 -1
View File
@@ -11,5 +11,5 @@ clockCycle :: Int -> V.Vector a -> World -> a
clockCycle tPeriod xs w = xs V.! i
where
l = V.length xs
t = (w ^. cwTime . worldClock) `mod` (l * tPeriod)
t = (w ^. cWorld . lWorld . lClock) `mod` (l * tPeriod)
i = t `div` tPeriod
src/Dodge/Data/CWorld.hs
+21
View File
@@ -116,8 +116,26 @@ data CWCam = CWCam
data CWorld = CWorld
{ _lWorld :: LWorld
, _cwGen :: CWGen
, _cwClock :: Int
, _pastWorlds :: [LWorld]
, _timeFlow :: TimeFlowStatus
}
data TimeFlowStatus
= RewindingNow
| DeathTime
{ _deathDelay :: Int }
| RewindingLastFrame
| NormalTimeFlow
| ScrollTimeFlow
{ _scrollSmoothing :: Int
, _reverseAmount :: Int
, _futureWorlds :: [LWorld]
, _scrollItemLocation :: Int
}
| RewindLeftClick
{ _reverseAmount :: Int }
data LWorld = LWorld
{ _cwCam :: CWCam
, _creatures :: IM.IntMap Creature
@@ -178,6 +196,7 @@ data LWorld = LWorld
, _seenLocations :: IM.IntMap (WdP2, String)
, _selLocation :: Int
, _distortions :: [Distortion]
, _lClock :: Int
}
data CWGen = CWGen
@@ -202,6 +221,7 @@ makeLenses ''LWorld
makeLenses ''WorldBeams
makeLenses ''CWCam
makeLenses ''CWGen
makeLenses ''TimeFlowStatus
concat
<$> mapM
(deriveJSON defaultOptions)
@@ -210,4 +230,5 @@ concat
, ''CWGen
, ''CWorld
, ''LWorld
, '' TimeFlowStatus
]
src/Dodge/Data/World.hs
-25
View File
@@ -23,7 +23,6 @@ import Dodge.Data.SoundOrigin
import Geometry.Data
import SDL (MouseButton, Scancode)
import Sound.Data
import MaybeHelp
import System.Random
data World = World
@@ -45,23 +44,9 @@ data World = World
, _rSelect :: Point2
, _clickMousePos :: Point2
, _backspaceTimer :: Int
, _timeFlow :: TimeFlowStatus
, _rbOptions :: RightButtonOptions
, _cwTime :: CWTime
}
data TimeFlowStatus
= RewindingNow
| RewindingLastFrame
| NormalTimeFlow
| ScrollTimeFlow
{ _scrollSmoothing :: Int
, _reverseAmount :: Int
, _futureWorlds :: [CWorld]
, _scrollItemLocation :: Int
}
| RewindLeftClick
{ _reverseAmount :: Int }
-- deriving (Eq, Ord, Show, Read) --Generic, Flat)
data WorldHammer
@@ -69,14 +54,4 @@ data WorldHammer
| DoubleMouseHam
deriving (Eq, Ord, Show, Read, Enum, Bounded)
data CWTime = CWTime
{ _maybeWorld :: Maybe' CWorld
, _pastWorlds :: [CWorld]
, _pastWorldsNum :: Int
, _worldClock :: Int
, _deathDelay :: Maybe Int
}
makeLenses ''World
makeLenses ''CWTime
makeLenses ''TimeFlowStatus
src/Dodge/Default/World.hs
+4 -14
View File
@@ -7,10 +7,8 @@ import Dodge.Data.World
import Geometry.Data
import Geometry.Polygon
import qualified IntMapHelp as IM
import MaybeHelp
import System.Random
--import Data.Graph.Inductive.NodeMap
defaultWorld :: World
defaultWorld =
World
@@ -32,9 +30,7 @@ defaultWorld =
, _lSelect = 0
, _rSelect = 0
, _backspaceTimer = 0
, _timeFlow = NormalTimeFlow
, _rbOptions = NoRightButtonOptions
, _cwTime = defaultCWTime
}
defaultCWGen :: CWGen
@@ -66,6 +62,9 @@ defaultCWorld =
CWorld
{ _lWorld = defaultLWorld
, _cwGen = defaultCWGen
, _cwClock = 0
, _pastWorlds = []
, _timeFlow = NormalTimeFlow
}
defaultLWorld :: LWorld
@@ -134,16 +133,7 @@ defaultLWorld =
, _selLocation = 0
, _foregroundShapes = mempty
, _distortions = []
}
defaultCWTime :: CWTime
defaultCWTime =
CWTime
{ _worldClock = 0
, _maybeWorld = Nothing'
, _pastWorlds = []
, _pastWorldsNum = 0
, _deathDelay = Nothing
, _lClock = 0
}
defaultHUD :: HUD
src/Dodge/Item/Weapon/TriggerType.hs
+1 -1
View File
@@ -459,7 +459,7 @@ withTempLight time rad col eff item cr =
modClock :: Int -> ChainEffect -> ChainEffect
modClock n chainEff eff it cr w
| (w ^. cwTime . worldClock) `mod` n == 0 = chainEff eff it cr w
| (w ^. cWorld . lWorld . lClock) `mod` n == 0 = chainEff eff it cr w
| otherwise = eff it cr w
withMuzFlareI :: ChainEffect
src/Dodge/Luse.hs
+2 -2
View File
@@ -21,7 +21,7 @@ useL lu = case lu of
LBoost -> boostSelfL 10
useTimeScrollGun :: Item -> Creature -> World -> World
useTimeScrollGun itm _ w = w & timeFlow .~ ScrollTimeFlow
useTimeScrollGun itm _ w = w & cWorld . timeFlow .~ ScrollTimeFlow
{ _scrollSmoothing = 0
, _reverseAmount = itm ^?! itUse . leftConsumption . wpCharge
, _futureWorlds = []
@@ -29,7 +29,7 @@ useTimeScrollGun itm _ w = w & timeFlow .~ ScrollTimeFlow
}
useRewindGun :: Item -> Creature -> World -> World
useRewindGun itm _ w = w & timeFlow .~ RewindLeftClick (itm ^?! itUse . leftConsumption . wpCharge)
useRewindGun itm _ w = w & cWorld . timeFlow .~ RewindLeftClick (itm ^?! itUse . leftConsumption . wpCharge)
--useRewindGun _ _ w = case w ^. cwTime . rewindWorlds of
-- [w'] -> w & cwTime . maybeWorld .~ Just' w'
src/Dodge/Render/Walls.hs
+1 -1
View File
@@ -25,7 +25,7 @@ wallsToDraw w =
<*> L.prefilter wlSeeThroughDraw (L.premap f L.list)
<*> L.premap getWallSPic L.mconcat
)
(wlsFromIXs w $ zonesExtract (w ^. cWorld . lWorld . wlZoning) $ zoneOfSight' wlZoneSize w)
(wlsFromIXs w $ zonesExtract (w ^. cWorld . lWorld . wlZoning) $ zoneOfSight wlZoneSize w)
--wallsToDraw
-- :: World
src/Dodge/Update.hs
+28 -29
View File
@@ -94,59 +94,59 @@ functionalUpdate'' :: Universe -> Universe
functionalUpdate'' = advanceScrollAmount . functionalUpdate'
functionalUpdate' :: Universe -> Universe
functionalUpdate' u = case u ^. uvWorld . timeFlow of
functionalUpdate' u = case u ^. uvWorld . cWorld . timeFlow of
NormalTimeFlow -> functionalUpdate u
ScrollTimeFlow smoothing _ _ _ -> over uvWorld (doTimeScroll smoothing) u
_ -> u
doTimeScroll :: Int -> World -> World
doTimeScroll smoothing w = case w ^? mouseButtons . ix ButtonLeft of
Just False -> w & timeFlow .~ NormalTimeFlow
Just False -> w & cWorld . timeFlow .~ NormalTimeFlow
_ -> doTimeScroll' smoothing w
doTimeScroll' :: Int -> World -> World
doTimeScroll' smoothing w = case w ^. scrollAmount of
x | x > 1 -> w & scrollTimeBack & timeFlow . scrollSmoothing .~ 20
x | x > 0 -> w & scrollTimeBack & timeFlow . scrollSmoothing %~ max 0
x | x < (-1) -> w & scrollTimeForward & timeFlow . scrollSmoothing .~ negate 20
x | x < 0 -> w & scrollTimeForward & timeFlow . scrollSmoothing %~ min 0
_ | smoothing > 0 -> scrollTimeBack w & timeFlow . scrollSmoothing -~ 1
_ | smoothing < 0 -> scrollTimeForward w & timeFlow . scrollSmoothing +~ 1
x | x > 1 -> w & scrollTimeBack & cWorld . timeFlow . scrollSmoothing .~ 20
x | x > 0 -> w & scrollTimeBack & cWorld . timeFlow . scrollSmoothing %~ max 0
x | x < (-1) -> w & scrollTimeForward & cWorld .timeFlow . scrollSmoothing .~ negate 20
x | x < 0 -> w & scrollTimeForward & cWorld .timeFlow . scrollSmoothing %~ min 0
_ | smoothing > 0 -> scrollTimeBack w & cWorld .timeFlow . scrollSmoothing -~ 1
_ | smoothing < 0 -> scrollTimeForward w & cWorld .timeFlow . scrollSmoothing +~ 1
_ -> w
scrollTimeBack :: World -> World
scrollTimeBack w = case w ^? cwTime . pastWorlds . _head of
scrollTimeBack w = case w ^? cWorld . pastWorlds . _head of
Nothing -> w
Just cw -> case w ^?! timeFlow . reverseAmount of
Just lw -> case w ^?! cWorld .timeFlow . reverseAmount of
x | x > 0 ->
w & cwTime . pastWorlds %~ tail
& timeFlow . futureWorlds .:~ _cWorld w
& timeFlow . reverseAmount -~ 1
& cWorld .~ cw
w & cWorld . pastWorlds %~ tail
& cWorld .timeFlow . futureWorlds .:~ (w ^. cWorld . lWorld)
& cWorld .timeFlow . reverseAmount -~ 1
& cWorld . lWorld .~ lw
& pointerToItemLocation (w ^?! cWorld . lWorld . itemLocations . ix i) . itUse . leftConsumption . wpCharge .~ (x -1)
_ -> w
where
i = w ^?! timeFlow . scrollItemLocation
i = w ^?! cWorld . timeFlow . scrollItemLocation
scrollTimeForward :: World -> World
scrollTimeForward w = case w ^? timeFlow . futureWorlds . _head of
scrollTimeForward w = case w ^? cWorld . timeFlow . futureWorlds . _head of
Nothing -> w
Just cw ->
w & timeFlow . futureWorlds %~ tail
& cwTime . pastWorlds .:~ _cWorld w
& cWorld .~ cw
& timeFlow . reverseAmount .~ ramount
Just lw ->
w & cWorld . timeFlow . futureWorlds %~ tail
& cWorld . pastWorlds .:~ (w ^. cWorld . lWorld)
& cWorld . lWorld .~ lw
& cWorld . timeFlow . reverseAmount .~ ramount
& pointerToItemLocation (w ^?! cWorld . lWorld . itemLocations . ix i) . itUse . leftConsumption . wpCharge .~ ramount
where
i = w ^?! timeFlow . scrollItemLocation
ramount = (w ^?! timeFlow . reverseAmount) + 1
i = w ^?! cWorld . timeFlow . scrollItemLocation
ramount = (w ^?! cWorld . timeFlow . reverseAmount) + 1
-- | The update step.
functionalUpdate :: Universe -> Universe
functionalUpdate w =
checkEndGame
-- . updateRandGen
. over uvWorld (cwTime . worldClock +~ 1)
. over uvWorld (cWorld . lWorld . lClock +~ 1)
. over uvWorld updateWorldSelect
-- . over uvWorld doRewind
-- . over uvWorld (hammers . each %~ moveHammerUp)
@@ -215,7 +215,7 @@ advanceScrollAmount u =
& uvWorld . scrollAmount .~ 0
updatePastWorlds :: World -> World
updatePastWorlds w = w & cwTime . pastWorlds %~ (forceFoldable . take 100 . (_cWorld w :))
updatePastWorlds w = w & cWorld . pastWorlds %~ (forceFoldable . take 100 . ((w ^. cWorld . lWorld) :))
moveHammersUp :: Universe -> Universe
--moveHammersUp = uvWorld . hammers .~ M.empty
@@ -537,13 +537,12 @@ markSeen :: Wall -> Wall
markSeen wl = wl{_wlSeen = True}
checkEndGame :: Universe -> Universe
checkEndGame uv = case w ^. cwTime . deathDelay of
checkEndGame uv = case w ^? cWorld . timeFlow . deathDelay of
Just x
| x < 0 ->
uv & uvScreenLayers .~ [gameOverMenu]
& uvWorld . cwTime . deathDelay .~ Nothing
Just _ -> uv & uvWorld . cwTime . deathDelay . _Just -~ 1
_ | _crHP (you w) < 1 -> uv & uvWorld . cwTime . deathDelay ?~ 50
Just _ -> uv & uvWorld . cWorld . timeFlow . deathDelay -~ 1
_ | _crHP (you w) < 1 -> uv & uvWorld . cWorld . timeFlow .~ DeathTime 50
_ -> uv
where
w = _uvWorld uv
src/Dodge/Zoning/Base.hs
+17 -4
View File
@@ -1,4 +1,17 @@
module Dodge.Zoning.Base where
module Dodge.Zoning.Base
( zoneExtract
, zoneOfPoint
, zonesExtract
, zoneOfSeg
, zoneOfRect
, zoneMonoid
, deZoneIX
, zoneOfPoint''
, zoneOfCirc
, zonesAroundPoint
, xIntercepts
, yIntercepts'
) where
import Control.Lens
import qualified Data.IntSet as IS
@@ -21,9 +34,9 @@ makeIntInterval x y
| x < y = [x .. y]
| otherwise = [y .. x]
makeInt2Interval :: Int2 -> Int2 -> [Int2]
makeInt2Interval (V2 x1 y1) (V2 x2 y2) =
[V2 x y | x <- makeIntInterval x1 x2, y <- makeIntInterval y1 y2]
--makeInt2Interval :: Int2 -> Int2 -> [Int2]
--makeInt2Interval (V2 x1 y1) (V2 x2 y2) =
-- [V2 x y | x <- makeIntInterval x1 x2, y <- makeIntInterval y1 y2]
zoneOfPoint :: Float -> Point2 -> Int2
zoneOfPoint = fmap . divTo
src/Dodge/Zoning/Cloud.hs
+2 -4
View File
@@ -1,7 +1,5 @@
module Dodge.Zoning.Cloud where
--import Data.Foldable
import Control.Lens
import Dodge.Data.World
import Dodge.Zoning.Base
import Geometry
@@ -13,10 +11,10 @@ clsNearPoint :: Point2 -> World -> [Cloud]
clsNearPoint = nearPoint clZoneSize _clZoning
clsNearSeg :: Point2 -> Point2 -> World -> [Cloud]
clsNearSeg sp ep w = zonesExtract (w ^. cWorld . lWorld . clZoning) (zoneOfSeg clZoneSize sp ep)
clsNearSeg = nearSeg clZoneSize _clZoning
clsNearRect :: Point2 -> Point2 -> World -> [Cloud]
clsNearRect sp ep w = zonesExtract (w ^. cWorld . lWorld . clZoning) $ zoneOfRect clZoneSize sp ep
clsNearRect = nearRect clZoneSize _clZoning
clsNearCirc :: Point2 -> Float -> World -> [Cloud]
clsNearCirc p r = clsNearRect (p +.+ V2 r r) (p -.- V2 r r)
src/Dodge/Zoning/Creature.hs
+1 -1
View File
@@ -34,7 +34,7 @@ crsNearCirc :: Point2 -> Float -> World -> [Creature]
crsNearCirc p r w = mapMaybe (\cid -> w ^? cWorld . lWorld . creatures . ix cid) . IS.toList $ crIXsNearCirc p r w
crsNearRect :: Point2 -> Point2 -> World -> IS.IntSet
crsNearRect sp ep w = zonesExtract (w ^. cWorld . lWorld . crZoning) $ zoneOfRect crZoneSize sp ep
crsNearRect = nearRect crZoneSize _crZoning
crZoneSize :: Float
crZoneSize = 15
src/Dodge/Zoning/Pathing.hs
+8 -7
View File
@@ -1,6 +1,5 @@
module Dodge.Zoning.Pathing where
import Control.Lens
import Data.Foldable
import Dodge.Data.World
import Dodge.Zoning.Base
@@ -8,15 +7,16 @@ import Geometry
import qualified IntMapHelp as IM
import Data.Set (Set)
import qualified Data.Set as Set
import Dodge.Zoning.Common
pnsNearPoint :: Point2 -> World -> [(Int, Point2)]
pnsNearPoint p w = zoneExtract (zoneOfPoint pnZoneSize p) (w ^. cWorld . lWorld . pnZoning)
pnsNearPoint = nearPoint pnZoneSize _pnZoning
pnsNearSeg :: Point2 -> Point2 -> World -> [(Int, Point2)]
pnsNearSeg sp ep w = zonesExtract (w ^. cWorld . lWorld . pnZoning) (zoneOfSeg pnZoneSize sp ep)
pnsNearSeg = nearSeg pnZoneSize _pnZoning
pnsNearRect :: Point2 -> Point2 -> World -> [(Int, Point2)]
pnsNearRect sp ep w = zonesExtract (w ^. cWorld . lWorld . pnZoning) $ zoneOfRect pnZoneSize sp ep
pnsNearRect = nearRect pnZoneSize _pnZoning
pnsNearCirc :: Point2 -> Float -> World -> [(Int, Point2)]
pnsNearCirc p r = pnsNearRect (p +.+ V2 r r) (p -.- V2 r r)
@@ -31,13 +31,14 @@ zonePn :: (Int, Point2) -> IM.IntMap (IM.IntMap [(Int, Point2)]) -> IM.IntMap (I
zonePn pn = zoneMonoid (zoneOfPn pn) [pn]
pesNearPoint :: Point2 -> World -> Set PathEdgeNodes
pesNearPoint p w = zoneExtract (zoneOfPoint peZoneSize p) (w ^. cWorld . lWorld . peZoning)
pesNearPoint = nearPoint peZoneSize _peZoning
--pesNearPoint p w = zoneExtract (zoneOfPoint peZoneSize p) (w ^. cWorld . lWorld . peZoning)
pesNearSeg :: Point2 -> Point2 -> World -> Set PathEdgeNodes
pesNearSeg sp ep w = zonesExtract (w ^. cWorld . lWorld . peZoning) (zoneOfSeg peZoneSize sp ep)
pesNearSeg = nearSeg peZoneSize _peZoning
pesNearRect :: Point2 -> Point2 -> World -> Set PathEdgeNodes
pesNearRect sp ep w = zonesExtract (w ^. cWorld . lWorld . peZoning) $ zoneOfRect peZoneSize sp ep
pesNearRect = nearRect peZoneSize _peZoning
pesNearCirc :: Point2 -> Float -> World -> Set PathEdgeNodes
pesNearCirc p r = pesNearRect (p +.+ V2 r r) (p -.- V2 r r)
src/Dodge/Zoning/Wall.hs
+5 -3
View File
@@ -8,16 +8,18 @@ import Dodge.Zoning.Base
import FoldableHelp
import Geometry
import qualified IntMapHelp as IM
import Dodge.Zoning.Common
wlIXsNearPoint :: Point2 -> World -> IS.IntSet
wlIXsNearPoint p w = zoneExtract (zoneOfPoint wlZoneSize p) (w ^. cWorld . lWorld . wlZoning)
wlIXsNearPoint = nearPoint wlZoneSize _wlZoning
--wlIXsNearPoint p w = zoneExtract (zoneOfPoint wlZoneSize p) (w ^. cWorld . lWorld . wlZoning)
wlIXsNearSeg :: Point2 -> Point2 -> World -> IS.IntSet
{-# INLINE wlIXsNearSeg #-}
wlIXsNearSeg sp ep w = zonesExtract (w ^. cWorld . lWorld . wlZoning) (zoneOfSeg wlZoneSize sp ep)
wlIXsNearSeg = nearSeg wlZoneSize _wlZoning
wlIXsNearRect :: Point2 -> Point2 -> World -> IS.IntSet
wlIXsNearRect sp ep w = zonesExtract (w ^. cWorld . lWorld . wlZoning) $ zoneOfRect wlZoneSize sp ep
wlIXsNearRect = nearRect wlZoneSize _wlZoning
wlIXsNearCirc :: Point2 -> Float -> World -> IS.IntSet
wlIXsNearCirc p r = wlIXsNearRect (p +.+ V2 r r) (p -.- V2 r r)
src/Dodge/Zoning/World.hs
+2 -2
View File
@@ -4,8 +4,8 @@ import Dodge.Data.World
import Geometry.Data
import Control.Lens
zoneOfSight' :: Float -> World -> [Int2]
zoneOfSight' s w =
zoneOfSight :: Float -> World -> [Int2]
zoneOfSight s w =
[ V2 a b
| a <- [minimum xs .. maximum xs]
, b <- [minimum ys .. maximum ys]
src/Sound.hs
+4
View File
@@ -12,6 +12,7 @@ module Sound (
-- * Simple (One-Shot) Playback
playSoundQueue
, playPositionalSoundQueue
, stopAllSounds
-- * Complex Playback
, playSoundAndUpdate
-- * Volume Control
@@ -120,6 +121,9 @@ cleanupHalted s = do
then return s
else mzero
stopAllSounds :: IO ()
stopAllSounds = Mix.halt Mix.AllChannels
-----------------------------------------------------------------
{- | Play sounds from a list of indices.
For each index, the corresponding sound starts playing if there is a free channel.