debug mode

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)