From 8de5cfcb18b9b772c2a3b07fc397ce66fd6906e5 Mon Sep 17 00:00:00 2001
From: Ross <xkjq@ymail.com>
Date: Mon, 29 Mar 2021 08:02:55 +0100
Subject: [PATCH] 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