justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Add basic prompt

Browse Source
This commit is contained in:
jgk
2021-05-23 16:24:11 +02:00
parent afafc245ef
commit b337fbdab9
12 changed files with 82 additions and 27 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Data.hs
+2 -1
View File
@@ -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
+1
View File
@@ -10,4 +10,5 @@ data MenuLayer
| GraphicsOptionMenu
| ControlList
| WaitMessage String Int
| Terminal String
deriving (Eq,Ord)
src/Dodge/Debug/Flag.hs
+3
View File
@@ -0,0 +1,3 @@
module Dodge.Debug.Flag
where
src/Dodge/Debug/Flag/Data.hs
+10
View File
@@ -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
+10
View File
@@ -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
+7 -1
View File
@@ -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
+25 -20
View File
@@ -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
debugKey scancode w
| scancode == ScancodeF5 = Just $ dropLight w
| scancode == ScancodeF6 = Just $ dropLight' w
debugKey _ w = Just w
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 == 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
+15
View File
@@ -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
+3 -3
View File
@@ -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
. addRoomLinkDecorations rs
-- . addRoomPolyDecorations rs
-- . addRoomLinkDecorations rs
$ w { _walls = wallsFromRooms rs
}
where
src/Dodge/Render/MenuScreen.hs
+1
View File
@@ -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
+3 -1
View File
@@ -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