Try to move sound into world, slightly broken now

This commit is contained in:
2021-09-08 19:12:54 +01:00
parent 04e5b9b39f
commit c3d567353c
9 changed files with 33 additions and 56 deletions
+14 -37
View File
@@ -21,7 +21,6 @@ import Sound.Data
import Music
import Data.Preload
import Data.Preload.Render
import Shader.Poke
import Control.Lens
--import Foreign (Word32)
@@ -33,59 +32,37 @@ import Graphics.Rendering.OpenGL hiding (color, rotate, scale, translate)
import qualified SDL
import qualified SDL.Mixer as Mix
main' :: IO ()
main' = do
(sizex,sizey) <- loadConfig
theKeyConfig <- loadKeyConfig
dodgeConfig <- loadDodgeConfig
setupLoop
(sizex,sizey)
(SDL.cursorVisible $= False >> doPreload >>= applyWorldConfig dodgeConfig)
(\x -> (SDL.cursorVisible $= True) >> cleanUpPreload x)
(fmap (setWindowSize sizex sizey . (keyConfig .~ theKeyConfig) . (config .~ dodgeConfig)) firstWorld)
doSideEffects
handleEvent
(Just . update)
main :: IO ()
main = do
(sizex,sizey) <- loadConfig
theKeyConfig <- loadKeyConfig
dodgeConfig <- loadDodgeConfig
setupLoop'
(sizex,sizey)
theCleanup
(firstWorldLoad (sizex,sizey) theKeyConfig dodgeConfig)
(firstWorldLoad (sizex,sizey))
theUpdateStep
handleEvent
-- (SDL.cursorVisible $= False >> doPreload >>= applyWorldConfig dodgeConfig)
-- (fmap (setWindowSize sizex sizey . (keyConfig .~ theKeyConfig) . (config .~ dodgeConfig)) firstWorld)
-- doSideEffects
theCleanup :: World -> IO ()
theCleanup w = SDL.cursorVisible $= True >> cleanUpPreload (_preloadData w)
--firstWorldLoad :: Configuration -> IO World
firstWorldLoad (sizex,sizey) theKeyConfig theConfig = do
firstWorldLoad :: (Int,Int) -> IO World
firstWorldLoad (sizex,sizey) = do
SDL.cursorVisible $= False
theKeyConfig <- loadKeyConfig
theConfig <- loadDodgeConfig
pdata <- doPreload >>= applyWorldConfig theConfig
w <- fmap (setWindowSize sizex sizey . (keyConfig .~ theKeyConfig) . (config .~ theConfig)) firstWorld
return $ w & preloadData .~ pdata
theUpdateStep :: World -> IO World
theUpdateStep = applySideEffects . update
theUpdateStep = doSideEffects . update
applySideEffects :: World -> IO (World)
applySideEffects w = do
newpdata <- doSideEffects (_preloadData w) w
return $ w & preloadData .~ newpdata
doSideEffects :: PreloadData SoundOrigin -> World -> IO (PreloadData SoundOrigin)
doSideEffects preData w = do
--startTicks <- SDL.ticks
doSideEffects :: World -> IO World
doSideEffects w = do
let preData = _preloadData w
void $ doDrawing (_renderData preData) w
playPositionalSoundQueue (_loadedChunks $ _soundData preData) (_soundQueue w)
newPlayingSounds <- playSoundAndUpdate (_soundData preData) (_sounds w)
newPlayingSounds <- playSoundAndUpdate (_soundData preData) (_playingSounds w) (_sounds w)
endTicks <- SDL.ticks
let lastFrameTicks = _frameTimer preData
@@ -96,14 +73,14 @@ doSideEffects preData w = do
. translate (-0.5) (-0.8) . scale 0.0005 0.0005
. text $ "ms/frame " ++ show (endTicks - lastFrameTicks)
)
foldr (=<<) (return (preData & soundData . playingSounds .~ newPlayingSounds
& frameTimer .~ endTicks)) (_doneSideEffects w)
newpdata <- foldr (=<<) (return (preData & frameTimer .~ endTicks)) (_doneSideEffects w)
return $ w & preloadData .~ newpdata
doPreload :: IO (PreloadData a)
doPreload :: IO PreloadData
doPreload = do
lChunks <- loadSounds
lMusic <- loadMusic
let sData = SoundData {_loadedChunks = lChunks, _playingSounds = M.empty}
let sData = SoundData {_loadedChunks = lChunks}
mData = MusicData {_loadedMusic = lMusic}
Mix.playMusic Mix.Forever (lMusic IM.! 0)
rData <- preloadRender
+2 -2
View File
@@ -8,9 +8,9 @@ import Music
import Control.Lens
import GHC.Word (Word32)
data PreloadData a = PreloadData
data PreloadData = PreloadData
{ _renderData :: RenderData
, _soundData :: SoundData a
, _soundData :: SoundData
, _musicData :: MusicData
, _frameTimer :: Word32
}
+4 -4
View File
@@ -14,7 +14,7 @@ import Data.Aeson (encodeFile)
{- |
Write the current world configuration to disk as a json file.
-}
saveConfig :: Configuration -> PreloadData SoundOrigin -> IO (PreloadData SoundOrigin)
saveConfig :: Configuration -> PreloadData -> IO PreloadData
saveConfig cfig d = do
putStrLn "Saving config to data/dodge.config.json"
encodeFile "data/dodge.config.json" cfig
@@ -23,7 +23,7 @@ saveConfig cfig d = do
{- |
Apply the volume settings from the world configuration to the running game.
-}
setVol :: Configuration -> PreloadData SoundOrigin -> IO (PreloadData SoundOrigin)
setVol :: Configuration -> PreloadData -> IO PreloadData
setVol cfig d = do
setSoundVolume ( _volume_master cfig * _volume_sound cfig)
setMusicVolume ( _volume_master cfig * _volume_music cfig)
@@ -34,8 +34,8 @@ Apply /all/ of the values in the world configuration to the running game.
-}
applyWorldConfig
:: Configuration
-> PreloadData SoundOrigin
-> IO (PreloadData SoundOrigin)
-> PreloadData
-> IO PreloadData
applyWorldConfig cfig pdata = do
setVol cfig pdata >>= pdataResizeUpdate (x `div` divRes) (y `div` divRes) x y
where
+4 -3
View File
@@ -78,6 +78,7 @@ data World = World
, _buttons :: IM.IntMap Button
, _soundQueue :: [(Int,Int16)]
, _sounds :: M.Map SoundOrigin Sound
, _playingSounds :: M.Map SoundOrigin Sound
, _decorations :: IM.IntMap Picture
, _foregroundDecorations :: [Polyhedra]
, _foregroundEdgeVerx :: [Point3]
@@ -102,14 +103,14 @@ data World = World
, _selLocation :: Int
, _keyConfig :: KeyConfigSDL
, _config :: Configuration
, _sideEffects :: [PreloadData SoundOrigin -> IO (PreloadData SoundOrigin)]
, _doneSideEffects :: [PreloadData SoundOrigin -> IO (PreloadData SoundOrigin)]
, _sideEffects :: [PreloadData -> IO PreloadData]
, _doneSideEffects :: [PreloadData -> IO PreloadData]
, _debugFlags :: DebugFlags
, _inventoryMode :: InventoryMode
, _lClickHammer :: HammerPosition
, _radDistortion :: [(Point2,Point2,Point2,Float)]
, _gameRooms :: [GameRoom]
, _preloadData :: PreloadData SoundOrigin
, _preloadData :: PreloadData
}
data OptionScreenFlag = NormalOptions | GameOverOptions
data ScreenLayer
+1 -1
View File
@@ -50,10 +50,10 @@ defaultWorld = World
, _buttons = IM.empty
, _soundQueue = []
, _sounds = M.empty
, _playingSounds = M.empty
, _corpses = IM.empty
, _decorations = IM.empty
, _storedLevel = Nothing
--, _menuLayers = [levelMenu 1]
, _menuLayers = []
, _worldState = M.empty
, _worldTriggers = S.empty
+2 -2
View File
@@ -9,10 +9,10 @@ import Sound.Data
import qualified SDL.Mixer as Mix
cleanUpPreload :: PreloadData a -> IO ()
cleanUpPreload :: PreloadData -> IO ()
cleanUpPreload pd = do
cleanUpRenderPreload $ _renderData pd
cleanUpSoundPreload $ _soundData pd
cleanUpSoundPreload :: SoundData a -> IO ()
cleanUpSoundPreload :: SoundData -> IO ()
cleanUpSoundPreload _ = Mix.closeAudio
+2 -2
View File
@@ -15,8 +15,8 @@ pdataResizeUpdate
-> Int -- ^ Scaled height
-> Int -- ^ Full width
-> Int -- ^ Full height
-> PreloadData a
-> IO (PreloadData a)
-> PreloadData
-> IO PreloadData
pdataResizeUpdate xsize ysize xfull yfull pdata = do
rd <- renderDataResizeUpdate xsize ysize xfull yfull (_renderData pdata)
return (pdata {_renderData = rd})
+3 -3
View File
@@ -49,9 +49,9 @@ In the update:
3. apply 'Just' sound position effects, set value to 'Nothing'
4. remove sounds that have stopped playing from the map.
-}
playSoundAndUpdate :: Ord a => SoundData a -> M.Map a Sound -> IO (M.Map a Sound)
playSoundAndUpdate sData newSounds
= updateSounds (_loadedChunks sData) (M.unionWith mergeSound (_playingSounds sData) newSounds)
playSoundAndUpdate :: Ord a => SoundData -> M.Map a Sound -> M.Map a Sound -> IO (M.Map a Sound)
playSoundAndUpdate sData oldSounds newSounds
= updateSounds (_loadedChunks sData) (M.unionWith mergeSound oldSounds newSounds)
mergeSound :: Sound -> Sound -> Sound
mergeSound oldS newS
+1 -2
View File
@@ -16,9 +16,8 @@ data SoundStatus
| ToStart
deriving (Eq,Ord,Show)
data SoundData a = SoundData
data SoundData = SoundData
{_loadedChunks :: IM.IntMap Mix.Chunk
,_playingSounds :: M.Map a Sound
}
data Sound = Sound
{ _soundTime :: Maybe Int