Cleanup
This commit is contained in:
+7
-2
@@ -382,6 +382,7 @@ data Button = Button
|
||||
, _btText :: String
|
||||
, _btState :: ButtonState
|
||||
, _btTerminalParams :: World -> TerminalParams
|
||||
, _btName :: String
|
||||
}
|
||||
data TerminalParams = NoTerminalParams | TerminalParams
|
||||
{ _termDisplayedLines :: [World -> (String,Color)]
|
||||
@@ -912,8 +913,11 @@ data Block = Block
|
||||
}
|
||||
data BlockMaterial = WoodBlock | DirtBlock | StoneBlock | GlassBlock | MetalBlock
|
||||
data Terminal = Terminal
|
||||
{ _tmID :: Int
|
||||
, _tmParams :: TerminalParams
|
||||
{ _tmID :: Int
|
||||
, _tmParams :: TerminalParams
|
||||
, _tmButtonID :: Int
|
||||
, _tmMachineID :: Int
|
||||
, _tmName :: String
|
||||
}
|
||||
data Machine = Machine
|
||||
{ _mcID :: Int
|
||||
@@ -927,6 +931,7 @@ data Machine = Machine
|
||||
, _mcDamage :: [Damage]
|
||||
, _mcLSs :: [Int]
|
||||
, _mcType :: MachineType
|
||||
, _mcName :: String
|
||||
}
|
||||
data Sensor = NoSensor
|
||||
| SensorToggleAmount
|
||||
|
||||
@@ -217,6 +217,7 @@ defaultMachine = Machine
|
||||
, _mcDamage = []
|
||||
, _mcLSs = []
|
||||
, _mcType = StaticMachine
|
||||
, _mcName = ""
|
||||
}
|
||||
defaultMachineUpdate :: Machine -> World -> World
|
||||
defaultMachineUpdate mc
|
||||
@@ -248,6 +249,7 @@ defaultButton = Button
|
||||
, _btText = "Button"
|
||||
, _btState = BtOff
|
||||
, _btTerminalParams = const NoTerminalParams
|
||||
, _btName = ""
|
||||
}
|
||||
defaultPT :: Prop
|
||||
defaultPT = Projectile
|
||||
@@ -300,3 +302,4 @@ defaultTLS = TLS
|
||||
|
||||
upHammer :: HammerType
|
||||
upHammer = HasHammer HammerUp
|
||||
|
||||
|
||||
@@ -25,8 +25,10 @@ import SDL
|
||||
--import Data.Text (unpack)
|
||||
import qualified Data.Text as T
|
||||
|
||||
-- annoyingly, the text input event doesn't register backspace, so this has to be
|
||||
-- dealt with elsewhere
|
||||
-- annoyingly, the text input event doesn't register backspace, so deletion has to be
|
||||
-- dealt with using key presses (handlePressedKey)
|
||||
-- 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)
|
||||
|
||||
@@ -18,14 +18,11 @@ makeButton
|
||||
:: Color
|
||||
-> (World -> World) -- ^ Effect when pressed
|
||||
-> Button
|
||||
makeButton col eff = Button
|
||||
makeButton col eff = defaultButton
|
||||
{ _btPict = defaultDrawButton col
|
||||
, _btPos = V2 0 0
|
||||
, _btRot = 0
|
||||
, _btEvent = \b w -> eff
|
||||
. over buttons (IM.adjust turnOn (_btID b))
|
||||
. soundFromGeneral (LeverSound 0) (btpos b) click1S Nothing $ w
|
||||
, _btID = 0
|
||||
, _btText = "Button"
|
||||
, _btState = BtOff
|
||||
, _btTerminalParams = const NoTerminalParams
|
||||
@@ -61,12 +58,9 @@ makeSwitchSPic
|
||||
-> (World -> World) -- ^ Switch on effect
|
||||
-> (World -> World) -- ^ Switch off effect
|
||||
-> Button
|
||||
makeSwitchSPic dswitch effOn effOff = Button
|
||||
makeSwitchSPic dswitch effOn effOff = defaultButton
|
||||
{ _btPict = dswitch
|
||||
, _btPos = V2 0 0
|
||||
, _btRot = 0
|
||||
, _btEvent = flipSwitch
|
||||
, _btID = 0
|
||||
, _btText = "SWITCH/"
|
||||
, _btState = BtOff
|
||||
, _btTerminalParams = const NoTerminalParams
|
||||
@@ -96,12 +90,9 @@ makeSwitch
|
||||
-> (World -> World) -- ^ Switch on effect
|
||||
-> (World -> World) -- ^ Switch off effect
|
||||
-> Button
|
||||
makeSwitch col1 col2 effOn effOff = Button
|
||||
makeSwitch col1 col2 effOn effOff = defaultButton
|
||||
{ _btPict = drawSwitch col1 col2
|
||||
, _btPos = V2 0 0
|
||||
, _btRot = 0
|
||||
, _btEvent = flipSwitch
|
||||
, _btID = 0
|
||||
, _btText = "SWITCH/"
|
||||
, _btState = BtOff
|
||||
, _btTerminalParams = const NoTerminalParams
|
||||
|
||||
@@ -51,15 +51,16 @@ putTerminal f = plGenUpdate ?~ g $ ps0PushPS (PutButton termButton)
|
||||
)
|
||||
termButton :: Button
|
||||
termButton = Button
|
||||
{ _btPict = const mempty
|
||||
, _btPos = 0
|
||||
, _btRot = 0
|
||||
, _btEvent = displayTerminalMessage . _btID
|
||||
, _btID = 0
|
||||
, _btText = "TERMINAL"
|
||||
, _btState = BtOff
|
||||
, _btTerminalParams = const $ TerminalParams [] [] 10 "TERMINAL" Nothing Nothing [] []
|
||||
}
|
||||
{ _btPict = const mempty
|
||||
, _btPos = 0
|
||||
, _btRot = 0
|
||||
, _btEvent = displayTerminalMessage . _btID
|
||||
, _btID = 0
|
||||
, _btText = "TERMINAL"
|
||||
, _btState = BtOff
|
||||
, _btTerminalParams = const $ TerminalParams [] [] 10 "TERMINAL" Nothing Nothing [] []
|
||||
, _btName = ""
|
||||
}
|
||||
|
||||
|
||||
terminalColor :: Color
|
||||
|
||||
@@ -69,12 +69,10 @@ addWarningTerminal outplid = (rmName .++~ "warningTerm-")
|
||||
else Just (ltpos, rpdir)
|
||||
_ -> Nothing
|
||||
termMessages trid = ops trid (genTermMessage $ const ["OPEN DOOR?"])
|
||||
-- <&> termFutureLines %~ (++ [TerminalLineChoice 0 (ops trid)])
|
||||
ops trid f gw w = f gw w & termFutureLines %~
|
||||
(++ [ TerminalLineInput 0 [unlockCommand trid] [quitCommand,helpCommand,infoCommand theinfo,commandsCommand]])
|
||||
ops trid f gw w = f gw w & termFutureLines ++.~ [ TerminalLineInput 0
|
||||
[unlockCommand trid,quitCommand]
|
||||
[helpCommand,infoCommand theinfo,commandsCommand]
|
||||
]
|
||||
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
|
||||
theinfo = "DOOR CONTROLABLE BY ENTERING \"OPEN\". THIS TERMINAL CANNOT CLOSE THE DOOR."
|
||||
theinfo = "DOOR CONTROLABLE WITH THE \"OPEN\" COMMAND. THIS TERMINAL CANNOT CLOSE THE DOOR."
|
||||
|
||||
@@ -41,7 +41,7 @@ helpf (str:_) w = maybe (Left "") Right $ do
|
||||
return $ w & infoClearInput
|
||||
([makeTermLine ("COMMAND:" ++ _tcString command)
|
||||
,makeTermLine ("ALIASES:" ++ unwords (_tcAlias command)) ]
|
||||
++ stringToTermPara (_tcHelp command ++ " " ++ argumentHelp (_tcArgumentType command))
|
||||
++ makeTermPara (_tcHelp command ++ " " ++ argumentHelp (_tcArgumentType command))
|
||||
)
|
||||
getCommands :: World -> Maybe [TerminalCommand]
|
||||
getCommands w = do
|
||||
@@ -61,8 +61,8 @@ argumentHelp mstr = case mstr of
|
||||
Nothing -> "ANY ARGUMENTS PROVIDED TO THIS COMMAND ARE IGNORED."
|
||||
Just str -> "EXPECTS " ++ str ++ " AS ARGUMENT."
|
||||
|
||||
stringToTermPara :: String -> [TerminalLine]
|
||||
stringToTermPara = map makeTermLine . makeParagraph 60
|
||||
makeTermPara :: String -> [TerminalLine]
|
||||
makeTermPara = map makeTermLine . makeParagraph 60
|
||||
|
||||
makeColorTermLine :: Color -> String -> TerminalLine
|
||||
makeColorTermLine col str = TerminalLineDisplay 0 $ const (str,col)
|
||||
@@ -79,7 +79,7 @@ infoCommand str = TerminalCommand
|
||||
, _tcArgumentType = Nothing
|
||||
, _tcArguments = const []
|
||||
, _tcEffect = const $ \w -> Right $ w & infoClearInput
|
||||
( stringToTermPara str)
|
||||
( makeTermPara str)
|
||||
}
|
||||
|
||||
commandsCommand :: TerminalCommand
|
||||
@@ -91,7 +91,7 @@ commandsCommand = TerminalCommand
|
||||
, _tcArguments = const []
|
||||
, _tcEffect = const $ \w -> Right $ w & infoClearInput
|
||||
( makeTermLine "AVAILABLE COMMANDS:"
|
||||
: stringToTermPara (unwords (maybe [""] (map _tcString) $ getCommands w))
|
||||
: makeTermPara (unwords (maybe [""] (map _tcString) $ getCommands w))
|
||||
)
|
||||
}
|
||||
|
||||
|
||||
Reference in New Issue
Block a user