Refactor menu

src/Dodge/Data.hs

@@ -3,11 +3,14 @@
 {-# LANGUAGE StrictData #-}
 module Dodge.Data 
     ( module Dodge.Data
+    , module Dodge.Data.Menu
     , Point2 (..)
     , Sound (..)
     , soundTime
     )
   where
+import Dodge.Data.Menu
+
 import Picture.Data
 import Geometry.Data
 import Sound.Data
@@ -78,7 +81,8 @@ data World = World
     , _keyConfig            :: KeyConfigSDL
     , _varMovementSpeedModifier :: Float
     , _varMovementStrafeSpeedModifier :: Float
-    , _debugMode :: Bool
+    , _debugMode            :: Bool
+    , _config               :: Configuration
     } 
 
 data Corpse = Corpse
@@ -242,13 +246,6 @@ data Faction
 data WorldState = DoorNumOpen Int | CrNumAlive Int
   deriving (Eq,Ord)
 
-data MenuState 
-    = LevelMenu Int
-    | PauseMenu
-    | GameOverMenu
-    | InGame
-  deriving (Eq,Ord)
-
 data Button = Button 
     { _btPict :: Picture
     , _btPos :: Point2

src/Dodge/Data/Menu.hs

@@ -0,0 +1,11 @@
+{-# LANGUAGE StrictData #-}
+module Dodge.Data.Menu
+  where
+data MenuState 
+    = LevelMenu Int
+    | PauseMenu
+    | GameOverMenu
+    | OptionMenu
+    | InGame
+  deriving (Eq,Ord)
+

src/Dodge/Default.hs

@@ -1,28 +1,28 @@
 {-# LANGUAGE BangPatterns #-}
+{- |
+Module      : Dodge.Default
+Description : Instances of data structures  
+
+This module contains prototypical data structures.
+-}
 module Dodge.Default where
 
 import Dodge.Item.Weapon.Recock
-
 import Dodge.Data
 import Dodge.SoundLogic
 import Dodge.Base
-
+import Dodge.LoadConfig
 import Geometry
 import Picture
 
 import Control.Lens
-
 import System.Random
-
 import qualified Data.IntMap.Strict as IM
 import qualified Data.Map as M
 import qualified Data.Set as S
 import Data.Graph.Inductive.Graph hiding ((&))
 import Data.List
 
-import Dodge.LoadConfig
-
--- defalt datatypes / prototypes {{{
 defaultWall = Wall { _wlLine = [(0,0),(50,0)]
                    , _wlID = 0
                    , _wlColor = greyN 0.6
@@ -235,6 +235,7 @@ defaultWorld = World
     , _varMovementSpeedModifier = 3
     , _varMovementStrafeSpeedModifier = 3
     , _debugMode = True
+    , _config       = defaultConfig
     }
 youLight = 
     TLS { _tlsPos = (0,0)

src/Dodge/Event.hs

@@ -1,16 +1,16 @@
-module Dodge.Event 
 {- |
 Module      : Dodge.Event
 Description : Direct event handling
 
 Deals with direct events.
-This includes individual key/mouse presses, but /not/ continuous held down input.
+This includes individual key or mouse presses, but /not/ continuous held down input.
 We cannot handle multiple keys held down at once here,
 (eg left mouse button + right mouse button)
 because these are separate events.
 Instead we store the events in a set, and deal with the combinations in
 "Dodge.Update".
 -}
+module Dodge.Event 
     ( handleEvent
     ) where
 import Dodge.Event.Keyboard

src/Dodge/Event/Keyboard.hs

@@ -1,3 +1,6 @@
+{- |
+Deals with keyboard events.
+-}
 module Dodge.Event.Keyboard
     ( handleKeyboardEvent
     )
@@ -21,6 +24,11 @@ import Control.Lens
 
 import Picture
 
+{- | Handles keyboard press and release.
+On release, remove scancode from the 'Set' of pressed keys.
+On press, adds the scancode, and perhaps applies a direct effect:
+see 'handlePressedKeyInGame'.
+ -}
 handleKeyboardEvent :: KeyboardEventData -> World -> Maybe World
 handleKeyboardEvent kev w = case keyboardEventKeyMotion kev of
     Released    -> Just $ w & keys %~ S.delete kcode
@@ -40,9 +48,8 @@ handlePressedKeyInGame scode w
     |  scode == reloadKey (_keyConfig w) = Just $ fromMaybe w $ reloadWeapon (_yourID w) w
     |  scode == testEventKey (_keyConfig w) = Just $ testEvent w
     |  scode == spaceActionKey (_keyConfig w) = Just $ spaceAction w
-    -- Rotation seems to be duplicated here and in Camera.hs ? why
+    |  scode == rotateCameraPlusKey (_keyConfig w)  = Just $ w & cameraRot +~ 0.01
-    |  scode == rotateCameraPlusKey (_keyConfig w) = Just $ w {_cameraRot = _cameraRot w + 0.01}
+    |  scode == rotateCameraMinusKey (_keyConfig w) = Just $ w & cameraRot -~ 0.01
-    |  scode == rotateCameraMinusKey (_keyConfig w) = Just $ w {_cameraRot = _cameraRot w - 0.01}
     |  scode ==   ScancodeF11      = Just $ w {_debugMode = not $ _debugMode w} 
     | _debugMode w = debugKey scode w
 handlePressedKeyInGame _ w = Just w
@@ -57,10 +64,10 @@ handlePressedKey _ _ w = Just w
 
 debugKey :: Scancode -> World -> Maybe World 
 debugKey scancode w
-    | scancode ==   ScancodeF7      = Just $ w {_varMovementSpeedModifier = _varMovementSpeedModifier w - 1}
+    | scancode == ScancodeF7 = Just $ w & varMovementSpeedModifier -~ 1
-    | scancode ==   ScancodeF8      = Just $ w {_varMovementSpeedModifier = _varMovementSpeedModifier w + 1}
+    | scancode == ScancodeF8 = Just $ w & varMovementSpeedModifier +~ 1
-    | scancode ==   ScancodeF5      = Just $ dropLight w 
+    | scancode == ScancodeF5 = Just $ dropLight w 
-    | scancode ==   ScancodeF6      = Just $ dropLight' w 
+    | scancode == ScancodeF6 = Just $ dropLight' w 
 debugKey _ w = Just w
 
 
@@ -78,7 +85,7 @@ escapeMap w = w & carteDisplay .~ False
 
 dropLight :: World -> World
 dropLight w = placeLS ls dec pos 0
-        -- $ over creatures IM.insert i (lamp)
+        --  $ over creatures IM.insert i (lamp)
         $ w
         --case yourItem w of
         --NoItem -> w

src/Dodge/Event/Menu.hs

@@ -18,20 +18,21 @@ import SDL
 handlePressedKeyInMenu :: MenuState -> Scancode -> World -> Maybe World
 handlePressedKeyInMenu mState scode w = case mState of
     LevelMenu _ -> case scode of
-            ScancodeEscape -> Nothing
+            ScancodeEscape  -> Nothing
             _               -> startLevel w
     PauseMenu   -> case scode of
-            ScancodeEscape -> Nothing
+            ScancodeEscape  -> Nothing
-            ScancodeR      -> return $ fromMaybe w $ _storedLevel w
+            ScancodeR       -> return $ fromMaybe w $ _storedLevel w
-            ScancodeN      -> Just $ putSound $ generateLevel 1 
+            ScancodeN       -> Just $ putSound $ generateLevel 1 
                                       $ initialWorld {_randGen = _randGen w}
-            _              -> unpause w
+            _               -> unpause w
     GameOverMenu -> case scode of
-            ScancodeEscape -> Nothing
+            ScancodeEscape  -> Nothing
-            ScancodeR      -> Just $ fromMaybe w $ _storedLevel w
+            ScancodeR       -> Just $ fromMaybe w $ _storedLevel w
-            ScancodeN      -> Just $ putSound $ generateLevel 1 
+            ScancodeN       -> Just $ putSound $ generateLevel 1 
                                                        $ initialWorld
                                                            {_randGen = _randGen w}
+            _               -> Just w
     _ -> Just w
   where 
     unpause w' = Just . resumeSound $

src/Dodge/LoadConfig.hs

@@ -1,7 +1,12 @@
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE StrictData #-}
 module Dodge.LoadConfig
-    ( module Dodge.LoadConfig.KeyConfig
+    ( 
+      Configuration (..)
+    , loadDodgeConfig
+    , defaultConfig
+    , module Dodge.LoadConfig.KeyConfig
     ) where
 import Dodge.LoadConfig.KeyConfig
 
@@ -13,9 +18,9 @@ import qualified SDL
 import System.Directory
 
 data Configuration = Configuration
-  { volume_master   :: Int
+  { volume_master   :: Float
-  , volume_sound    :: Int
+  , volume_sound    :: Float
-  , volume_music    :: Int
+  , volume_music    :: Float
   }
   deriving (Generic, Show)
 
@@ -24,18 +29,18 @@ instance ToJSON Configuration where
 
 instance FromJSON Configuration
 
-loadConfig :: IO Configuration
+loadDodgeConfig :: IO Configuration
-loadConfig = do
+loadDodgeConfig = do
   mayConfig <- decodeFileStrict "data/dodge.config.json"
   case mayConfig of
     Just config -> return config
     Nothing -> do
       putStrLn "invalid data/dodge.config.json, loading default config"
-      return defaultConfiguration
+      return defaultConfig
 
-defaultConfiguration = Configuration
+defaultConfig = Configuration
-    { volume_master = 128
+    { volume_master = 1
-    , volume_sound  = 128
+    , volume_sound  = 1
-    , volume_music  = 128
+    , volume_music  = 1
     }
  

src/Dodge/Render/MenuScreen.hs

@@ -16,16 +16,18 @@ menuScreen w = case _menuState w of
                             ,controlsList
                             ]
                         PauseMenu   -> pictures 
-                                    [--color (withAlpha 0.5 black) $ polygon $ screenBox w
+                                    [color (withAlpha 0.5 black) $ polygon $ screenBox w
-                                    tst (-100) 100 0.4 "PAUSED"
+                                    ,tst (-100) 100 0.4 "PAUSED"
                                     ,tst (-100) 50 0.2 "n - new level"
                                     ,tst (-100) 0 0.2 "r - restart"
+                                    ,tst (-100) (-50) 0.2 "o - options"
                                     , controlsList
                                     ]
                         GameOverMenu -> pictures [color (withAlpha 0.5 black) $ polygon $ screenBox w
                                     ,tst (-100) 100 0.4 "GAME OVER"
                                     ,tst (-100) 50 0.2 "n - new level"
                                     ,tst (-100) 0 0.2 "r - restart"
+                                    ,tst (-100) (-50) 0.2 "o - options"
                                     ,controlsList
                                     ]
                 where tst x y sc t = translate x y $ scale sc sc $ color white $ text t

src/Loop.hs

@@ -1,4 +1,4 @@
-{-|
+{- |
 Module      : Loop
 Description : Minimal game loop
 
@@ -7,14 +7,14 @@ This module sets up an SDL window which may be updated using a simple game loop.
 module Loop
     ( setupLoop
     ) where
-import SDL
 import qualified Data.Text as T
 import Control.Concurrent
 import Control.Exception
-import qualified Graphics.Rendering.OpenGL as GL
 import Control.Monad
 import System.Mem
 import Foreign.C
+import SDL
+import qualified Graphics.Rendering.OpenGL as GL
 
 import Control.Lens ((.~),(&),(+~))