Merge branch 'testing'

app/Main.hs

@@ -22,19 +22,20 @@ import Preload
 import Sound.Data
 import Music
 
-import Control.Concurrent
-import Control.Lens
-import Foreign (Word32)
+import           Control.Concurrent
+import           Control.Lens
+import           Foreign                   (Word32)
 
 import Control.Monad (when,void)
  
 import System.Random
 
-import qualified Data.Map as M
-import qualified Data.IntMap as IM
+
+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
@@ -55,7 +56,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)
@@ -68,12 +69,14 @@ 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)
-                )
+            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)
+                        )
+
+
             return $ preData & soundData . playingSounds .~ newPlayingSounds
                              & frameTimer .~ endTicks
         )

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)