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
+45 -23
View File
@@ -12,32 +12,34 @@ Instead we store the events in a set, and deal with the combinations in
module Dodge.Event
( handleEvent
) where
import Dodge.Combine
import Dodge.Event.Keyboard
import Dodge.Terminal
import Dodge.Combine
import Dodge.Event.Keyboard
--import Dodge.Event.Menu
import Dodge.Base
import Dodge.Data
import Dodge.Base
import Dodge.Data
--import Dodge.Base.Window
import Dodge.PreloadData
import Dodge.PreloadData
--import Dodge.Creature.Action
import Dodge.Inventory
import Dodge.Inventory.Add
import Dodge.SoundLogic
import Dodge.Inventory
import Dodge.Inventory.Add
import Dodge.SoundLogic
--import Geometry
--import Preload.Update
import Dodge.FloorItem
import Dodge.FloorItem
import qualified IntMapHelp as IM
import ListHelp
import ListHelp
--import Data.Monoid
import Control.Lens
import Data.Maybe
import Control.Lens
import Data.Maybe
--import Data.Maybe
--import Data.Char
--import Data.List
--import Data.Function (on)
import qualified Data.Set as S
import SDL
import qualified Data.Text as T
import SDL
handleEvent :: Event -> Universe -> IO (Maybe Universe)
handleEvent e = case eventPayload e of
@@ -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
+42 -38
View File
@@ -3,19 +3,22 @@ module Dodge.Event.Keyboard
( handleKeyboardEvent
, handleTextInput
) where
import qualified Data.IntMap.Strict as IM
import Dodge.Base
import Dodge.Combine
import Dodge.Creature.Action
import Dodge.Data
import Dodge.Event.Menu
import Dodge.Event.Test
import Dodge.Inventory
import Dodge.Menu
import Dodge.Reloading
import Dodge.Save
import Dodge.Terminal
import Dodge.Base
import Dodge.Combine
import Dodge.Creature.Action
import Dodge.Data
import Dodge.Event.Menu
import Dodge.Event.Test
import Dodge.Inventory
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}