diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 7cb91d76d..ddc3277c0 100644 --- a/src/Dodge/Data.hs +++ b/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 diff --git a/src/Dodge/Data/Menu.hs b/src/Dodge/Data/Menu.hs new file mode 100644 index 000000000..61abc4719 --- /dev/null +++ b/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) + diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index a8a50d63c..2f5131423 100644 --- a/src/Dodge/Default.hs +++ b/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) diff --git a/src/Dodge/Event.hs b/src/Dodge/Event.hs index 5f8b09b11..811f9835e 100644 --- a/src/Dodge/Event.hs +++ b/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 diff --git a/src/Dodge/Event/Keyboard.hs b/src/Dodge/Event/Keyboard.hs index 302c3f66b..61900fc61 100644 --- a/src/Dodge/Event/Keyboard.hs +++ b/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 = _cameraRot w + 0.01} - | scode == rotateCameraMinusKey (_keyConfig w) = Just $ w {_cameraRot = _cameraRot w - 0.01} + | scode == rotateCameraPlusKey (_keyConfig w) = Just $ w & cameraRot +~ 0.01 + | scode == rotateCameraMinusKey (_keyConfig w) = Just $ w & cameraRot -~ 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 == ScancodeF8 = Just $ w {_varMovementSpeedModifier = _varMovementSpeedModifier w + 1} - | scancode == ScancodeF5 = Just $ dropLight w - | scancode == ScancodeF6 = Just $ dropLight' w + | scancode == ScancodeF7 = Just $ w & varMovementSpeedModifier -~ 1 + | scancode == ScancodeF8 = Just $ w & varMovementSpeedModifier +~ 1 + | scancode == ScancodeF5 = 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 diff --git a/src/Dodge/Event/Menu.hs b/src/Dodge/Event/Menu.hs index 12d68a103..7b8dc3acc 100644 --- a/src/Dodge/Event/Menu.hs +++ b/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 - ScancodeR -> return $ fromMaybe w $ _storedLevel w - ScancodeN -> Just $ putSound $ generateLevel 1 + ScancodeEscape -> Nothing + ScancodeR -> return $ fromMaybe w $ _storedLevel w + ScancodeN -> Just $ putSound $ generateLevel 1 $ initialWorld {_randGen = _randGen w} - _ -> unpause w + _ -> unpause w GameOverMenu -> case scode of - ScancodeEscape -> Nothing - ScancodeR -> Just $ fromMaybe w $ _storedLevel w - ScancodeN -> Just $ putSound $ generateLevel 1 + ScancodeEscape -> Nothing + ScancodeR -> Just $ fromMaybe w $ _storedLevel w + ScancodeN -> Just $ putSound $ generateLevel 1 $ initialWorld {_randGen = _randGen w} + _ -> Just w _ -> Just w where unpause w' = Just . resumeSound $ diff --git a/src/Dodge/LoadConfig.hs b/src/Dodge/LoadConfig.hs index 16daa9bcd..6b6126859 100644 --- a/src/Dodge/LoadConfig.hs +++ b/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_sound :: Int - , volume_music :: Int + { volume_master :: Float + , volume_sound :: Float + , volume_music :: Float } deriving (Generic, Show) @@ -24,18 +29,18 @@ instance ToJSON Configuration where instance FromJSON Configuration -loadConfig :: IO Configuration -loadConfig = do +loadDodgeConfig :: IO Configuration +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 - { volume_master = 128 - , volume_sound = 128 - , volume_music = 128 +defaultConfig = Configuration + { volume_master = 1 + , volume_sound = 1 + , volume_music = 1 } diff --git a/src/Dodge/Render/MenuScreen.hs b/src/Dodge/Render/MenuScreen.hs index b27ea3a43..95435a1c2 100644 --- a/src/Dodge/Render/MenuScreen.hs +++ b/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 - tst (-100) 100 0.4 "PAUSED" + [color (withAlpha 0.5 black) $ polygon $ screenBox w + ,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 diff --git a/src/Loop.hs b/src/Loop.hs index b202638ef..3c5dcd519 100644 --- a/src/Loop.hs +++ b/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 ((.~),(&),(+~))