Add first compo

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
@@ -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
+setWindowSize x y z w = w 
+    & windowX .~ fromIntegral x
     & windowY .~ fromIntegral y
     & keyConfig .~ z

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

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
 

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

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
 

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

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

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)

src/Dodge/LoadConfig.hs

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

src/Dodge/LoadConfig/KeyConfig.hs

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

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
         ]

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

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
 

src/Sound.hs

@@ -106,11 +106,13 @@ decrementTimer s = case _soundTime s of
                                          & soundStatus .~ FadingOut)
     Nothing -> return s
 
-applyPosition :: Sound -> IO Sound
+applyPosition = return
-applyPosition s = case _soundPos s of
+
-    Nothing     -> return s
+--applyPosition :: Sound -> IO Sound
-    Just (a,d)  -> Mix.effectPosition (fromJust $ _soundChannel s) a d
+--applyPosition s = case _soundPos s of
-                    >> return (s & soundPos .~ Nothing)
+--    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.