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

Partially successful change of terminals to external entities

Browse Source
This commit is contained in:
justin
2022-06-06 12:49:14 +01:00
parent 597336499c
commit eb38874102
12 changed files with 141 additions and 167 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/YourControl.hs
+2 -2
View File
@@ -15,8 +15,8 @@ import qualified Data.Set as S
import Data.Maybe
{- | The AI equivalent for your control. -}
yourControl :: Creature -> World -> World
yourControl cr w = case w ^? hud . hudElement . subInventory . termParams . termInput . _Just of
Just _ -> w
yourControl cr w = case w ^? hud . hudElement . subInventory . onInputLine of
Just True -> w
_ -> w
& creatures . ix (_crID cr) %~
(wasdWithAiming w (_mvSpeed $ _crMvType cr) . mouseActionsCr (_mouseButtons w))
src/Dodge/Data.hs
+8 -19
View File
@@ -203,8 +203,8 @@ data SubInventory
| InspectInventory
| LockedInventory
| DisplayTerminal
{_termParams :: TerminalParams
,_termID :: Int
{_termID :: Int
,_onInputLine :: Bool
}
-- deriving (Eq,Ord,Show)
@@ -408,18 +408,6 @@ data Button = Button
, _btTermMID :: Maybe Int
, _btName :: String
}
data TerminalParams = NoTerminalParams | TerminalParams
{ _termDisplayedLines :: [World -> (String,Color)]
, _termFutureLines :: [TerminalLine]
, _termMaxLines :: Int
, _termTitle :: String
, _termSel :: Maybe (Int,Int)
-- , _termOptions :: [(String, World -> World)]
, _termInput :: Maybe T.Text
, _termScrollCommands :: [TerminalCommand]
, _termWriteCommands :: [TerminalCommand]
, _termDeathCommand :: Maybe String
}
data TerminalLine
= TerminalLineDisplay
{_tlPause :: Int
@@ -432,7 +420,7 @@ data TerminalLine
}
| TerminalLineEffect
{_tlPause :: Int
,_tlEffect :: SubInventory -> World -> World
,_tlEffect :: Terminal -> World -> World
}
data ButtonState = BtOn | BtOff | BtNoLabel
deriving (Eq, Show)
@@ -948,9 +936,10 @@ data Block = Block
, _blMaterial :: BlockMaterial
}
data BlockMaterial = WoodBlock | DirtBlock | StoneBlock | GlassBlock | MetalBlock
data TerminalStatus = Connected | Disconnected
data Terminal = Terminal
{ _tmID :: Int
, _tmProgram :: Terminal -> World -> TerminalParams
, _tmProgram :: Terminal -> World -> [TerminalLine]
, _tmButtonID :: Int
, _tmMachineID :: Int
, _tmName :: String
@@ -963,6 +952,7 @@ data Terminal = Terminal
, _tmScrollCommands :: [TerminalCommand]
, _tmWriteCommands :: [TerminalCommand]
, _tmDeathEffect :: Terminal -> World -> World
, _tmStatus :: TerminalStatus
}
data Machine = Machine
{ _mcID :: Int
@@ -1384,8 +1374,8 @@ data TerminalCommand = TerminalCommand
, _tcAlias :: [String]
, _tcHelp :: String
, _tcArgumentType :: Maybe String
, _tcArguments :: World -> [String]
, _tcEffect :: [String] -> World -> Either String World
, _tcArguments :: Terminal -> World -> [String]
, _tcEffect :: [String] -> Terminal -> World -> Either String World
}
@@ -1601,7 +1591,6 @@ makeLenses ''Nozzle
makeLenses ''HUD
makeLenses ''HUDElement
makeLenses ''SubInventory
makeLenses ''TerminalParams
makeLenses ''TerminalLine
makeLenses ''ItemValue
makeLenses ''Equipment
src/Dodge/Default.hs
+2 -1
View File
@@ -244,7 +244,7 @@ defaultDrawButton col bt =
defaultTerminal :: Terminal
defaultTerminal = Terminal
{ _tmID = 0
, _tmProgram = (\_ _ -> NoTerminalParams)
, _tmProgram = (\_ _ -> [])
, _tmButtonID = 0
, _tmMachineID = 0
, _tmName = "TESTTERMINAL"
@@ -257,6 +257,7 @@ defaultTerminal = Terminal
, _tmScrollCommands = []
, _tmWriteCommands = []
, _tmDeathEffect = const id
, _tmStatus = Disconnected
}
defaultButton :: Button
src/Dodge/Event.hs
+24 -24
View File
@@ -94,8 +94,8 @@ 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 _ _) , ButtonLeft)
-> Just $ over uvWorld doTerminalEffect w
( DisplayInventory (DisplayTerminal tmid _) , ButtonLeft)
-> Just $ over uvWorld (doTerminalEffect (w ^?! uvWorld . terminals . ix tmid)) w
( DisplayInventory (CombineInventory mi) , ButtonLeft)
-> Just $ fromMaybe (w & uvWorld . hud . hudElement .~ DisplayInventory NoSubInventory)
$ do -- ugly
@@ -144,30 +144,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{}
| rbDown -> w
& hud . hudElement . subInventory . termParams %~ updatetermsubsel
| otherwise -> w
& hud . hudElement . subInventory . termParams %~ updatetermsel
-- DisplayInventory (DisplayTerminal tmid True)
-- | rbDown -> w
-- & terminals . ix tmid %~ updatetermsubsel
-- | otherwise -> w
-- & terminals . ix tmid %~ 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 (_termScrollCommands 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 (_termScrollCommands tp !! i) w))
in tp & termSel . _Just .~ (i,newj)
& termInput . _Just %~ replacewith' tp i newj w
replacewith tp newi _ = T.pack (_tcString (_termScrollCommands 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 = _termScrollCommands tp !! i
-- updatetermsel tp = case _tmSel tp of
-- Nothing -> tp & tmSel ?~ (0,0)
-- & tmInput . _Just %~ replacewith tp 0
-- Just (i,_) -> let newi = ((`mod` length (_tmScrollCommands tp)) . subtract yi) i
-- in tp & tmSel . _Just .~ (newi,0)
-- & tmInput . _Just %~ replacewith tp newi
-- updatetermsubsel tp = case _tmSel tp of
-- Nothing -> tp
-- Just (i,j) -> let newj = (j - yi) `mod` (1 + length (_tcArguments (_tmScrollCommands tp !! i) tp w))
-- in tp & tmSel . _Just .~ (i,newj)
-- & tmInput . _Just %~ replacewith' tp i newj w
-- replacewith tp newi _ = T.pack (_tcString (_tmScrollCommands 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 = _tmScrollCommands tp !! i
numcombs = length $ combineItemListYou w
yi = round $ signum y
numLocs = (fst . IM.findMax $ _seenLocations w) + 1
src/Dodge/Event/Keyboard.hs
+13 -9
View File
@@ -30,9 +30,13 @@ import qualified Data.Text as T
-- also, note that this currently "doubles" the inputs to both terminals if both
-- are open
handleTextInput :: T.Text -> Universe -> IO (Maybe Universe)
handleTextInput text = return . Just . (menuLayers . ix 0 . scInput %~ updateText)
. (uvWorld . hud . hudElement . subInventory . termParams . termInput . _Just %~ updateText)
handleTextInput text u = return . Just $ u
& menuLayers . ix 0 . scInput %~ updateText
& updateTerminalText
where
updateTerminalText = case u ^? uvWorld . hud . hudElement . subInventory of
Just (DisplayTerminal tmid True) -> uvWorld . terminals . ix tmid . tmInput . _Just %~ updateText
_ -> id
updateText s = case T.unpack text of
";" -> s
_ -> s `T.append` T.toUpper text
@@ -60,8 +64,8 @@ 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
_ | null (_menuLayers u) -> case u ^? uvWorld . hud . hudElement . subInventory of
Just (DisplayTerminal tmid True) -> return $ uvWorld (handlePressedKeyTerminal tmid scode) u
_ -> return $ uvWorld (Just . handlePressedKeyInGame scode) u
_ -> handlePressedKeyInMenu (head $ _menuLayers u) scode u
@@ -80,12 +84,12 @@ handlePressedKeyInGame scode w = case scode of
_ -> w
handlePressedKeyTerminal :: Scancode -> World -> Maybe World
handlePressedKeyTerminal scode w = case scode of
ScancodeEscape -> Just $ w & hud . hudElement . subInventory .~ NoSubInventory
ScancodeReturn -> Just $ w & doTerminalEffect
handlePressedKeyTerminal :: Int -> Scancode -> World -> Maybe World
handlePressedKeyTerminal tmid scode w = case scode of
ScancodeEscape -> Just $ w & hud . hudElement . subInventory . onInputLine .~ False
ScancodeReturn -> Just $ w & doTerminalEffect (w ^?! terminals . ix tmid)
ScancodeBackspace -> Just $ w
& hud . hudElement . subInventory . termParams . termInput . _Just %~ doBackspace
& terminals . ix tmid . tmInput . _Just %~ doBackspace
& backspaceTimer .~ 5
_ -> Just w
where
src/Dodge/Inventory.hs
+1 -20
View File
@@ -146,7 +146,7 @@ invSelPos w = splitgap + (foldl' (+) 0 . fst $ IM.split invsel (augmentedInvSize
| otherwise = 1
updateTerminal :: World -> World
updateTerminal = checkTermDist . updateTerminalLine
updateTerminal = checkTermDist
checkTermDist :: World -> World
checkTermDist w = case w ^? hud . hudElement . subInventory . termID of
@@ -155,25 +155,6 @@ checkTermDist w = case w ^? hud . hudElement . subInventory . termID of
if dist btpos (_crPos $ you w) < 40 then Just w else Nothing
Nothing -> w
updateTerminalLine :: World -> World
updateTerminalLine w = case w ^? hud . hudElement . subInventory . termParams . termFutureLines . ix 0 of
Nothing -> w
Just tl | _tlPause tl > 0 -> w & pointTermParams . termFutureLines . ix 0 . tlPause -~ 1
Just (TerminalLineDisplay _ f) -> w & pointTermParams %~
( ( termFutureLines %~ tail )
. ( termDisplayedLines .:~ f )
)
Just (TerminalLineEffect _ eff) -> w
& pointTermParams . termFutureLines %~ tail
& eff (_subInventory . _hudElement $ _hud w)
Just (TerminalLineInput _) -> w & pointTermParams %~
( ( termFutureLines %~ tail )
-- . ( termScrollCommands .~ scrollc )
-- . ( termWriteCommands .~ writec )
. ( termInput ?~ T.empty ) )
where
pointTermParams = hud . hudElement . subInventory . termParams
-- this looks ugly...
updateCloseObjects :: World -> World
updateCloseObjects w = w & closeObjects .~ unionBy closeObjEq oldCloseFiltered currentClose
src/Dodge/Placement/Instance/Analyser.hs
+1 -1
View File
@@ -52,7 +52,7 @@ analyser
analyser starts sucs fails afters upf pslight psmc = extTrigLitPos pslight $ \tp ->
Just $ plSpot .~ psmc $ putTerminal' aquamarine tparams (termupdate tp)
where
tparams = const $ defaultTermParams & termFutureLines ++.~
tparams = const $ defaultTermParams & tmFutureLines ++.~
(map makeTermLine starts ++ [makeTermLine sucs] ++ map makeTermLine afters)
termupdate tp btid =
(\mc -> upf mc . (triggers . ix (fromJust $ _plMID tp) .~ const (_sensToggle $ _mcSensor mc))
src/Dodge/Placement/Instance/Terminal.hs
+15 -18
View File
@@ -25,7 +25,7 @@ import Data.Maybe
putTerminal''
:: Machine
-> (World -> TerminalParams)
-> (World -> Terminal)
-> (Int -> Machine -> World -> World) -- | machine update, takes button id as input
-> Placement
putTerminal'' mc f mcf = ps0PushPS (PutTerminal theterminal) $ \tmpl -> Just $
@@ -46,11 +46,11 @@ putTerminal'' mc f mcf = ps0PushPS (PutTerminal theterminal) $ \tmpl -> Just $
tmid = fromJust (_plMID tmpl)
btid = fromJust (_plMID btpl)
mcid = fromJust (_plMID mcpl)
theterminal = defaultTerminal & tmProgram .~ const f
theterminal = defaultTerminal & tmProgram .~ (\_ w -> _tmFutureLines (f w))
putTerminal'
:: Color
-> (World -> TerminalParams)
-> (World -> Terminal)
-> (Int -> Machine -> World -> World) -- | machine update, takes button id as input
-> Placement
putTerminal' col = putTerminal'' (defaultMachine & mcColor .~ col)
@@ -59,7 +59,7 @@ putTerminal' col = putTerminal'' (defaultMachine & mcColor .~ col)
, _mcSensor = SensorCloseToggle NotClose False
}
putTerminal :: Color -> (World -> TerminalParams) -> Placement
putTerminal :: Color -> (World -> Terminal) -> Placement
putTerminal col f = putTerminal'' (mc & mcColor .~ col) f (\_ -> basicMachineUpdate $ const id)
where
mc = defaultMachine
@@ -73,7 +73,7 @@ termButton = Button
{ _btPict = const mempty
, _btPos = 0
, _btRot = 0
, _btEvent = displayTerminalMessage . _btTermMID
, _btEvent = bootTerminal . _btTermMID
, _btID = 0
, _btText = "TERMINAL"
, _btState = BtOff
@@ -100,19 +100,16 @@ terminalShape mc = colorSH col (prismPoly
where
col = _mcColor mc
displayTerminalMessage :: Maybe Int -> World -> World
displayTerminalMessage mtmid w = case mtmid of
bootTerminal :: Maybe Int -> World -> World
bootTerminal mtmid w = case mtmid of
Nothing -> w
Just tmid -> w & hud . hudElement .~ DisplayInventory DisplayTerminal
{ _termID = tmid
, _termParams = message tmid
}
where
message tmid = fromMaybe NoTerminalParams $ do
tm <- w ^? terminals . ix tmid
return $ _tmProgram tm tm w
Just tmid -> w & hud . hudElement .~ DisplayInventory (DisplayTerminal tmid False)
& terminals . ix tmid . tmFutureLines ++.~ _tmProgram tm tm w
& terminals . ix tmid . tmStatus .~ Connected
where
tm = w ^?! terminals . ix tmid
simpleTermMessage :: [String] -> World -> TerminalParams
simpleTermMessage :: [String] -> World -> Terminal
simpleTermMessage = genTermMessage . const
--simpleTermMessage ss = const $ TerminalParams
-- {_termDisplayedLines = []
@@ -135,5 +132,5 @@ topFlushStrings = topFlush . maximum . map length
topFlush :: Int -> [String]
topFlush twidth = [replicate i ' ' ++ "*" | i <- [0, max 1 $ twidth `div` 5 .. twidth]]
genTermMessage :: (World -> [String]) -> World -> TerminalParams
genTermMessage f w = defaultTermParams & termFutureLines ++.~ map makeTermLine (f w)
genTermMessage :: (World -> [String]) -> World -> Terminal
genTermMessage f w = defaultTermParams & tmFutureLines ++.~ map makeTermLine (f w)
src/Dodge/Render/HUD.hs
+7 -5
View File
@@ -84,14 +84,16 @@ subInventoryDisplay subinv cfig w = case subinv of
, invHead cfig "TWEAK"
, listTextPicturesAt subInvX 60 cfig $ map text (ammoTweakStrings it)
]
DisplayTerminal {_termParams = tp,_termID = tid} -> pictures
[ invHead cfig (_termTitle tp ++ ":T" ++ show tid)
DisplayTerminal {_termID = tid,_onInputLine=isoninput} ->
let tp = w ^?! terminals . ix tid
in pictures
[ invHead cfig (_tmTitle tp ++ ":T" ++ show tid)
, renderListAt subInvX 60 cfig
. displayTermInput tp
-- . (++ map (\(str,_) -> (str,white)) (_termOptions tp))
. reverse
. take (_termMaxLines tp)
$ _termDisplayedLines tp <&> ($ w)
. take (_tmMaxLines tp)
$ _tmDisplayedLines tp
-- , fromMaybe mempty $ do
-- cursori <- _termSel tp <&> (+ _termMaxLines tp)
-- return $ listCursorNSW subInvX 60 cfig cursori white 15 1
@@ -122,7 +124,7 @@ subInventoryDisplay subinv cfig w = case subinv of
]
InspectInventory -> invHead cfig "INSPECT"
where
displayTermInput tp = case _termInput tp of
displayTermInput tp = case _tmInput tp of
Nothing -> id
Just s -> (++ [('>':T.unpack s++clockCycle 10 (V.fromList ["_",""]) w,white)])
closeobjectcursor = case selectedCloseObject w of
src/Dodge/Terminal.hs
+65 -66
View File
@@ -1,5 +1,6 @@
module Dodge.Terminal where
import Dodge.Data
import Dodge.Default
import Dodge.Base
import Dodge.SoundLogic
import Color
@@ -20,28 +21,28 @@ quitCommand = TerminalCommand
, _tcAlias = ["Q","EXIT","X","SHUTDOWN",""]
, _tcHelp = "DISCONNECTS THE TERMINAL."
, _tcArgumentType = Nothing
, _tcArguments = const []
, _tcEffect = const $ \w -> Right $ w & disconnectTerminal
, _tcArguments = const (const [])
, _tcEffect = const $ \tm w -> Right $ w & disconnectTerminal tm
}
disconnectTerminal :: World -> World
disconnectTerminal = hud . hudElement . subInventory . termParams %~
( (termInput .~ Nothing)
. (termFutureLines ++.~ [makeTermLine "DISCONNECTION COMPLETE"] )
)
disconnectTerminal :: Terminal -> World -> World
disconnectTerminal tm w = w
& terminals . ix (_tmID tm) . tmStatus .~ Disconnected
& terminals . ix (_tmID tm) . tmFutureLines ++.~ [makeTermLine "DISCONNECTION COMPLETE"]
damageCodeCommand :: TerminalCommand
damageCodeCommand = TerminalCommand
{ _tcString = "DAMAGECODE"
, _tcAlias = ["DCODE","DC"]
, _tcHelp = "DISPLAYS THE SHAPE AND COLOR ASSOCIATED WITH A GIVEN DAMAGE TYPE."
, _tcArgumentType = Just "A DAMAGE TYPE"
, _tcArguments = map (map toUpper . show) . M.keys . _sensorCoding . _genParams
, _tcArguments = \_ -> map (map toUpper . show) . M.keys . _sensorCoding . _genParams
, _tcEffect = f
}
where
f args w = fromMaybe (Left "") $ do
f args tm w = fromMaybe (Left "") $ do
dtype <- safeHead args >>= readMaybe
dinfo <- _sensorCoding (_genParams w) M.!? dtype
return $ Right $ w & infoClearInput [makeTermLine $ show (fst dinfo) ++ " " ++ show (snd dinfo)]
return $ Right $ w & infoClearInput tm [makeTermLine $ show (fst dinfo) ++ " " ++ show (snd dinfo)]
helpCommand :: TerminalCommand
helpCommand = TerminalCommand
@@ -49,31 +50,31 @@ helpCommand = TerminalCommand
, _tcAlias = ["H","MAN"]
, _tcHelp = "DISPLAYS HELP FOR A SPECIFIC COMMAND. TO DISPLAY AVAILABLE COMMANDS USE \"COMMANDS\"."
, _tcArgumentType = Just "AN AVAILABLE COMMAND"
, _tcArguments = \w -> fromMaybe [] $ do
commands <- getCommands w
, _tcArguments = \tm w -> fromMaybe [] $ do
commands <- getCommands tm w
return $ map _tcString commands
, _tcEffect = helpf
}
helpf :: [String] -> World -> Either String World
helpf [] w = helpf ["HELP"] w
helpf (str:_) w = maybe (Left "") Right $ do
commands <- getCommands w
helpf :: [String] -> Terminal -> World -> Either String World
helpf [] tm w = helpf ["HELP"] tm w
helpf (str:_) tm w = maybe (Left "") Right $ do
commands <- getCommands tm w
command <- find (\tc -> _tcString tc == str || str `elem` _tcAlias tc) commands
return $ w & infoClearInput
return $ w & infoClearInput tm
([makeTermLine ("COMMAND:" ++ _tcString command)
,makeTermLine ("ALIASES:" ++ unwords (_tcAlias command)) ]
++ makeTermPara (_tcHelp command ++ " " ++ argumentHelp (_tcArgumentType command))
)
getCommands :: World -> Maybe [TerminalCommand]
getCommands w = do
commands1 <- w ^? hud . hudElement . subInventory . termParams . termScrollCommands
commands2 <- w ^? hud . hudElement . subInventory . termParams . termWriteCommands
getCommands :: Terminal -> World -> Maybe [TerminalCommand]
getCommands tm w = do
commands1 <- w ^? terminals . ix (_tmID tm) . tmScrollCommands
commands2 <- w ^? terminals . ix (_tmID tm) . tmWriteCommands
return $ commands1 ++ commands2
infoClearInput :: [TerminalLine] -> World -> World
infoClearInput tls = hud . hudElement . subInventory . termParams %~
( (termInput ?~ T.empty)
. (termFutureLines ++.~ tls
infoClearInput :: Terminal -> [TerminalLine] -> World -> World
infoClearInput tm tls = terminals . ix (_tmID tm) %~
( (tmInput ?~ T.empty)
. (tmFutureLines ++.~ tls
)
)
@@ -94,9 +95,9 @@ makeTermLine = makeColorTermLine white
termSoundLine :: SoundID -> TerminalLine
termSoundLine sid = TerminalLineEffect 0 termsound
where
termsound subinv w = soundStart TerminalSound tpos sid Nothing w
termsound tm w = soundStart TerminalSound tpos sid Nothing w
where
tpos = fromMaybe 0 $ w ^? buttons . ix (_termID subinv) . btPos
tpos = fromMaybe 0 $ w ^? buttons . ix (_tmButtonID tm) . btPos
infoCommand :: String -> TerminalCommand
infoCommand str = TerminalCommand
@@ -104,8 +105,8 @@ infoCommand str = TerminalCommand
, _tcAlias = ["INFO","I"]
, _tcHelp = "DISPLAYS INFORMATION CONCERNING THE TERMINAL."
, _tcArgumentType = Nothing
, _tcArguments = const []
, _tcEffect = const $ \w -> Right $ w & infoClearInput
, _tcArguments = const (const [])
, _tcEffect = const $ \tm w -> Right $ w & infoClearInput tm
( makeTermPara str)
}
@@ -115,10 +116,10 @@ commandsCommand = TerminalCommand
, _tcAlias = ["COMMAND","COM"]
, _tcHelp = "DISPLAYS AVAILABLE COMMANDS."
, _tcArgumentType = Nothing
, _tcArguments = const []
, _tcEffect = const $ \w -> Right $ w & infoClearInput
, _tcArguments = const $ const []
, _tcEffect = \_ tm w -> Right $ w & infoClearInput tm
( makeTermLine "AVAILABLE COMMANDS:"
: makeTermPara (unwords (maybe [""] (map _tcString) $ getCommands w))
: makeTermPara (unwords (maybe [""] (map _tcString) $ getCommands tm w))
)
}
@@ -128,59 +129,57 @@ singleCommand command aliases htext eff = TerminalCommand
,_tcAlias = aliases
,_tcHelp = htext
,_tcArgumentType = Nothing
, _tcArguments = const []
,_tcEffect = const $ \w -> Right $ eff $ disconnectTerminal w
, _tcArguments = const $ const []
,_tcEffect = \_ tm w -> Right $ eff $ disconnectTerminal tm w
}
doTerminalEffect :: World -> World
doTerminalEffect w = fromMaybe w $ do
s <- fmap T.unpack $ w ^? hud . hudElement . subInventory . termParams . termInput . _Just
return $ doTerminalEffect' s $ w
& hud . hudElement . subInventory . termParams . termFutureLines
doTerminalEffect :: Terminal -> World -> World
doTerminalEffect tm w = fromMaybe w $ do
s <- fmap T.unpack $ w ^? terminals . ix (_tmID tm) . tmInput . _Just
return $ doTerminalEffect' s tm $ w
& terminals . ix (_tmID tm) . tmFutureLines
.~ [makeColorTermLine (greyN 0.9) ('>':s)]
doTerminalEffect' :: String -> World -> World
doTerminalEffect' s w = fromMaybe (w & badinput) $ do
commands <- getCommands w
if null (words s) then Just $ disconnectTerminal w else do
doTerminalEffect' :: String -> Terminal -> World -> World
doTerminalEffect' s tm w = fromMaybe (w & badinput) $ do
commands <- getCommands tm w
if null (words s) then Just $ disconnectTerminal tm w else do
let (str:args) = words s
command <- find (\tc -> _tcString tc == str || str `elem` _tcAlias tc) commands
case _tcEffect command args w of
case _tcEffect command args tm w of
Right w' -> return w'
Left err -> return $ w & hud . hudElement . subInventory . termParams %~
( (termInput ?~ T.empty)
. (termFutureLines ++.~
Left err -> return $ w & terminals . ix (_tmID tm) %~
( (tmInput ?~ T.empty)
. (tmFutureLines ++.~
[makeColorTermLine red
("^ INVALID ARGUMENT: EXPECTS "++fromJust (_tcArgumentType command)++ err)
]
)
)
where
badinput = hud . hudElement . subInventory . termParams %~
( (termInput ?~ T.empty)
. (termFutureLines ++.~ [makeColorTermLine red "^ INVALID INPUT"
]
badinput = terminals . ix (_tmID tm) %~
( (tmInput ?~ T.empty)
. (tmFutureLines ++.~ [makeColorTermLine red "^ INVALID INPUT" ]
)
)
addInputLine :: [TerminalCommand] -> [TerminalCommand] -> TerminalParams -> TerminalParams
addInputLine :: [TerminalCommand] -> [TerminalCommand] -> Terminal -> Terminal
addInputLine searchablecommands hiddencommands =
(termFutureLines ++.~ [TerminalLineInput 0])
. (termScrollCommands ++.~ searchablecommands)
. (termWriteCommands ++.~ hiddencommands)
(tmFutureLines ++.~ [TerminalLineInput 0])
. (tmScrollCommands .~ searchablecommands)
. (tmWriteCommands .~ hiddencommands)
defaultTermParams :: TerminalParams
defaultTermParams = TerminalParams
{_termDisplayedLines = []
,_termFutureLines = termSoundLine computerBeepingS
defaultTermParams :: Terminal
defaultTermParams = defaultTerminal
{_tmDisplayedLines = []
,_tmFutureLines = termSoundLine computerBeepingS
: map makeTermLine connectionBlurb
,_termMaxLines = 14
,_termTitle = "TERMINAL"
,_termSel = Nothing
,_termInput = Nothing
,_termScrollCommands = []
,_termWriteCommands = []
,_termDeathCommand = Nothing
,_tmMaxLines = 14
,_tmTitle = "TERMINAL"
,_tmSel = Nothing
,_tmInput = Nothing
,_tmScrollCommands = []
,_tmWriteCommands = []
}
connectionBlurb :: [String]
src/Dodge/Update.hs
+1 -1
View File
@@ -109,7 +109,7 @@ tmUpdate tm w = case w ^? terminals . ix (_tmID tm) . tmFutureLines . ix 0 of
)
Just (TerminalLineEffect _ eff) -> w
& pointTermParams . tmFutureLines %~ tail
& eff (_subInventory . _hudElement $ _hud w)
& eff tm
Just (TerminalLineInput _) -> w & pointTermParams %~
( ( tmFutureLines %~ tail )
-- . ( tmScrollCommands .~ scrollc )
src/Dodge/Update/Camera.hs
+2 -1
View File
@@ -167,8 +167,9 @@ rotateCamera cfig w
keyl = SDL.ScancodeQ `S.member` _keys w && notAtTerminal w
keyr = SDL.ScancodeE `S.member` _keys w && notAtTerminal w
-- TODO check where/how this is used
notAtTerminal :: World -> Bool
notAtTerminal w = isNothing $ w ^? hud . hudElement . subInventory . termParams . termInput . _Just
notAtTerminal w = isNothing $ w ^? hud . hudElement . subInventory . termID
--zoomCamBy :: Float -> World -> World
--zoomCamBy x w = w {_cameraZoom = max (_cameraZoom w + x) 0.01}