Stop all sound when stopping time

appDodge/Main.hs

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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 = []
-        }
+        , _lClock = 0
-
-defaultCWTime :: CWTime
-defaultCWTime =
-    CWTime
-        { _worldClock = 0
-        , _maybeWorld = Nothing'
-        , _pastWorlds = []
-        , _pastWorldsNum = 0
-        , _deathDelay = Nothing
         }
 
 defaultHUD :: HUD

src/Dodge/Item/Weapon/TriggerType.hs

@@ -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

@@ -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

@@ -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

@@ -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 > 1 -> w & scrollTimeBack & cWorld . timeFlow . scrollSmoothing .~ 20
-    x | x > 0 -> w & scrollTimeBack & timeFlow . scrollSmoothing %~ max 0
+    x | x > 0 -> w & scrollTimeBack & cWorld . timeFlow . scrollSmoothing %~ max 0
-    x | x < (-1) -> w & scrollTimeForward & timeFlow . scrollSmoothing .~ negate 20
+    x | x < (-1) -> w & scrollTimeForward & cWorld .timeFlow . scrollSmoothing .~ negate 20
-    x | x < 0 -> w & scrollTimeForward & timeFlow . scrollSmoothing %~ min 0
+    x | x < 0 -> w & scrollTimeForward & cWorld .timeFlow . scrollSmoothing %~ min 0
-    _ | smoothing > 0 -> scrollTimeBack w & timeFlow . scrollSmoothing -~ 1
+    _ | smoothing > 0 -> scrollTimeBack w & cWorld .timeFlow . scrollSmoothing -~ 1
-    _ | smoothing < 0 -> scrollTimeForward w & 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
+                w & cWorld . pastWorlds %~ tail
-                    & timeFlow . futureWorlds .:~ _cWorld w
+                    & cWorld .timeFlow . futureWorlds .:~ (w ^. cWorld . lWorld)
-                    & timeFlow . reverseAmount -~ 1
+                    & cWorld .timeFlow . reverseAmount -~ 1
-                    & cWorld .~ cw
+                    & 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 ->
+    Just lw ->
-        w & timeFlow . futureWorlds %~ tail
+        w & cWorld . timeFlow . futureWorlds %~ tail
-            & cwTime . pastWorlds .:~ _cWorld w
+            & cWorld . pastWorlds .:~ (w ^. cWorld . lWorld)
-            & cWorld .~ cw
+            & cWorld . lWorld .~ lw
-            & timeFlow . reverseAmount .~ ramount
+            & cWorld . timeFlow . reverseAmount .~ ramount
             & pointerToItemLocation (w ^?! cWorld . lWorld . itemLocations . ix i) . itUse . leftConsumption . wpCharge .~ ramount
   where
-    i = w ^?! timeFlow . scrollItemLocation
+    i = w ^?! cWorld . timeFlow . scrollItemLocation
-    ramount = (w ^?! timeFlow . reverseAmount) + 1
+    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 . cWorld . timeFlow . deathDelay -~ 1
-    Just _ -> uv & uvWorld . cwTime . deathDelay . _Just -~ 1
+    _ | _crHP (you w) < 1 -> uv & uvWorld . cWorld . timeFlow .~ DeathTime 50
-    _ | _crHP (you w) < 1 -> uv & uvWorld . cwTime . deathDelay ?~ 50
     _ -> uv
   where
     w = _uvWorld uv

src/Dodge/Zoning/Base.hs

@@ -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 :: Int2 -> Int2 -> [Int2]
-makeInt2Interval (V2 x1 y1) (V2 x2 y2) =
+--makeInt2Interval (V2 x1 y1) (V2 x2 y2) =
-    [V2 x y | x <- makeIntInterval x1 x2, y <- makeIntInterval y1 y2]
+--    [V2 x y | x <- makeIntInterval x1 x2, y <- makeIntInterval y1 y2]
 
 zoneOfPoint :: Float -> Point2 -> Int2
 zoneOfPoint = fmap . divTo

src/Dodge/Zoning/Cloud.hs

@@ -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

@@ -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

@@ -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

@@ -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

@@ -4,8 +4,8 @@ import Dodge.Data.World
 import Geometry.Data
 import Control.Lens
 
-zoneOfSight' :: Float -> World -> [Int2]
+zoneOfSight :: Float -> World -> [Int2]
-zoneOfSight' s w =
+zoneOfSight s w =
     [ V2 a b
     | a <- [minimum xs .. maximum xs]
     , b <- [minimum ys .. maximum ys]

src/Sound.hs

@@ -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.