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

Work on terminals: allow scrolling to get default inputs

Browse Source
This commit is contained in:
justin
2022-06-01 22:22:46 +01:00
parent 0585236a01
commit 0da298bde9
10 changed files with 140 additions and 95 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Data.hs
+20 -8
View File
@@ -137,6 +137,7 @@ data World = World
, _timeFlow :: TimeFlowStatus
, _worldClock :: Int
, _doubleMouseHammer :: HammerPosition
, _backspaceTimer :: Int
}
data HUDElement
@@ -386,22 +387,23 @@ data TerminalParams = NoTerminalParams | TerminalParams
, _termFutureLines :: [TerminalLine]
, _termMaxLines :: Int
, _termTitle :: String
, _termSel :: Maybe Int
, _termOptions :: [(String, World -> World)]
, _termInput :: Maybe (T.Text, String -> World -> World)
, _termSel :: Maybe (Int,Int)
-- , _termOptions :: [(String, World -> World)]
, _termInput :: Maybe T.Text
, _termCommands :: [TerminalCommand]
}
data TerminalLine
= TerminalLineDisplay
{_tlPause :: Int
,_tlString :: World -> (String, Color)
}
| TerminalLineChoice
{_tlPause :: Int
,_tlOptions :: [(String,World -> World)]
}
-- | TerminalLineChoice
-- {_tlPause :: Int
-- ,_tlOptions :: [(String,World -> World)]
-- }
| TerminalLineInput
{_tlPause :: Int
,_tlInputFunction :: String -> World -> World
,_tlCommands :: [TerminalCommand]
}
| TerminalLineEffect
{_tlPause :: Int
@@ -1316,6 +1318,15 @@ data CreatureState = CrSt
, _crDropsOnDeath :: CreatureDropType
}
data TerminalCommand = TerminalCommand
{ _tcString :: String
, _tcAlias :: [String]
, _tcHelp :: String
, _tcArgumentType :: Maybe String
, _tcArguments :: World -> [String]
, _tcEffect :: [String] -> World -> Either String World
}
makeLenses ''CreatureState
makeLenses ''Damage
makeLenses ''DamageEffect
@@ -1381,3 +1392,4 @@ makeLenses ''RightButtonOptions
makeLenses ''AllocateEquipment
makeLenses ''ActivateEquipment
makeLenses ''EquipParams
makeLenses ''TerminalCommand
src/Dodge/Default/World.hs
+1
View File
@@ -96,6 +96,7 @@ defaultWorld = World
, _rewindWorlds = []
, _timeFlow = NormalTimeFlow
, _doubleMouseHammer = HammerUp
, _backspaceTimer = 0
}
youLight :: TempLightSource
youLight =
src/Dodge/Event.hs
+32 -10
View File
@@ -12,6 +12,7 @@ Instead we store the events in a set, and deal with the combinations in
module Dodge.Event
( handleEvent
) where
import Dodge.Terminal
import Dodge.Combine
import Dodge.Event.Keyboard
--import Dodge.Event.Menu
@@ -37,6 +38,7 @@ import Data.Maybe
--import Data.List
--import Data.Function (on)
import qualified Data.Set as S
import qualified Data.Text as T
import SDL
handleEvent :: Event -> Universe -> IO (Maybe Universe)
@@ -92,13 +94,14 @@ handlePressedMouseButton :: MouseButton -> Universe -> Maybe Universe
handlePressedMouseButton but w = case (_hudElement (_hud $ _uvWorld w), but) of
(DisplayCarte,_) -> Just $ w & uvWorld . clickMousePos .~ _mousePos (_uvWorld w)
(_,ButtonMiddle) -> Just $ w & uvWorld . clickMousePos .~ _mousePos (_uvWorld w)
( DisplayInventory (DisplayTerminal tp _) , ButtonLeft)
-> Just $ fromMaybe w
$ do -- ugly
i <- _termSel tp
f <- _termOptions tp !? i
return $ w & uvWorld %~ snd f
-- & uvWorld . hud . hudElement .~ DisplayInventory NoSubInventory
( DisplayInventory (DisplayTerminal _ _) , ButtonLeft)
-> Just $ over uvWorld doTerminalEffect w
-- -> Just $ fromMaybe w
-- $ do -- ugly
-- i <- _termSel tp
-- f <- _termOptions tp !? i
-- return $ w & uvWorld %~ snd f
---- & uvWorld . hud . hudElement .~ DisplayInventory NoSubInventory
( DisplayInventory (CombineInventory mi) , ButtonLeft)
-> Just $ fromMaybe (w & uvWorld . hud . hudElement .~ DisplayInventory NoSubInventory)
$ do -- ugly
@@ -147,11 +150,30 @@ wheelEvent y w = case _hudElement $ _hud w of
| otherwise -> w & moveTweakSel yi
DisplayInventory (CombineInventory _) -> w
& hud . hudElement . subInventory . combineInvSel . _Just %~ ((`mod` numcombs) . subtract yi)
DisplayInventory (DisplayTerminal tp _) -> w
& hud . hudElement . subInventory . termParams . termSel . _Just
%~ ((`mod` length (_termOptions tp)) . subtract yi)
DisplayInventory (DisplayTerminal tp _)
| rbDown -> w
& hud . hudElement . subInventory . termParams %~ updatetermsubsel
| otherwise -> w
& hud . hudElement . subInventory . termParams %~ updatetermsel
_ -> w
where
updatetermsel tp = case _termSel tp of
Nothing -> tp & termSel ?~ (0,0)
& termInput . _Just %~ replacewith tp 0
Just (i,_) -> let newi = ((`mod` length (_termCommands tp)) . subtract yi) i
in tp & termSel . _Just .~ (newi,0)
& termInput . _Just %~ replacewith tp newi
updatetermsubsel tp = case _termSel tp of
Nothing -> tp
Just (i,j) -> let newj = (j - yi) `mod` (1 + length (_tcArguments (_termCommands tp !! i) w))
in tp & termSel . _Just .~ (i,newj)
& termInput . _Just %~ replacewith' tp i newj w
replacewith tp newi _ = T.pack (_tcString (_termCommands tp !! newi))
replacewith' tp i j w _ = T.pack $ _tcString tc ++ " " ++ arg-- ++ ((_tcArguments tp) w !! j)
where
arg :: String
arg = (("":(_tcArguments tc w) )!! j)
tc = _termCommands tp !! i
numcombs = length $ combineItemListYou w
yi = round $ signum y
numLocs = (fst . IM.findMax $ _seenLocations w) + 1
src/Dodge/Event/Keyboard.hs
+32 -28
View File
@@ -3,7 +3,7 @@ module Dodge.Event.Keyboard
( handleKeyboardEvent
, handleTextInput
) where
import qualified Data.IntMap.Strict as IM
import Dodge.Terminal
import Dodge.Base
import Dodge.Combine
import Dodge.Creature.Action
@@ -15,7 +15,10 @@ import Dodge.Menu
import Dodge.Reloading
import Dodge.Save
import LensHelp
--import Color
--import Data.List
import qualified Data.IntMap.Strict as IM
import Data.Maybe
import qualified Data.Set as S
import SDL
@@ -26,7 +29,7 @@ import qualified Data.Text as T
-- dealt with elsewhere
handleTextInput :: T.Text -> Universe -> IO (Maybe Universe)
handleTextInput text = return . Just . (menuLayers . ix 0 . scInput %~ updateText)
. (uvWorld . hud . hudElement . subInventory . termParams . termInput . _Just . _1 %~ updateText)
. (uvWorld . hud . hudElement . subInventory . termParams . termInput . _Just %~ updateText)
where
updateText s = case T.unpack text of
";" -> s
@@ -46,29 +49,33 @@ handleKeyboardEvent kev u = case keyboardEventKeyMotion kev of
scode = (keysymScancode . keyboardEventKeysym) kev
handlePressedKey :: Bool -> Scancode -> Universe -> IO (Maybe Universe)
handlePressedKey True _ w = return $ Just w
handlePressedKey _ scode w = case scode of
ScancodeF5 -> return . Just $ doQuicksave w
ScancodeF9 -> return . Just $ loadSaveSlot QuicksaveSlot w
ScancodeSemicolon -> return . Just $ gotoTerminal w
_ | null (_menuLayers w) -> case w ^? uvWorld . hud . hudElement . subInventory . termParams . termInput . _Just of
Just {} -> return $ uvWorld (handlePressedKeyTerminal scode) w
_ -> return $ uvWorld (handlePressedKeyInGame scode) w
_ -> handlePressedKeyInMenu (head $ _menuLayers w) scode w
handlePressedKey True ScancodeBackspace u
| _backspaceTimer (_uvWorld u) <= 0 = handlePressedKey False ScancodeBackspace u
<&> _Just . uvWorld . backspaceTimer .~ 0
| otherwise = return $ Just $ u & uvWorld . backspaceTimer -~ 1
handlePressedKey True _ u = return $ Just u
handlePressedKey _ scode u = case scode of
ScancodeF5 -> return . Just $ doQuicksave u
ScancodeF9 -> return . Just $ loadSaveSlot QuicksaveSlot u
ScancodeSemicolon -> return . Just $ gotoTerminal u
_ | null (_menuLayers u) -> case u ^? uvWorld . hud . hudElement . subInventory . termParams . termInput . _Just of
Just {} -> return $ uvWorld (handlePressedKeyTerminal scode) u
_ -> return $ uvWorld (Just . handlePressedKeyInGame scode) u
_ -> handlePressedKeyInMenu (head $ _menuLayers u) scode u
handlePressedKeyInGame :: Scancode -> World -> Maybe World
handlePressedKeyInGame :: Scancode -> World -> World
handlePressedKeyInGame scode w = case scode of
ScancodeEscape -> Just $ pauseGame $ escapeMap w
ScancodeSpace -> Just $ spaceAction w
ScancodeP -> Just $ pauseGame $ escapeMap w
ScancodeF -> Just $ youDropItem w
ScancodeM -> Just $ toggleMap w
ScancodeR -> Just $ fromMaybe w $ startReloadingWeapon (you w) w
ScancodeT -> Just $ testEvent w
ScancodeX -> Just $ w & hud . hudElement %~ toggleTweakInv
ScancodeC -> Just $ toggleCombineInv w
ScancodeI -> Just $ w & hud . hudElement %~ toggleInspectInv
_ -> Just w
ScancodeEscape -> pauseGame $ escapeMap w
ScancodeSpace -> spaceAction w
ScancodeP -> pauseGame $ escapeMap w
ScancodeF -> youDropItem w
ScancodeM -> toggleMap w
ScancodeR -> fromMaybe w $ startReloadingWeapon (you w) w
ScancodeT -> testEvent w
ScancodeX -> w & hud . hudElement %~ toggleTweakInv
ScancodeC -> toggleCombineInv w
ScancodeI -> w & hud . hudElement %~ toggleInspectInv
_ -> w
handlePressedKeyTerminal :: Scancode -> World -> Maybe World
@@ -76,16 +83,13 @@ handlePressedKeyTerminal scode w = case scode of
ScancodeEscape -> Just $ w & hud . hudElement . subInventory .~ NoSubInventory
ScancodeReturn -> Just $ w & doTerminalEffect
ScancodeBackspace -> Just $ w
& hud . hudElement . subInventory . termParams . termInput . _Just . _1 %~ doBackspace
& hud . hudElement . subInventory . termParams . termInput . _Just %~ doBackspace
& backspaceTimer .~ 5
_ -> Just w
where
doBackspace t = case T.unsnoc t of
Nothing -> t
Just (t',_) -> t'
doTerminalEffect w' = fromMaybe w' $ do
f <- w' ^? hud . hudElement . subInventory . termParams . termInput . _Just . _2
s <- w' ^? hud . hudElement . subInventory . termParams . termInput . _Just . _1
return $ f (T.unpack s) w'
toggleTweakInv :: HUDElement -> HUDElement
toggleTweakInv he = case he of
src/Dodge/Inventory.hs
+7 -6
View File
@@ -165,13 +165,14 @@ updateTerminalLine w = case w ^? hud . hudElement . subInventory . termParams .
Just (TerminalLineEffect _ eff) -> w
& hud . hudElement . subInventory . termParams . termFutureLines %~ tail
& eff (_subInventory . _hudElement $ _hud w)
Just (TerminalLineChoice _ ops) -> w
-- Just (TerminalLineChoice _ ops) -> w
-- & hud . hudElement . subInventory . termParams . termFutureLines %~ tail
-- & hud . hudElement . subInventory . termParams . termOptions .~ ops
-- & hud . hudElement . subInventory . termParams . termSel ?~ 0
Just (TerminalLineInput _ commands) -> w
& hud . hudElement . subInventory . termParams . termFutureLines %~ tail
& hud . hudElement . subInventory . termParams . termOptions .~ ops
& hud . hudElement . subInventory . termParams . termSel ?~ 0
Just (TerminalLineInput _ func) -> w
& hud . hudElement . subInventory . termParams . termFutureLines %~ tail
& hud . hudElement . subInventory . termParams . termInput ?~ (T.empty,func)
& hud . hudElement . subInventory . termParams . termInput ?~ T.empty
& hud . hudElement . subInventory . termParams . termCommands .~ commands
-- this looks ugly...
updateCloseObjects :: World -> World
src/Dodge/Placement/Instance/Analyser.hs
+2 -1
View File
@@ -72,8 +72,9 @@ analyser' starts sucs fails afters upf pslight psmc = extTrigLitPos pslight $ \t
, _termMaxLines = 7
, _termTitle = "ANALYSER"
, _termSel = Nothing
, _termOptions = []
-- , _termOptions = []
, _termInput = Nothing
, _termCommands = []
})
)
(\mc -> upf mc . (triggers . ix (fromJust $ _plMID tp) .~ const (_sensToggle $ _mcSensor mc))
src/Dodge/Placement/Instance/Terminal.hs
+3 -2
View File
@@ -58,7 +58,7 @@ termButton = Button
, _btID = 0
, _btText = "TERMINAL"
, _btState = BtOff
, _btTerminalParams = const $ TerminalParams [] [] 10 "TERMINAL" Nothing [] Nothing
, _btTerminalParams = const $ TerminalParams [] [] 10 "TERMINAL" Nothing Nothing []
}
@@ -115,8 +115,9 @@ genTermMessage f = \gp _ -> TerminalParams
,_termMaxLines = 7
,_termTitle = "TERMINAL"
,_termSel = Nothing
,_termOptions = []
-- ,_termOptions = []
,_termInput = Nothing
,_termCommands = []
}
where
totermline s = TerminalLineDisplay 0 (const (s,white))
src/Dodge/Render/HUD.hs
+5 -5
View File
@@ -88,13 +88,13 @@ subInventoryDisplay subinv cfig w = case subinv of
[ invHead cfig (_termTitle tp ++ ":T" ++ show tid)
, renderListAt subInvX 60 cfig
. displayTermInput tp
. (++ (map (\(str,_) -> (str,white)) (_termOptions tp)))
-- . (++ map (\(str,_) -> (str,white)) (_termOptions tp))
. reverse
. take (_termMaxLines tp)
$ _termDisplayedLines tp <&> ($ w)
, fromMaybe mempty $ do
cursori <- _termSel tp <&> (+ _termMaxLines tp)
return $ listCursorNSW subInvX 60 cfig cursori white 15 1
-- , fromMaybe mempty $ do
-- cursori <- _termSel tp <&> (+ _termMaxLines tp)
-- return $ listCursorNSW subInvX 60 cfig cursori white 15 1
]
CombineInventory mi -> pictures
[ invHead cfig "COMBINE"
@@ -124,7 +124,7 @@ subInventoryDisplay subinv cfig w = case subinv of
where
displayTermInput tp = case _termInput tp of
Nothing -> id
Just (s,_) -> (++ [('>':T.unpack s++clockCycle 10 (V.fromList ["_",""]) w,white)])
Just s -> (++ [('>':T.unpack s++clockCycle 10 (V.fromList ["_",""]) w,white)])
closeobjectcursor = case selectedCloseObject w of
Nothing -> mempty
Just (i,co) -> listCursorNS clObjFloatIn 0 cfig (selNumPos i w) (closeObjectCol co) topInvW (invSelSize i w)
src/Dodge/Room/Warning.hs
+10 -10
View File
@@ -1,5 +1,6 @@
{-# LANGUAGE TupleSections #-}
--{-# LANGUAGE TupleSections #-}
module Dodge.Room.Warning where
import Dodge.Terminal
import Dodge.LevelGen.Data
import Dodge.PlacementSpot
import Dodge.Placement.Instance.Terminal
@@ -34,6 +35,7 @@ import Data.Maybe
--import Data.Tree
import Control.Monad.State
import System.Random
--import qualified Data.Text as T
warningRooms :: RandomGen g => Int -> State g (LabSubCompTree Room)
@@ -51,7 +53,7 @@ addWarningTerminal outplid = (rmName .++~ "warningTerm-")
where
outplace = extTrigLitPos
(atFstLnkOutShiftBy (\(p,a) -> (p +.+ rotateV a (V2 18.5 (-2.5)), a)))
(\trid -> Just $ set plSpot (rprShift fps) $ putTerminal $ termMessages trid)
(Just . set plSpot (rprShift fps) . putTerminal . termMessages)
--termspot = atFstLnkOutShiftBy (\(p,a) -> (p +.+ rotateV a (V2 18.5 (-2.5)), a))
fps rp rm = case rp ^? rpLinkStatus . rplsChildNum of
Just 0 ->
@@ -66,15 +68,13 @@ addWarningTerminal outplid = (rmName .++~ "warningTerm-")
then Just (rtpos, rpdir)
else Just (ltpos, rpdir)
_ -> Nothing
termMessages trid = ops trid (genTermMessage $ const ["AVAILABLE COMMANDS:"
, " QUIT TOGGLE"
, replicate 50 'M'
])
termMessages trid = ops trid (genTermMessage $ const ["OPEN DOOR?"])
-- <&> termFutureLines %~ (++ [TerminalLineChoice 0 (ops trid)])
ops _ f gw w = f gw w & termFutureLines %~
(++ [ TerminalLineInput 0 (const id) ])
ops trid f gw w = f gw w & termFutureLines %~
(++ [ TerminalLineInput 0 [quitCommand,helpCommand,infoCommand theinfo,commandsCommand,unlockCommand trid]])
unlockCommand trid = singleCommand "OPEN" ["YES","Y"] "OPEN THE CONNECTED DOOR." (toggledoor trid)
-- (++ [ TerminalLineChoice 0 [ ("TOGGLE", toggledoor trid)
-- , ("EXIT", id)
-- ]])
--toggledoor trid w' = w' & triggers . ix (fromJust $ _plMID trid) .~ const True
toggledoor trid w' = w' & triggers . ix (fromJust $ _plMID trid) .~ const True
theinfo = "DOOR CONTROLABLE BY ENTERING \"OPEN\". THIS TERMINAL CANNOT CLOSE THE DOOR."
src/Dodge/Update/Camera.hs
+5 -2
View File
@@ -131,8 +131,11 @@ rotateCamera cfig w
| keyr = rotateCameraBy (-0.025) w
| otherwise = ifConfigWallRotate cfig w
where
keyl = SDL.ScancodeQ `S.member` _keys w
keyr = SDL.ScancodeE `S.member` _keys w
keyl = SDL.ScancodeQ `S.member` _keys w && notAtTerminal w
keyr = SDL.ScancodeE `S.member` _keys w && notAtTerminal w
notAtTerminal :: World -> Bool
notAtTerminal w = isNothing $ w ^? hud . hudElement . subInventory . termParams . termInput . _Just
--zoomCamBy :: Float -> World -> World
--zoomCamBy x w = w {_cameraZoom = max (_cameraZoom w + x) 0.01}