Fix: move terminal functions around
This commit is contained in:
@@ -4,6 +4,7 @@ module Dodge.Event.Keyboard
|
||||
, handleTextInput
|
||||
, guardDisconnectedID
|
||||
) where
|
||||
import Dodge.Event.Keyboard
|
||||
import Dodge.WorldPos
|
||||
import Dodge.Button.Event
|
||||
import Dodge.Terminal
|
||||
|
||||
@@ -2,6 +2,7 @@
|
||||
{- | Rooms containing long doors, probably with a big reveal behind them.
|
||||
-}
|
||||
module Dodge.Room.LongDoor where
|
||||
import Dodge.Terminal
|
||||
import Dodge.Data
|
||||
import Dodge.Default.Door
|
||||
import Dodge.Cleat
|
||||
|
||||
@@ -121,3 +121,112 @@ makeColorTermLine col str = TerminalLineDisplay 0 $ TerminalLineConst str col
|
||||
|
||||
commandColor :: Color
|
||||
commandColor = yellow
|
||||
|
||||
doTerminalCommandEffect :: TerminalCommandEffect -> Terminal -> World -> EffectArguments
|
||||
doTerminalCommandEffect tce = case tce of
|
||||
TerminalCommandArguments eas -> \_ _ -> eas
|
||||
TerminalCommandEffectDamageCoding -> \_ -> OneArgument "A DAMAGE TYPE" . getDamageCoding
|
||||
TerminalCommandEffectSensorParameter -> \tm -> OneArgument "A SENSOR PARAMETER" . sensorInfoMap tm
|
||||
TerminalCommandEffectLinkedObject -> \tm _ -> OneArgument "A LINKED OBJECT" (togglesToEffects tm)
|
||||
TerminalCommandEffectHelp -> \tm -> OneArgument "AN AVAILABLE COMMAND" . getCommandsHelp tm
|
||||
TerminalCommandEffectNoArgumentsStr str -> \_ _ -> NoArguments (makeTermPara str)
|
||||
TerminalCommandEffectCommands -> \tm _ -> NoArguments
|
||||
( makeTermLine "AVAILABLE COMMANDS:"
|
||||
: makeColorTermPara commandColor (unwords (map _tcString $ getCommands tm))
|
||||
)
|
||||
TerminalCommandEffectSingleCommand eff followingLines -> \_ _ -> NoArguments $ TerminalLineEffect 0 (TmWdWdfromWdWd eff) : map makeTermLine followingLines
|
||||
TerminalCommandEffectNone -> \_ _ -> NoArguments []
|
||||
|
||||
argumentHelp :: TerminalCommand -> Terminal -> World -> (String,Maybe [String])
|
||||
argumentHelp tc tm w = case doTerminalCommandEffect (_tcEffect tc) tm w of
|
||||
NoArguments {} -> ("ANY ARGUMENTS PROVIDED TO THIS COMMAND ARE IGNORED.",Nothing)
|
||||
OneArgument argtype argm -> ("EXPECTS " ++ argtype ++ " AS ARGUMENT. AVAILABLE ARGUMENTS: "
|
||||
, Just (M.keys argm) )
|
||||
|
||||
|
||||
infoCommand :: String -> TerminalCommand
|
||||
infoCommand str = TerminalCommand
|
||||
{ _tcString = "INFORMATION"
|
||||
, _tcAlias = ["INFO","I"]
|
||||
, _tcHelp = "DISPLAYS INFORMATION CONCERNING THE TERMINAL."
|
||||
, _tcEffect = TerminalCommandEffectNoArgumentsStr str -- \_ _ -> NoArguments (makeTermPara str)
|
||||
}
|
||||
|
||||
singleCommand :: [String] -> String -> [String] -> String -> WdWd -> TerminalCommand
|
||||
singleCommand followingLines command aliases htext eff = TerminalCommand
|
||||
{_tcString = command
|
||||
,_tcAlias = aliases
|
||||
,_tcHelp = htext
|
||||
,_tcEffect = TerminalCommandEffectSingleCommand eff followingLines }
|
||||
|
||||
guardDisconnected :: Terminal -> World -> World -> World
|
||||
guardDisconnected tm w w' = case _tmStatus tm of
|
||||
TerminalOff -> w
|
||||
TerminalBusy -> w
|
||||
TerminalReady -> w'
|
||||
getDamageCoding :: World -> M.Map String [TerminalLine]
|
||||
getDamageCoding = decodedtmap . _sensorCoding . _genParams
|
||||
|
||||
sensorInfoMap :: Terminal -> World -> M.Map String [TerminalLine]
|
||||
sensorInfoMap tm w = M.fromList
|
||||
[("REQUIREMENT", getSensor _proxRequirement tm w)
|
||||
,("DISTANCE", getSensor _proxDist tm w)
|
||||
,("CURRENTSTATUS", getSensor _proxStatus tm w)
|
||||
,("PASTSTATUS", getSensor _sensToggle tm w)
|
||||
]
|
||||
getSensor :: Show a => (Sensor -> a) -> Terminal -> World -> [TerminalLine]
|
||||
getSensor f tm w = maybe [] (makeTermPara . map toUpper . show . f)
|
||||
(w ^? machines . ix (_tmMachineID tm) . mcSensor)
|
||||
|
||||
toggleCommand :: TerminalCommand
|
||||
toggleCommand = TerminalCommand
|
||||
{ _tcString = "TOGGLE"
|
||||
, _tcAlias = ["TOG"]
|
||||
, _tcHelp = "PERFORMS A REVERSABLE EFFECT."
|
||||
, _tcEffect = TerminalCommandEffectLinkedObject -- \tm _ -> OneArgument "A LINKED OBJECT" (togglesToEffects tm)
|
||||
}
|
||||
decodedtmap :: M.Map DamageType (PaletteColor,DecorationShape) -> M.Map String [TerminalLine]
|
||||
decodedtmap = M.mapKeys show . M.map ((:[]) . makeTermLine . show)
|
||||
|
||||
sensorCommand :: TerminalCommand
|
||||
sensorCommand = TerminalCommand
|
||||
{ _tcString = "SENSOR"
|
||||
, _tcAlias = ["SEN"]
|
||||
, _tcHelp = "ACCESS INFORMATION CONCERNING THE CONNECTED SENSOR."
|
||||
, _tcEffect = TerminalCommandEffectSensorParameter -- \tm -> OneArgument "A SENSOR PARAMETER" . sensorInfoMap tm
|
||||
}
|
||||
|
||||
disconnectTerminal :: Terminal -> World -> World
|
||||
disconnectTerminal tm w = w
|
||||
& terminals . ix (_tmID tm) . tmStatus .~ TerminalOff
|
||||
& exitTerminalSubInv
|
||||
& terminals . ix (_tmID tm) . tmFutureLines .~
|
||||
[ TerminalLineTerminalEffect 0 TmTmClearDisplayedLines ]
|
||||
|
||||
exitTerminalSubInv :: World -> World
|
||||
exitTerminalSubInv w = case w ^? hud . hudElement . subInventory . termID of
|
||||
Just _ -> w & hud . hudElement . subInventory .~ NoSubInventory
|
||||
_ -> w
|
||||
|
||||
damageCodeCommand :: TerminalCommand
|
||||
damageCodeCommand = TerminalCommand
|
||||
{ _tcString = "DAMAGECODE"
|
||||
, _tcAlias = ["DCODE","DC"]
|
||||
, _tcHelp = "DISPLAYS THE SHAPE AND COLOR ASSOCIATED WITH A GIVEN DAMAGE TYPE."
|
||||
, _tcEffect = TerminalCommandEffectDamageCoding -- \_ -> OneArgument "A DAMAGE TYPE" . getDamageCoding
|
||||
}
|
||||
|
||||
|
||||
infoClearInput :: Terminal -> [TerminalLine] -> World -> World
|
||||
infoClearInput tm tls = terminals . ix (_tmID tm) %~
|
||||
( (tmInput .~ TerminalInput T.empty True (0,0))
|
||||
. (tmFutureLines ++.~ tls)
|
||||
)
|
||||
|
||||
togglesToEffects :: Terminal -> M.Map String [TerminalLine]
|
||||
togglesToEffects = fmap f . _tmToggles
|
||||
where
|
||||
f tt = [TerminalLineEffect 0 $ TmWdWdfromWdWd $ WdWdNegateTrig (_ttTriggerID tt)]
|
||||
-- \_ -> triggers . ix (_ttTriggerID tt) %~ not]
|
||||
simpleTermMessage :: [String] -> Terminal
|
||||
simpleTermMessage strs = defaultTerminal & tmFutureLines .~ map makeTermLine strs
|
||||
|
||||
@@ -2,6 +2,7 @@
|
||||
module Dodge.Update.UsingInput
|
||||
( updateUsingInput
|
||||
) where
|
||||
import Dodge.WorldEffect
|
||||
import Dodge.Data
|
||||
import Dodge.Base.You
|
||||
import Dodge.Creature.Impulse.UseItem
|
||||
|
||||
@@ -61,96 +61,8 @@ torqueCr x cid w
|
||||
where
|
||||
(rot, g) = randomR (-x,x) $ _randGen w
|
||||
|
||||
disconnectTerminal :: Terminal -> World -> World
|
||||
disconnectTerminal tm w = w
|
||||
& terminals . ix (_tmID tm) . tmStatus .~ TerminalOff
|
||||
& exitTerminalSubInv
|
||||
& terminals . ix (_tmID tm) . tmFutureLines .~
|
||||
[ TerminalLineTerminalEffect 0 TmTmClearDisplayedLines ]
|
||||
|
||||
|
||||
exitTerminalSubInv :: World -> World
|
||||
exitTerminalSubInv w = case w ^? hud . hudElement . subInventory . termID of
|
||||
Just _ -> w & hud . hudElement . subInventory .~ NoSubInventory
|
||||
_ -> w
|
||||
|
||||
damageCodeCommand :: TerminalCommand
|
||||
damageCodeCommand = TerminalCommand
|
||||
{ _tcString = "DAMAGECODE"
|
||||
, _tcAlias = ["DCODE","DC"]
|
||||
, _tcHelp = "DISPLAYS THE SHAPE AND COLOR ASSOCIATED WITH A GIVEN DAMAGE TYPE."
|
||||
, _tcEffect = TerminalCommandEffectDamageCoding -- \_ -> OneArgument "A DAMAGE TYPE" . getDamageCoding
|
||||
}
|
||||
getDamageCoding :: World -> M.Map String [TerminalLine]
|
||||
getDamageCoding = decodedtmap . _sensorCoding . _genParams
|
||||
|
||||
decodedtmap :: M.Map DamageType (PaletteColor,DecorationShape) -> M.Map String [TerminalLine]
|
||||
decodedtmap = M.mapKeys show . M.map ((:[]) . makeTermLine . show)
|
||||
|
||||
sensorCommand :: TerminalCommand
|
||||
sensorCommand = TerminalCommand
|
||||
{ _tcString = "SENSOR"
|
||||
, _tcAlias = ["SEN"]
|
||||
, _tcHelp = "ACCESS INFORMATION CONCERNING THE CONNECTED SENSOR."
|
||||
, _tcEffect = TerminalCommandEffectSensorParameter -- \tm -> OneArgument "A SENSOR PARAMETER" . sensorInfoMap tm
|
||||
}
|
||||
sensorInfoMap :: Terminal -> World -> M.Map String [TerminalLine]
|
||||
sensorInfoMap tm w = M.fromList
|
||||
[("REQUIREMENT", getSensor _proxRequirement tm w)
|
||||
,("DISTANCE", getSensor _proxDist tm w)
|
||||
,("CURRENTSTATUS", getSensor _proxStatus tm w)
|
||||
,("PASTSTATUS", getSensor _sensToggle tm w)
|
||||
]
|
||||
getSensor :: Show a => (Sensor -> a) -> Terminal -> World -> [TerminalLine]
|
||||
getSensor f tm w = maybe [] (makeTermPara . map toUpper . show . f)
|
||||
(w ^? machines . ix (_tmMachineID tm) . mcSensor)
|
||||
|
||||
toggleCommand :: TerminalCommand
|
||||
toggleCommand = TerminalCommand
|
||||
{ _tcString = "TOGGLE"
|
||||
, _tcAlias = ["TOG"]
|
||||
, _tcHelp = "PERFORMS A REVERSABLE EFFECT."
|
||||
, _tcEffect = TerminalCommandEffectLinkedObject -- \tm _ -> OneArgument "A LINKED OBJECT" (togglesToEffects tm)
|
||||
}
|
||||
togglesToEffects :: Terminal -> M.Map String [TerminalLine]
|
||||
togglesToEffects = fmap f . _tmToggles
|
||||
where
|
||||
f tt = [TerminalLineEffect 0 $ TmWdWdfromWdWd $ WdWdNegateTrig (_ttTriggerID tt)]
|
||||
-- \_ -> triggers . ix (_ttTriggerID tt) %~ not]
|
||||
|
||||
infoClearInput :: Terminal -> [TerminalLine] -> World -> World
|
||||
infoClearInput tm tls = terminals . ix (_tmID tm) %~
|
||||
( (tmInput .~ TerminalInput T.empty True (0,0))
|
||||
. (tmFutureLines ++.~ tls)
|
||||
)
|
||||
|
||||
argumentHelp :: TerminalCommand -> Terminal -> World -> (String,Maybe [String])
|
||||
argumentHelp tc tm w = case doTerminalCommandEffect (_tcEffect tc) tm w of
|
||||
NoArguments {} -> ("ANY ARGUMENTS PROVIDED TO THIS COMMAND ARE IGNORED.",Nothing)
|
||||
OneArgument argtype argm -> ("EXPECTS " ++ argtype ++ " AS ARGUMENT. AVAILABLE ARGUMENTS: "
|
||||
, Just (M.keys argm) )
|
||||
|
||||
|
||||
infoCommand :: String -> TerminalCommand
|
||||
infoCommand str = TerminalCommand
|
||||
{ _tcString = "INFORMATION"
|
||||
, _tcAlias = ["INFO","I"]
|
||||
, _tcHelp = "DISPLAYS INFORMATION CONCERNING THE TERMINAL."
|
||||
, _tcEffect = TerminalCommandEffectNoArgumentsStr str -- \_ _ -> NoArguments (makeTermPara str)
|
||||
}
|
||||
|
||||
singleCommand :: [String] -> String -> [String] -> String -> WdWd -> TerminalCommand
|
||||
singleCommand followingLines command aliases htext eff = TerminalCommand
|
||||
{_tcString = command
|
||||
,_tcAlias = aliases
|
||||
,_tcHelp = htext
|
||||
,_tcEffect = TerminalCommandEffectSingleCommand eff followingLines }
|
||||
|
||||
guardDisconnected :: Terminal -> World -> World -> World
|
||||
guardDisconnected tm w w' = case _tmStatus tm of
|
||||
TerminalOff -> w
|
||||
TerminalBusy -> w
|
||||
TerminalReady -> w'
|
||||
|
||||
doTerminalEffectLB :: Terminal -> World -> World
|
||||
doTerminalEffectLB tm w = guardDisconnected tm w $ fromMaybe w $ do
|
||||
@@ -234,20 +146,6 @@ doTerminalBootProgram tbp = case tbp of
|
||||
TerminalBootLines ls -> \_ _ -> ls
|
||||
|
||||
|
||||
doTerminalCommandEffect :: TerminalCommandEffect -> Terminal -> World -> EffectArguments
|
||||
doTerminalCommandEffect tce = case tce of
|
||||
TerminalCommandArguments eas -> \_ _ -> eas
|
||||
TerminalCommandEffectDamageCoding -> \_ -> OneArgument "A DAMAGE TYPE" . getDamageCoding
|
||||
TerminalCommandEffectSensorParameter -> \tm -> OneArgument "A SENSOR PARAMETER" . sensorInfoMap tm
|
||||
TerminalCommandEffectLinkedObject -> \tm _ -> OneArgument "A LINKED OBJECT" (togglesToEffects tm)
|
||||
TerminalCommandEffectHelp -> \tm -> OneArgument "AN AVAILABLE COMMAND" . getCommandsHelp tm
|
||||
TerminalCommandEffectNoArgumentsStr str -> \_ _ -> NoArguments (makeTermPara str)
|
||||
TerminalCommandEffectCommands -> \tm _ -> NoArguments
|
||||
( makeTermLine "AVAILABLE COMMANDS:"
|
||||
: makeColorTermPara commandColor (unwords (map _tcString $ getCommands tm))
|
||||
)
|
||||
TerminalCommandEffectSingleCommand eff followingLines -> \_ _ -> NoArguments $ TerminalLineEffect 0 (TmWdWdfromWdWd eff) : map makeTermLine followingLines
|
||||
TerminalCommandEffectNone -> \_ _ -> NoArguments []
|
||||
|
||||
doTmWdWd :: TmWdWd -> Terminal -> World -> World
|
||||
doTmWdWd tmwdwd = case tmwdwd of
|
||||
@@ -258,5 +156,3 @@ doTmWdWd tmwdwd = case tmwdwd of
|
||||
TmWdWdDoDeathTriggers -> doDeathTriggers
|
||||
--TmWdWdfromWdWd f -> \_ -> doWorldEffect f
|
||||
|
||||
simpleTermMessage :: [String] -> Terminal
|
||||
simpleTermMessage strs = defaultTerminal & tmFutureLines .~ map makeTermLine strs
|
||||
|
||||
Reference in New Issue
Block a user