Add basic prompt

app/Main.hs

@@ -11,6 +11,7 @@ import Dodge.Config.KeyConfig
 import Dodge.Config.Load
 import Dodge.Config.Update
 import Dodge.LoadSound
+import Dodge.Debug.Flag.Data
 import Picture
 import Picture.Render
 import Picture.Preload
@@ -52,7 +53,7 @@ doSideEffects preData w = do
     
     endTicks <- SDL.ticks
     let lastFrameTicks = _frameTimer preData
-    when (_debugMode w) $ void $ renderFoldable
+    when (_displaySecondsPerFrame $ _debugFlags w) $ void $ renderFoldable
                 (_renderData preData)
                 (picToLTree Nothing . setLayer 1 . setDepth (-1)
                     . translate (-0.5) (-0.8) . scale 0.0005 0.0005

src/Dodge/Data.hs

@@ -18,6 +18,7 @@ module Dodge.Data
 import Dodge.Creature.State.Data
 import Dodge.Creature.Stance.Data
 import Dodge.Creature.AlertLevel.Data
+import Dodge.Debug.Flag.Data
 import Dodge.Data.Menu
 import Dodge.Data.SoundOrigin
 import Dodge.Data.DamageType
@@ -91,10 +92,10 @@ data World = World
     , _seenLocations        :: IM.IntMap (World -> Point2,String)
     , _selLocation          :: Int
     , _keyConfig            :: KeyConfigSDL
-    , _debugMode            :: Bool
     , _config               :: Configuration
     , _sideEffects          :: [PreloadData SoundOrigin -> IO (PreloadData SoundOrigin)]
     , _doneSideEffects      :: [PreloadData SoundOrigin -> IO (PreloadData SoundOrigin)]
+    , _debugFlags           :: DebugFlags
     }
 data CrGroupParams = CrGroupParams
     { _crGroupParamID   :: Int

src/Dodge/Data/Menu.hs

@@ -10,4 +10,5 @@ data MenuLayer
     | GraphicsOptionMenu
     | ControlList
     | WaitMessage String Int
+    | Terminal String
   deriving (Eq,Ord)

src/Dodge/Debug/Flag.hs

@@ -0,0 +1,3 @@
+module Dodge.Debug.Flag
+    where
+

src/Dodge/Debug/Flag/Data.hs

@@ -0,0 +1,10 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE StrictData #-}
+module Dodge.Debug.Flag.Data
+    where
+import Control.Lens
+data DebugFlags = DebugFlags
+    { _noClip :: Bool
+    , _displaySecondsPerFrame :: Bool
+    }
+makeLenses ''DebugFlags

src/Dodge/Debug/Terminal.hs

@@ -0,0 +1,10 @@
+module Dodge.Debug.Terminal
+    where
+import Dodge.Data
+import Dodge.Debug.Flag.Data
+
+import Control.Lens
+
+applyTerminalString :: String -> World -> World
+applyTerminalString "NOCLIP" w = w & debugFlags . noClip %~ not
+applyTerminalString _ w = w

src/Dodge/Default.hs

@@ -10,6 +10,7 @@ import Dodge.Data
 import Dodge.Creature.Stance.Data
 import Dodge.Creature.State.Data
 import Dodge.Creature.AlertLevel.Data
+import Dodge.Debug.Flag.Data
 import Dodge.Data.Menu
 import Dodge.SoundLogic
 import Dodge.Base
@@ -272,10 +273,15 @@ defaultWorld = World
         ]
     , _selLocation = 0
     , _keyConfig = defaultKeyConfigSDL
-    , _debugMode = True
     , _config       = defaultConfig
     , _sideEffects          = []
     , _doneSideEffects      = []
+    , _debugFlags = defaultDebugFlags
+    }
+defaultDebugFlags :: DebugFlags
+defaultDebugFlags = DebugFlags
+    { _noClip = False
+    , _displaySecondsPerFrame = True
     }
 youLight :: TempLightSource
 youLight = 

src/Dodge/Event/Keyboard.hs

@@ -37,32 +37,37 @@ handleKeyboardEvent kev w = case keyboardEventKeyMotion kev of
   where
     kcode = (keysymScancode . keyboardEventKeysym) kev
 
-handlePressedKeyInGame :: Scancode -> World -> Maybe World
-handlePressedKeyInGame scode w
-    |  scode == escapeKey (_keyConfig w) = Nothing
-    |  scode == pauseKey (_keyConfig w) = Just $ pauseGame $ escapeMap w
-    |  scode == dropItemKey (_keyConfig w) = Just $ youDropItem w
-    |  scode == toggleMapKey (_keyConfig w) = Just $ toggleMap w
-    |  scode == reloadKey (_keyConfig w) = Just $ fromMaybe w $ startReloadingWeapon (_yourID w) w
-    |  scode == testEventKey (_keyConfig w) = Just $ testEvent w
-    |  scode == spaceActionKey (_keyConfig w) = Just $ spaceAction w
-    |  scode == rotateCameraPlusKey (_keyConfig w)  = Just $ w & cameraRot +~ 0.01
-    |  scode == rotateCameraMinusKey (_keyConfig w) = Just $ w & cameraRot -~ 0.01
-    |  scode ==   ScancodeF11      = Just $ w {_debugMode = not $ _debugMode w} 
-    | _debugMode w = debugKey scode w
-handlePressedKeyInGame _ w = Just w
-
 handlePressedKey :: Bool -> Scancode -> World -> Maybe World
 handlePressedKey True _     w   = Just w
+handlePressedKey _    ScancodeSemicolon w | not (inTerminal w) = Just $ gotoTerminal w
 handlePressedKey _    scode w
     | null (_menuLayers w)      = handlePressedKeyInGame scode w
     | otherwise                 = handlePressedKeyInMenu (head $ _menuLayers w) scode w
 
-debugKey :: Scancode -> World -> Maybe World 
+handlePressedKeyInGame :: Scancode -> World -> Maybe World
-debugKey scancode w
+handlePressedKeyInGame scode w
-    | scancode == ScancodeF5 = Just $ dropLight w 
+    | scode == escapeKey (_keyConfig w) = Nothing
-    | scancode == ScancodeF6 = Just $ dropLight' w 
+    | scode == pauseKey (_keyConfig w) = Just $ pauseGame $ escapeMap w
-debugKey _ w = Just w
+    | scode == dropItemKey (_keyConfig w) = Just $ youDropItem w
+    | scode == toggleMapKey (_keyConfig w) = Just $ toggleMap w
+    | scode == reloadKey (_keyConfig w) = Just $ fromMaybe w $ startReloadingWeapon (_yourID w) w
+    | scode == testEventKey (_keyConfig w) = Just $ testEvent w
+    | scode == spaceActionKey (_keyConfig w) = Just $ spaceAction w
+    | scode == rotateCameraPlusKey (_keyConfig w)  = Just $ w & cameraRot +~ 0.01
+    | scode == rotateCameraMinusKey (_keyConfig w) = Just $ w & cameraRot -~ 0.01
+    | scode == ScancodeF5 = Just $ dropLight w 
+    | scode == ScancodeF6 = Just $ dropLight' w 
+handlePressedKeyInGame _ w = Just w
+
+
+inTerminal :: World -> Bool
+inTerminal w = case _menuLayers w of
+    (Terminal _ : _) -> True
+    _ -> False
+gotoTerminal :: World -> World
+gotoTerminal w = case _menuLayers w of
+    (Terminal _ : _ ) ->  w
+    _ -> w & menuLayers %~ (Terminal [] :)
 
 spaceAction :: World -> World
 spaceAction w = if _carteDisplay w

src/Dodge/Event/Menu.hs

@@ -11,14 +11,21 @@ import Dodge.Config.Data
 import Dodge.Config.Update
 import Dodge.Layout
 import Preload.Update
+import Dodge.Debug.Terminal
 
 import Data.Maybe
 --import qualified Data.Set as S
 import Control.Lens
 import SDL
+import SDL.Internal.Numbered
 
 handlePressedKeyInMenu :: MenuLayer -> Scancode -> World -> Maybe World
 handlePressedKeyInMenu mState scode w = case mState of
+    Terminal s -> case scode of
+        ScancodeEscape  -> popMenu w
+        ScancodeReturn  -> popMenu $ applyTerminalString s w
+        ScancodeBackspace -> popMenu w >>= pushMenu (Terminal $ dropLast s)
+        _               -> popMenu w >>= pushMenu (Terminal $ s ++ [scodeToChar scode])
     LevelMenu _ -> case scode of
         ScancodeEscape  -> Nothing
         ScancodeO       -> pushMenu OptionMenu w
@@ -72,6 +79,12 @@ handlePressedKeyInMenu mState scode w = case mState of
     aNewGame = updateFramebufferSize $ generateLevelFromRoomList levx $ initialWorld 
         & randGen .~ _randGen w
         & config .~ _config w
+    dropLast (x:xs) = init (x:xs)
+    dropLast _ = []
+
+-- | hacky
+scodeToChar :: Scancode -> Char
+scodeToChar = toEnum . (+ 61) . fromIntegral . toNumber
 
 updateFramebufferSize :: World -> World
 updateFramebufferSize w = w & sideEffects 
@@ -91,3 +104,5 @@ storeLevel :: World -> World
 storeLevel w = case _storedLevel w of
                  Nothing -> w & storedLevel ?~ w
                  _       -> w
+
+

src/Dodge/Layout.hs

@@ -13,7 +13,7 @@ import Dodge.Default
 import Geometry
 import Dodge.Room.Link
 import qualified IntMapHelp as IM
-import Dodge.Debug.LinkDecoration
+--import Dodge.Debug.LinkDecoration
 
 import Control.Monad.State
 import Control.Lens
@@ -27,8 +27,8 @@ import qualified Data.Map as M
 generateLevelFromRoomList :: State StdGen [Room] -> World -> World
 generateLevelFromRoomList gr w = updateWallZoning 
     . placeSpots plmnts
-    . addRoomPolyDecorations rs
+--    . addRoomPolyDecorations rs
-    . addRoomLinkDecorations rs
+--    . addRoomLinkDecorations rs
     $ w { _walls = wallsFromRooms rs
         }
   where

src/Dodge/Render/MenuScreen.hs

@@ -50,6 +50,7 @@ menuScreen cfig hw hh mLays = case mLays of
         ,controlsList
         ]
     (WaitMessage s _ : _) -> optionsList hw hh s []
+    (Terminal s : _)    -> optionsList hw hh "SCANCODE INPUT" ['>':s ++ "_"]
     _ -> blank
   where 
     tst x y sc t = translate x y $ scale sc sc $ color white $ text t

src/Dodge/WallCreatureCollisions.hs

@@ -2,6 +2,7 @@
 module Dodge.WallCreatureCollisions where
 import Dodge.Data
 import Dodge.Creature.State.Data
+import Dodge.Debug.Flag.Data
 import Dodge.Base
 import Geometry
 
@@ -16,7 +17,7 @@ colCrsWalls w = over creatures (fmap (colCrWall w)) w
 
 colCrWall :: World -> Creature -> Creature
 colCrWall w c 
-    | _crID c == 0 = c -- for noclip
+    | noclipIsOn && _crID c == 0 = c -- for noclip
     | p1 == p2  = pushOrCrush ls c
     | otherwise = c & crPos %~
         collideCorners rad wallPoints
@@ -28,6 +29,7 @@ colCrWall w c
     p2  = _crPos c
     ls  = IM.elems $ _wlLine <$> wallsNearPoint p2 w
     wallPoints = nub $ concatMap (\(x,y) -> [x,y]) ls
+    noclipIsOn = _noClip $ _debugFlags w
 
 -- colCrPushThrough :: World -> Creature -> Creature
 -- colCrPushThrough w cr = set crPos (checkPushThroughs rad p1 p2 ls) cr