From 8de5cfcb18b9b772c2a3b07fc397ce66fd6906e5 Mon Sep 17 00:00:00 2001 From: Ross Date: Mon, 29 Mar 2021 08:02:55 +0100 Subject: [PATCH 1/3] debug mode --- src/Dodge/CreatureAction.hs | 1 + src/Dodge/Data.hs | 1 + src/Dodge/Default.hs | 1 + src/Dodge/Event/Keyboard.hs | 36 +++++++++++++++++++++++++++++++++--- 4 files changed, 36 insertions(+), 3 deletions(-) diff --git a/src/Dodge/CreatureAction.hs b/src/Dodge/CreatureAction.hs index 2057b9a9c..fd35e5e38 100644 --- a/src/Dodge/CreatureAction.hs +++ b/src/Dodge/CreatureAction.hs @@ -13,6 +13,7 @@ import Dodge.Base import Dodge.SoundLogic import Dodge.WorldEvent import Dodge.Inventory +import Dodge.LightSources import Geometry import Picture diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index ed93e5393..3aa3addc7 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -76,6 +76,7 @@ data World = World , _keyConfig :: KeyConfigSDL , _varMovementSpeedModifier :: Float , _varMovementStrafeSpeedModifier :: Float + , _debugMode :: Bool } data Corpse = Corpse diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index 027e44db6..df3570a32 100644 --- a/src/Dodge/Default.hs +++ b/src/Dodge/Default.hs @@ -232,6 +232,7 @@ defaultWorld = World , _keyConfig = defaultKeyConfigSDL , _varMovementSpeedModifier = 3 , _varMovementStrafeSpeedModifier = 3 + , _debugMode = False } youLight = -- LS {_lsEff = \w _ p -> (logistic 1 1 1 (d p w * 0.01) ) diff --git a/src/Dodge/Event/Keyboard.hs b/src/Dodge/Event/Keyboard.hs index 2fe3f6133..7ee3c3085 100644 --- a/src/Dodge/Event/Keyboard.hs +++ b/src/Dodge/Event/Keyboard.hs @@ -6,12 +6,19 @@ import Dodge.Data import Dodge.Base import Dodge.CreatureAction import Dodge.LoadConfig +import Dodge.Room.Placement +import Dodge.LightSources +import Dodge.LevelGen +import Dodge.Creature.Inanimate +import qualified Data.IntMap.Strict as IM import SDL import Data.Maybe import qualified Data.Set as S import Control.Lens +import Picture + handleKeyboardEvent :: KeyboardEventData -> World -> Maybe World handleKeyboardEvent kev w = case keyboardEventKeyMotion kev of Released -> Just $ w & keys %~ S.delete kcode @@ -35,11 +42,13 @@ handlePressedKey _ scancode w -- Rotation seems to be duplicated here and in Camera.hs ? why | scancode == rotateCameraPlusKey (_keyConfig w) = Just $ w {_cameraRot = _cameraRot w + 0.01} | scancode == rotateCameraMinusKey (_keyConfig w) = Just $ w {_cameraRot = _cameraRot w - 0.01} - | scancode == ScancodeF7 = Just $ w {_varMovementSpeedModifier = _varMovementSpeedModifier w - 1} - | scancode == ScancodeF8 = Just $ w {_varMovementSpeedModifier = _varMovementSpeedModifier w + 1} + | scancode == ScancodeF11 = Just $ w {_debugMode = not $ _debugMode w} + | _debugMode w && scancode == ScancodeF7 = Just $ w {_varMovementSpeedModifier = _varMovementSpeedModifier w - 1} + | _debugMode w && scancode == ScancodeF8 = Just $ w {_varMovementSpeedModifier = _varMovementSpeedModifier w + 1} + | _debugMode w && scancode == ScancodeF5 = Just $ dropLight w + | _debugMode w && scancode == ScancodeF6 = Just $ dropLight' w handlePressedKey _ _ w = Just w - spaceAction :: World -> World spaceAction w = case listToMaybe $ _closeActiveObjects w of Just (Left flit) -> pickUpItem' flit w @@ -54,3 +63,24 @@ pauseGame w = w {_menuState = PauseMenu} toggleMap w = w & carteDisplay %~ not escapeMap w = w & carteDisplay .~ False + +dropLight :: World -> World +dropLight w = placeLS ls dec pos 0 + -- $ over creatures IM.insert i (lamp) + $ w + --case yourItem w of + --NoItem -> w + --it -> rmInvItem (_yourID w) $ over floorItems (IM.insert flid theflit) + -- gg $ updateLocation + -- $ soundOnce putDownSound + -- $ set randGen g w + where --(rot, g) = randomR (-pi,pi) $ _randGen w + i = newCrKey w -- to give different lights different keys + pos = _crPos(you w) + ls = lightAt pos 0 + dec = onLayer PtLayer $ color white $ circleSolid 8 + +dropLight' :: World -> World +dropLight' w = placeCr lamp pos 0 w + where + pos = _crPos(you w) \ No newline at end of file From 5e885b879bca29943d74f7bf2474a39ce15ef79a Mon Sep 17 00:00:00 2001 From: Ross Date: Tue, 30 Mar 2021 22:43:40 +0100 Subject: [PATCH 2/3] start debug mode --- app/Main.hs | 17 +++++++++++------ src/Dodge/Event/Keyboard.hs | 17 +++++++++++++---- 2 files changed, 24 insertions(+), 10 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index 7385911da..24c8e1c81 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -69,12 +69,17 @@ main = do endTicks <- SDL.ticks let lastFrameTicks = _frameTimer preData - renderFoldable - (_renderData preData) - (picToLTree Nothing . setLayer 1 . setDepth (-1) - . translate (-0.5) (-0.8) . scale 0.0005 0.0005 - . text $ "ms/frame " ++ show (endTicks - lastFrameTicks) - ) + if (_debugMode w) then + renderFoldable + (_renderData preData) + (picToLTree Nothing . setLayer 1 . setDepth (-1) + . translate (-0.5) (-0.8) . scale 0.0005 0.0005 + . text $ "ms/frame " ++ show (endTicks - lastFrameTicks) + ) + else + -- ? Why (or rather how to avoid) + return endTicks + return $ preData & soundData .~ newSoundData & frameTimer .~ endTicks ) diff --git a/src/Dodge/Event/Keyboard.hs b/src/Dodge/Event/Keyboard.hs index 64e35b3aa..63455b5b3 100644 --- a/src/Dodge/Event/Keyboard.hs +++ b/src/Dodge/Event/Keyboard.hs @@ -44,12 +44,21 @@ handlePressedKey _ scancode w | scancode == rotateCameraPlusKey (_keyConfig w) = Just $ w {_cameraRot = _cameraRot w + 0.01} | scancode == rotateCameraMinusKey (_keyConfig w) = Just $ w {_cameraRot = _cameraRot w - 0.01} | scancode == ScancodeF11 = Just $ w {_debugMode = not $ _debugMode w} - | _debugMode w && scancode == ScancodeF7 = Just $ w {_varMovementSpeedModifier = _varMovementSpeedModifier w - 1} - | _debugMode w && scancode == ScancodeF8 = Just $ w {_varMovementSpeedModifier = _varMovementSpeedModifier w + 1} - | _debugMode w && scancode == ScancodeF5 = Just $ dropLight w - | _debugMode w && scancode == ScancodeF6 = Just $ dropLight' w + | _debugMode w = debugKey scancode w + -- | _debugMode w && scancode == ScancodeF7 = Just $ w {_varMovementSpeedModifier = _varMovementSpeedModifier w - 1} + -- | _debugMode w && scancode == ScancodeF8 = Just $ w {_varMovementSpeedModifier = _varMovementSpeedModifier w + 1} + -- | _debugMode w && scancode == ScancodeF5 = Just $ dropLight w + -- | _debugMode w && scancode == ScancodeF6 = Just $ dropLight' w 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 +debugKey _ w = Just w + spaceAction :: World -> World spaceAction w = case listToMaybe $ _closeActiveObjects w of Just (Left flit) -> pickUpItem' flit w From b75c24e384aaff890329477541352177fd9acbed Mon Sep 17 00:00:00 2001 From: Ross Date: Fri, 2 Apr 2021 09:59:25 +0100 Subject: [PATCH 3/3] basicWorld --- app/Main.hs | 77 +++++++++++++++++++++++++---------------------------- 1 file changed, 37 insertions(+), 40 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index 2ca918a54..755bffe0f 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,39 +1,39 @@ module Main where -import Loop -import Shader -import LoadConfig -import Dodge.Default -import Dodge.Data -import Dodge.Initialisation -import Dodge.Rooms -import Dodge.Layout -import Dodge.LoadSound -import Dodge.Update -import Dodge.Event -import Dodge.Render -import Dodge.Menu -import Dodge.Floor -import Dodge.LoadConfig -import Dodge.LoadSound -import Picture -import Picture.Render -import Picture.Preload -import Sound -import Preload -import Sound.Preload +import Dodge.Data +import Dodge.Default +import Dodge.Event +import Dodge.Floor +import Dodge.Initialisation +import Dodge.Layout +import Dodge.LoadConfig +import Dodge.LoadSound +import Dodge.Menu +import Dodge.Render +import Dodge.Rooms +import Dodge.Update +import LoadConfig +import Loop +import Picture +import Picture.Preload +import Picture.Render +import Preload +import Shader +import Sound +import Sound.Preload -import Control.Concurrent -import Control.Lens -import Foreign (Word32) +import Control.Concurrent +import Control.Lens +import Foreign (Word32) -import Control.Monad (when) - -import System.Random +import Control.Monad (void, when) -import qualified Data.Map as M +import System.Random + +import qualified Data.Map as M +import Graphics.Rendering.OpenGL hiding (color, rotate, scale, + translate) import qualified SDL -import qualified SDL.Mixer as Mix -import Graphics.Rendering.OpenGL hiding (color,scale,translate,rotate) +import qualified SDL.Mixer as Mix doPreload' :: IO (PreloadData a) doPreload' = do @@ -46,7 +46,7 @@ main :: IO () main = do (sizex,sizey) <- loadConfig keyConfig <- loadKeyConfig - setupLoop + setupLoop (sizex,sizey) (SDL.cursorVisible $= False >> doPreload' >>= resizeSpareFBO sizex sizey) (\x -> (SDL.cursorVisible $= True) >> cleanUpPreload x) @@ -59,16 +59,13 @@ main = do endTicks <- SDL.ticks let lastFrameTicks = _frameTimer preData - if (_debugMode w) then - renderFoldable - (_renderData preData) - (picToLTree Nothing . setLayer 1 . setDepth (-1) - . translate (-0.5) (-0.8) . scale 0.0005 0.0005 + when (_debugMode w) $ void $ renderFoldable + (_renderData preData) + (picToLTree Nothing . setLayer 1 . setDepth (-1) + . translate (-0.5) (-0.8) . scale 0.0005 0.0005 . text $ "ms/frame " ++ show (endTicks - lastFrameTicks) ) - else - -- ? Why (or rather how to avoid) - return endTicks + return $ preData & soundData .~ newSoundData & frameTimer .~ endTicks