Merge branch 'testing'

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

src/Dodge/Data.hs

@@ -78,6 +78,7 @@ data World = World
     , _keyConfig            :: KeyConfigSDL
     , _varMovementSpeedModifier :: Float
     , _varMovementStrafeSpeedModifier :: Float
+    , _debugMode :: Bool
     } 
 
 data Corpse = Corpse

src/Dodge/Default.hs

@@ -234,6 +234,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) ) 

src/Dodge/Event/Keyboard.hs

@@ -6,6 +6,11 @@ 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 Dodge.Event.Test
 
 import SDL
@@ -13,6 +18,8 @@ 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
@@ -36,10 +43,21 @@ 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 = 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
@@ -52,3 +70,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)