debug mode

This commit is contained in:
Ross
2021-03-29 08:02:55 +01:00
parent 4360c3b530
commit 8de5cfcb18
4 changed files with 36 additions and 3 deletions
+1
View File
@@ -13,6 +13,7 @@ import Dodge.Base
import Dodge.SoundLogic import Dodge.SoundLogic
import Dodge.WorldEvent import Dodge.WorldEvent
import Dodge.Inventory import Dodge.Inventory
import Dodge.LightSources
import Geometry import Geometry
import Picture import Picture
+1
View File
@@ -76,6 +76,7 @@ data World = World
, _keyConfig :: KeyConfigSDL , _keyConfig :: KeyConfigSDL
, _varMovementSpeedModifier :: Float , _varMovementSpeedModifier :: Float
, _varMovementStrafeSpeedModifier :: Float , _varMovementStrafeSpeedModifier :: Float
, _debugMode :: Bool
} }
data Corpse = Corpse data Corpse = Corpse
+1
View File
@@ -232,6 +232,7 @@ defaultWorld = World
, _keyConfig = defaultKeyConfigSDL , _keyConfig = defaultKeyConfigSDL
, _varMovementSpeedModifier = 3 , _varMovementSpeedModifier = 3
, _varMovementStrafeSpeedModifier = 3 , _varMovementStrafeSpeedModifier = 3
, _debugMode = False
} }
youLight = youLight =
-- LS {_lsEff = \w _ p -> (logistic 1 1 1 (d p w * 0.01) ) -- LS {_lsEff = \w _ p -> (logistic 1 1 1 (d p w * 0.01) )
+33 -3
View File
@@ -6,12 +6,19 @@ import Dodge.Data
import Dodge.Base import Dodge.Base
import Dodge.CreatureAction import Dodge.CreatureAction
import Dodge.LoadConfig 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 SDL
import Data.Maybe import Data.Maybe
import qualified Data.Set as S import qualified Data.Set as S
import Control.Lens import Control.Lens
import Picture
handleKeyboardEvent :: KeyboardEventData -> World -> Maybe World handleKeyboardEvent :: KeyboardEventData -> World -> Maybe World
handleKeyboardEvent kev w = case keyboardEventKeyMotion kev of handleKeyboardEvent kev w = case keyboardEventKeyMotion kev of
Released -> Just $ w & keys %~ S.delete kcode 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 -- Rotation seems to be duplicated here and in Camera.hs ? why
| scancode == rotateCameraPlusKey (_keyConfig w) = Just $ w {_cameraRot = _cameraRot w + 0.01} | scancode == rotateCameraPlusKey (_keyConfig w) = Just $ w {_cameraRot = _cameraRot w + 0.01}
| scancode == rotateCameraMinusKey (_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 == ScancodeF11 = Just $ w {_debugMode = not $ _debugMode w}
| scancode == ScancodeF8 = Just $ w {_varMovementSpeedModifier = _varMovementSpeedModifier w + 1} | _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 handlePressedKey _ _ w = Just w
spaceAction :: World -> World spaceAction :: World -> World
spaceAction w = case listToMaybe $ _closeActiveObjects w of spaceAction w = case listToMaybe $ _closeActiveObjects w of
Just (Left flit) -> pickUpItem' flit w Just (Left flit) -> pickUpItem' flit w
@@ -54,3 +63,24 @@ pauseGame w = w {_menuState = PauseMenu}
toggleMap w = w & carteDisplay %~ not toggleMap w = w & carteDisplay %~ not
escapeMap w = w & carteDisplay .~ False 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)