diff --git a/app/Main.hs b/app/Main.hs index 04fa02535..944871fbf 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -8,7 +8,8 @@ import Dodge.Initialisation import Dodge.Update import Dodge.Event import Dodge.Render -import Dodge.LoadConfig +import Dodge.Config.Data +import Dodge.Config.KeyConfig import Dodge.Config.Load import Dodge.Config.Update import Dodge.LoadSound @@ -26,7 +27,7 @@ import Foreign (Word32) import Control.Monad (when,void) import System.Random import qualified Data.Map as M -import qualified Data.IntMap as IM +import qualified Data.IntMap as IM import Graphics.Rendering.OpenGL hiding (color, rotate, scale, translate) import qualified SDL import qualified SDL.Mixer as Mix @@ -63,7 +64,7 @@ doSideEffects preData w = do foldr (=<<) (return (preData & soundData . playingSounds .~ newPlayingSounds & frameTimer .~ endTicks)) (_doneSideEffects w) -doPreload' :: Dodge.LoadConfig.Configuration -> IO (PreloadData a) +doPreload' :: Dodge.Config.Data.Configuration -> IO (PreloadData a) doPreload' config = do lChunks <- loadSounds lMusic <- loadMusic @@ -85,6 +86,7 @@ checkForGlErrors = do when (length errs > 0) $ putStrLn $ "GLerror during doLoop: " ++ unwords (map show errs) setWindowSize :: Int -> Int -> KeyConfigSDL-> World -> World -setWindowSize x y z w = w & windowX .~ fromIntegral x - & windowY .~ fromIntegral y - & keyConfig .~ z +setWindowSize x y z w = w + & windowX .~ fromIntegral x + & windowY .~ fromIntegral y + & keyConfig .~ z diff --git a/data/music/firstCompo.mid b/data/music/firstCompo.mid new file mode 100644 index 000000000..ee4fd8a8f Binary files /dev/null and b/data/music/firstCompo.mid differ diff --git a/src/Dodge/Config/Update.hs b/src/Dodge/Config/Update.hs index 02d212e22..b7696e381 100644 --- a/src/Dodge/Config/Update.hs +++ b/src/Dodge/Config/Update.hs @@ -3,7 +3,7 @@ IO actions that apply config side effects and save configuration settings to dis -} module Dodge.Config.Update where -import Dodge.Data +import Dodge.Data.SoundOrigin import Dodge.Config.Data import Sound import Preload.Data diff --git a/src/Dodge/Creature/YourControl.hs b/src/Dodge/Creature/YourControl.hs index 9b2284c3c..5cbbbde06 100644 --- a/src/Dodge/Creature/YourControl.hs +++ b/src/Dodge/Creature/YourControl.hs @@ -6,7 +6,7 @@ import Dodge.Base import Dodge.CreatureAction import Dodge.Update.UsingInput import Dodge.CreatureState -import Dodge.LoadConfig +import Dodge.Config.KeyConfig import Geometry diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index d70f3e5ff..cf8ac493d 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -4,14 +4,16 @@ module Dodge.Data ( module Dodge.Data , module Dodge.Data.Menu + , module Dodge.Data.SoundOrigin , Point2 (..) , Sound (..) , soundTime ) where import Dodge.Data.Menu +import Dodge.Data.SoundOrigin import Dodge.Config.Data -import Dodge.LoadConfig.KeyConfig +import Dodge.Config.KeyConfig import Preload.Data import Picture.Data import Geometry.Data @@ -574,24 +576,6 @@ data ForceField = FF } data FFState = FFDestroyable { _ffsHP :: Int } -data SoundOrigin = InventorySound - | BackgroundSound - | OnceSound - | CrSound Int - | CrWeaponSound Int - | WallSound Int - | CrReloadSound Int - | Flamer - | ShellSound Int - | Flame - | LasSound - | FootstepSound Int - | BlockDegradeSound Int - | CrHitSound Int - | BarrelHiss Int - | GlassBreakSound Int - deriving (Eq,Ord,Show) - makeLenses ''World makeLenses ''Cloud diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index ab3639fd4..bad62e229 100644 --- a/src/Dodge/Default.hs +++ b/src/Dodge/Default.hs @@ -11,7 +11,8 @@ import Dodge.Item.Weapon.Recock import Dodge.Data import Dodge.SoundLogic import Dodge.Base -import Dodge.LoadConfig +import Dodge.Config.Data +import Dodge.Config.KeyConfig import Geometry import Picture diff --git a/src/Dodge/Event/Keyboard.hs b/src/Dodge/Event/Keyboard.hs index 03c83163c..2f7ed0042 100644 --- a/src/Dodge/Event/Keyboard.hs +++ b/src/Dodge/Event/Keyboard.hs @@ -8,7 +8,7 @@ module Dodge.Event.Keyboard import Dodge.Data import Dodge.Base import Dodge.CreatureAction -import Dodge.LoadConfig +import Dodge.Config.KeyConfig import Dodge.Room.Placement import Dodge.LightSources import Dodge.LevelGen diff --git a/src/Dodge/Event/Menu.hs b/src/Dodge/Event/Menu.hs index 81e120086..257691da3 100644 --- a/src/Dodge/Event/Menu.hs +++ b/src/Dodge/Event/Menu.hs @@ -7,7 +7,7 @@ import Dodge.Rooms import Dodge.Floor import Dodge.Initialisation import Dodge.SoundLogic -import Dodge.LoadConfig +import Dodge.Config.Data import Dodge.Config.Update import Data.Maybe diff --git a/src/Dodge/Layout/Tree.hs b/src/Dodge/Layout/Tree.hs index 81989efb4..a32f6a4c9 100644 --- a/src/Dodge/Layout/Tree.hs +++ b/src/Dodge/Layout/Tree.hs @@ -1,9 +1,12 @@ +{-| +Combining and composing trees. +-} module Dodge.Layout.Tree where import Data.Tree import Control.Monad.State import System.Random --- Left elements get new children, Right elements inherit the children from the +-- | 'Left' elements get new children, 'Right' elements inherit the children from the -- mapped over node expandTreeBy :: (a -> Tree (Either b b)) -> Tree a -> Tree b expandTreeBy f (Node x []) = fmap removeEither (f x) diff --git a/src/Dodge/LoadConfig.hs b/src/Dodge/LoadConfig.hs deleted file mode 100644 index 26441a9b4..000000000 --- a/src/Dodge/LoadConfig.hs +++ /dev/null @@ -1,30 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE StrictData #-} -module Dodge.LoadConfig - ( - module Dodge.LoadConfig.KeyConfig - , module Dodge.Config.Data - ) where -import Dodge.LoadConfig.KeyConfig -import Dodge.Config.Data -import Dodge.Config.Update - -import Data.Aeson -import System.Directory - -loadDodgeConfig :: IO Configuration -loadDodgeConfig = do - fExists <- doesFileExist "data/dodge.config.json" - if fExists - then do - mayConfig <- decodeFileStrict "data/dodge.config.json" - case mayConfig of - Just config -> setVolume config >> return config - Nothing -> do - putStrLn "invalid data/dodge.config.json, loading default config" - return defaultConfig - else do - putStrLn "No data/data/dodge.config.json found, loading defaults" - return defaultConfig diff --git a/src/Dodge/LoadConfig/KeyConfig.hs b/src/Dodge/LoadConfig/KeyConfig.hs deleted file mode 100644 index f2596b19b..000000000 --- a/src/Dodge/LoadConfig/KeyConfig.hs +++ /dev/null @@ -1,152 +0,0 @@ -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE OverloadedStrings #-} -module Dodge.LoadConfig.KeyConfig - where -import Data.Aeson -import Foreign.C.Types -import GHC.Generics -import qualified GHC.Int -import qualified SDL -import SDL.Internal.Numbered as SDL.Internal.Numbered - -import System.Directory - -data KeyConfig = KeyConfig - { moveUpBinding :: Int, - moveDownBinding :: Int, - moveLeftBinding :: Int, - moveRightBinding :: Int, - pauseBinding :: Int, - escapeBinding :: Int, - dropItemBinding :: Int, - toggleMapBinding :: Int, - reloadBinding :: Int, - testEventBinding :: Int, - spaceActionBinding :: Int, - rotateCameraPlusBinding :: Int, - rotateCameraMinusBinding :: Int, - zoomInBinding :: Int, - zoomOutBinding :: Int, - newBinding :: Int - } - deriving (Generic, Show) - -data KeyConfigSDL = KeyConfigSDL - { moveUpKey :: SDL.Scancode, - moveDownKey :: SDL.Scancode, - moveLeftKey :: SDL.Scancode, - moveRightKey :: SDL.Scancode, - pauseKey :: SDL.Scancode, - escapeKey :: SDL.Scancode, - dropItemKey :: SDL.Scancode, - toggleMapKey :: SDL.Scancode, - reloadKey :: SDL.Scancode, - testEventKey :: SDL.Scancode, - spaceActionKey :: SDL.Scancode, - rotateCameraPlusKey :: SDL.Scancode, - rotateCameraMinusKey :: SDL.Scancode, - zoomInKey :: SDL.Scancode, - zoomOutKey :: SDL.Scancode, - newKey :: SDL.Scancode - } - deriving (Generic, Show) - -defaultKeyConfigSDL = - KeyConfigSDL - { moveUpKey = SDL.ScancodeW, - moveDownKey = SDL.ScancodeS, - moveLeftKey = SDL.ScancodeA, - moveRightKey = SDL.ScancodeD, - pauseKey = SDL.ScancodeP, - escapeKey = SDL.ScancodeEscape, - dropItemKey = SDL.ScancodeF, - toggleMapKey = SDL.ScancodeM, - reloadKey = SDL.ScancodeR, - testEventKey = SDL.ScancodeT, - spaceActionKey = SDL.ScancodeSpace, - rotateCameraPlusKey = SDL.ScancodeQ, - rotateCameraMinusKey = SDL.ScancodeE, - zoomInKey = SDL.ScancodeJ, - zoomOutKey = SDL.ScancodeK, - newKey = SDL.ScancodeN - } - -instance ToJSON KeyConfig where - toEncoding = genericToEncoding defaultOptions - -instance FromJSON KeyConfig where - parseJSON = withObject "KeyConfig" $ \o -> do - moveUpBinding <- o .:? "moveUp" .!= 119 - moveDownBinding <- o .:? "moveDown" .!= 115 - moveLeftBinding <- o .:? "moveLeft" .!= 97 - moveRightBinding <- o .:? "moveRight" .!= 100 - pauseBinding <- o .:? "pause" .!= 112 - escapeBinding <- o .:? "escape" .!= 27 - dropItemBinding <- o .:? "dropItem" .!= 102 - toggleMapBinding <- o .:? "toggleMap" .!= 109 - reloadBinding <- o .:? "reload" .!= 114 - testEventBinding <- o .:? "testEvent" .!= 116 - spaceActionBinding <- o .:? "spaceAction" .!= 32 - rotateCameraPlusBinding <- o .:? "rotateCameraPlus" .!= 113 - rotateCameraMinusBinding <- o .:? "rotateCameraMinus" .!= 101 - zoomInBinding <- o .:? "zoomIn" .!= 106 - zoomOutBinding <- o .:? "zoomOut" .!= 107 - newBinding <- o .:? "new" .!= 110 - return - KeyConfig - { moveUpBinding = moveUpBinding, - moveDownBinding = moveDownBinding, - moveLeftBinding = moveLeftBinding, - moveRightBinding = moveRightBinding, - pauseBinding = pauseBinding, - escapeBinding = escapeBinding, - dropItemBinding = dropItemBinding, - toggleMapBinding = toggleMapBinding, - reloadBinding = reloadBinding, - testEventBinding = testEventBinding, - spaceActionBinding = spaceActionBinding, - rotateCameraPlusBinding = rotateCameraPlusBinding, - rotateCameraMinusBinding = rotateCameraMinusBinding, - zoomInBinding = zoomInBinding, - zoomOutBinding = zoomOutBinding, - newBinding = newBinding - } - -loadKeyConfig :: IO KeyConfigSDL -loadKeyConfig = do - fExists <- doesFileExist "keys.json" - if fExists - then do - mayConfig <- decodeFileStrict "keys.json" - print mayConfig - case mayConfig of - Just config -> - return - KeyConfigSDL - { moveUpKey = getSdlScancode $ moveUpBinding config, - moveDownKey = getSdlScancode $ moveDownBinding config, - moveLeftKey = getSdlScancode $ moveLeftBinding config, - moveRightKey = getSdlScancode $ moveRightBinding config, - pauseKey = getSdlScancode $ pauseBinding config, - escapeKey = getSdlScancode $ escapeBinding config, - dropItemKey = getSdlScancode $ dropItemBinding config, - toggleMapKey = getSdlScancode $ toggleMapBinding config, - reloadKey = getSdlScancode $ reloadBinding config, - testEventKey = getSdlScancode $ testEventBinding config, - spaceActionKey = getSdlScancode $ spaceActionBinding config, - rotateCameraPlusKey = getSdlScancode $ rotateCameraPlusBinding config, - rotateCameraMinusKey = getSdlScancode $ rotateCameraMinusBinding config, - zoomInKey = getSdlScancode $ zoomInBinding config, - zoomOutKey = getSdlScancode $ zoomOutBinding config, - newKey = getSdlScancode $ newBinding config - } - Nothing -> do - putStrLn "invalid keys.json, loading default config" - -- This is duplicated but not sure how to reduce - return defaultKeyConfigSDL - else do - putStrLn "No keys.json found, loading default config" - return defaultKeyConfigSDL - -getSdlScancode :: Int -> SDL.Scancode -getSdlScancode x = SDL.Internal.Numbered.fromNumber (fromIntegral x) :: SDL.Scancode diff --git a/src/Dodge/LoadSound.hs b/src/Dodge/LoadSound.hs index f38b5da4e..e3e78790b 100644 --- a/src/Dodge/LoadSound.hs +++ b/src/Dodge/LoadSound.hs @@ -104,7 +104,7 @@ loadSounds = do loadMusic :: IO (IM.IntMap Mix.Music) loadMusic = do - undercity <- Mix.load "./data/music/undercity.mid" + undercity <- Mix.load "./data/music/firstCompo.mid" return $ IM.fromList $ zip [0..] $ [ undercity ] diff --git a/src/Dodge/Render/MenuScreen.hs b/src/Dodge/Render/MenuScreen.hs index aa3803dba..fd524313d 100644 --- a/src/Dodge/Render/MenuScreen.hs +++ b/src/Dodge/Render/MenuScreen.hs @@ -3,9 +3,9 @@ module Dodge.Render.MenuScreen ) where import Dodge.Data -import Dodge.LoadConfig +import Dodge.Config.Update +import Dodge.Config.Data import Dodge.Base (halfWidth,halfHeight) - import Picture menuScreen :: World -> Picture diff --git a/src/Dodge/Update/Camera.hs b/src/Dodge/Update/Camera.hs index 209379dff..452bd2fe3 100644 --- a/src/Dodge/Update/Camera.hs +++ b/src/Dodge/Update/Camera.hs @@ -2,20 +2,16 @@ module Dodge.Update.Camera where import Dodge.Data import Dodge.Base - +import Dodge.Config.KeyConfig import Geometry import Control.Lens import Control.Monad - import Data.Maybe import qualified Data.Set as S import qualified Data.IntMap.Strict as IM - import qualified SDL as SDL -import Dodge.LoadConfig - updateCamera :: World -> World updateCamera = rotCam . moveCamera . updateScopeZoom diff --git a/src/Sound.hs b/src/Sound.hs index 29d981c1f..1d160966d 100644 --- a/src/Sound.hs +++ b/src/Sound.hs @@ -106,11 +106,13 @@ decrementTimer s = case _soundTime s of & soundStatus .~ FadingOut) Nothing -> return s -applyPosition :: Sound -> IO Sound -applyPosition s = case _soundPos s of - Nothing -> return s - Just (a,d) -> Mix.effectPosition (fromJust $ _soundChannel s) a d - >> return (s & soundPos .~ Nothing) +applyPosition = return + +--applyPosition :: Sound -> IO Sound +--applyPosition s = case _soundPos s of +-- Nothing -> return s +-- Just (a,d) -> Mix.effectPosition (fromJust $ _soundChannel s) a d +-- >> return (s & soundPos .~ Nothing) fadeOutMaybe :: Maybe Mix.Channel -> Int -> IO () fadeOutMaybe (Just x) fadeT = Mix.fadeOut (fromIntegral fadeT + 1) x @@ -159,6 +161,7 @@ setChannelPos a i = do Behind the scenes, scales a float [0,1] to an Int [0..128]. -} setSoundVolume :: Float -> IO () +--setSoundVolume x = Mix.setVolume (round (x * 128)) Mix.AllChannels setSoundVolume x = Mix.setVolume (round (x * 128)) Mix.AllChannels {- | Set the music volume.