diff --git a/appDodge/Main.hs b/appDodge/Main.hs index 9ec91d8d1..b5c9a6cc0 100644 --- a/appDodge/Main.hs +++ b/appDodge/Main.hs @@ -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 diff --git a/src/Data/Preload.hs b/src/Data/Preload.hs index c5b29d369..076d17f5d 100644 --- a/src/Data/Preload.hs +++ b/src/Data/Preload.hs @@ -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 } diff --git a/src/Dodge/Config/Update.hs b/src/Dodge/Config/Update.hs index 75c848e70..09253ebff 100644 --- a/src/Dodge/Config/Update.hs +++ b/src/Dodge/Config/Update.hs @@ -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 diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 62043a7d7..181a0e99f 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -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 diff --git a/src/Dodge/Default/World.hs b/src/Dodge/Default/World.hs index 34d2bf1ff..87515030b 100644 --- a/src/Dodge/Default/World.hs +++ b/src/Dodge/Default/World.hs @@ -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 diff --git a/src/Preload.hs b/src/Preload.hs index 6ec362240..540c0addf 100644 --- a/src/Preload.hs +++ b/src/Preload.hs @@ -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 diff --git a/src/Preload/Update.hs b/src/Preload/Update.hs index e095c1028..42ecf4c9e 100644 --- a/src/Preload/Update.hs +++ b/src/Preload/Update.hs @@ -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}) diff --git a/src/Sound.hs b/src/Sound.hs index 344f2dc24..20fc9d09c 100644 --- a/src/Sound.hs +++ b/src/Sound.hs @@ -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 diff --git a/src/Sound/Data.hs b/src/Sound/Data.hs index dd4926fd7..9fc1e28c5 100644 --- a/src/Sound/Data.hs +++ b/src/Sound/Data.hs @@ -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