diff --git a/app/Main.hs b/app/Main.hs index 3d050df53..8f6c67879 100644 --- a/app/Main.hs +++ b/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 ) diff --git a/src/Dodge/CreatureAction.hs b/src/Dodge/CreatureAction.hs index 2b3337026..5935389ca 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 3d42315e7..7cb91d76d 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -78,6 +78,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 d7da21066..b597e786a 100644 --- a/src/Dodge/Default.hs +++ b/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) ) diff --git a/src/Dodge/Event/Keyboard.hs b/src/Dodge/Event/Keyboard.hs index 8c3df61de..63455b5b3 100644 --- a/src/Dodge/Event/Keyboard.hs +++ b/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) \ No newline at end of file