diff --git a/data/charMaps/charMapVert16Tall.png b/data/charMaps/charMapVert16Tall.png index af00339f8..2944b681c 100644 Binary files a/data/charMaps/charMapVert16Tall.png and b/data/charMaps/charMapVert16Tall.png differ diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index 0bfa104a9..7aac8de50 100644 --- a/src/Dodge/Render/HUD.hs +++ b/src/Dodge/Render/HUD.hs @@ -3,8 +3,8 @@ module Dodge.Render.HUD ( drawHUD, ) where -import Data.Foldable import Control.Lens +import Data.Foldable import qualified Data.Map.Strict as M import Data.Maybe import qualified Data.Vector as V @@ -203,14 +203,11 @@ displayTerminal :: Int -> Configuration -> LWorld -> Picture displayTerminal tid cfig w = fromMaybe mempty $ do tm <- w ^? terminals . ix tid return $ - pictures - [ invHead cfig (_tmTitle tm ++ ":T" ++ show tid) - , drawSelectionList secondColumnParams cfig (thesellist tm) - ] + invHead cfig (_tmTitle tm ++ ":T" ++ show tid) + <> drawSelectionList secondColumnParams cfig (thesellist tm) where toselitm (str, col) = SelectionItem [str] 1 True col 0 () - thesellist tm = - defaultSelectionList & slItems .~ thelist tm + thesellist tm = defaultSelectionList & slItems .~ thelist tm thelist tm = map toselitm . displayTermInput tm . reverse @@ -218,7 +215,7 @@ displayTerminal tid cfig w = fromMaybe mempty $ do $ _tmDisplayedLines tm displayTermInput tm = case _tmInput tm of TerminalInput s hasfoc _ -> (++ [(displayInputText tm s ++ displayBlinkCursor hasfoc, white)]) - partcommand tm = fromMaybe "" $ tm ^? tmPartialCommand . _Just + partcommand tm = maybe "" (++ " ") $ tm ^? tmPartialCommand . _Just displayInputText tm s | _tmStatus tm == TerminalReady = partcommand tm ++ "> " ++ s | otherwise = "" diff --git a/src/Dodge/Terminal.hs b/src/Dodge/Terminal.hs index e754df794..0a5f88a4f 100644 --- a/src/Dodge/Terminal.hs +++ b/src/Dodge/Terminal.hs @@ -1,6 +1,5 @@ module Dodge.Terminal ( doTerminalCommandEffect, - guardDisconnected, makeTermLine, commandFutureLines, quitCommand, @@ -46,9 +45,9 @@ basicTerminal = connectionBlurbLines :: [TerminalLine] -> [TerminalLine] connectionBlurbLines tls = [ termSoundLine computerBeepingS - , TerminalLineDisplay 0 (TerminalLineConst "CONNECTING" termTextColor) + , TerminalLineDisplay 0 (TerminalLineConst "Connecting" termTextColor) , TerminalLineDisplay 10 (TerminalLineConst "..." termTextColor) - , TerminalLineDisplay 10 (TerminalLineConst "CONNECTED" termTextColor) + , TerminalLineDisplay 10 (TerminalLineConst "Connected" termTextColor) ] ++ tls ++ [TerminalLineTerminalEffect 0 (TmTmSetStatus TerminalReady)] @@ -56,18 +55,18 @@ connectionBlurbLines tls = quitCommand :: TerminalCommand quitCommand = TerminalCommand - { _tcString = "QUIT" - , _tcAlias = ["Q", "EXIT", "X", "SHUTDOWN", ""] - , _tcHelp = "DISCONNECTS THE TERMINAL." + { _tcString = "quit" + , _tcAlias = ["q", "exit", "x", "shutdown", ""] + , _tcHelp = "Disconnects the terminal." , _tcEffect = TerminalCommandArguments $ NoArguments [TerminalLineEffect 0 TmWdWdDisconnectTerminal] } helpCommand :: TerminalCommand helpCommand = TerminalCommand - { _tcString = "HELP" - , _tcAlias = ["H", "MAN"] - , _tcHelp = "DISPLAYS HELP FOR A SPECIFIC COMMAND." + { _tcString = "help" + , _tcAlias = ["h", "man"] + , _tcHelp = "Displays help for a specific command." , _tcEffect = TerminalCommandEffectHelp -- \tm -> OneArgument "AN AVAILABLE COMMAND" . getCommandsHelp tm } @@ -77,9 +76,9 @@ getCommandsHelp tm w = foldr f mempty $ getCommands tm f tc = M.insert (_tcString tc) - ( [ makeTermLine "COMMAND:" + ( [ makeTermLine "Command:" , makeColorTermLine commandColor (_tcString tc) - , makeTermLine "ALIASES:" + , makeTermLine "Aliases:" , makeColorTermLine commandColor (unwords (_tcAlias tc)) ] ++ case argumentHelp tc tm w of @@ -92,18 +91,18 @@ getCommandsHelp tm w = foldr f mempty $ getCommands tm commandsCommand :: TerminalCommand commandsCommand = TerminalCommand - { _tcString = "COMMANDS" - , _tcAlias = ["COMMAND", "COM"] - , _tcHelp = "DISPLAYS AVAILABLE COMMANDS." + { _tcString = "commands" + , _tcAlias = ["command", "com"] + , _tcHelp = "Displays available commands." , _tcEffect = TerminalCommandEffectCommands } connectionBlurb :: [TerminalLine] connectionBlurb = [ termSoundLine computerBeepingS - , TerminalLineDisplay 0 (TerminalLineConst "CONNECTING" termTextColor) + , TerminalLineDisplay 0 (TerminalLineConst "Connecting" termTextColor) , TerminalLineDisplay 10 (TerminalLineConst "..." termTextColor) - , TerminalLineDisplay 10 (TerminalLineConst "CONNECTED" termTextColor) + , TerminalLineDisplay 10 (TerminalLineConst "Connected" termTextColor) , TerminalLineTerminalEffect 0 (TmTmSetStatus TerminalReady) ] @@ -173,12 +172,6 @@ argumentHelp tc tm w = case doTerminalCommandEffect (_tcEffect tc) tm w of -- , _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 . _cwgParams . _cwGen . _cWorld @@ -195,15 +188,15 @@ getSensor :: Show a => (Sensor -> a) -> Terminal -> World -> [TerminalLine] getSensor f tm w = maybe [] - (makeTermPara . map toUpper . show . f) + (makeTermPara . map toLower . show . f) (w ^? cWorld . lWorld . machines . ix (_tmMachineID tm) . mcType . _McSensor) toggleCommand :: TerminalCommand toggleCommand = TerminalCommand - { _tcString = "TOGGLE" - , _tcAlias = ["TOG"] - , _tcHelp = "PERFORMS A REVERSABLE EFFECT." + { _tcString = "toggle" + , _tcAlias = ["tog"] + , _tcHelp = "Performs a reversable effect." , _tcEffect = TerminalCommandEffectLinkedObject -- \tm _ -> OneArgument "A LINKED OBJECT" (togglesToEffects tm) } @@ -213,19 +206,19 @@ decodedtmap = M.mapKeys show . M.map ((: []) . makeTermLine . show) sensorCommand :: TerminalCommand sensorCommand = TerminalCommand - { _tcString = "SENSOR" - , _tcAlias = ["SEN"] - , _tcHelp = "ACCESS INFORMATION CONCERNING THE CONNECTED SENSOR." + { _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 - & cWorld . lWorld . terminals . ix (_tmID tm) . tmStatus .~ TerminalOff - & exitTerminalSubInv - & cWorld . lWorld . terminals . ix (_tmID tm) . tmFutureLines - .~ [TerminalLineTerminalEffect 0 TmTmClearDisplayedLines] +disconnectTerminal tm = + (cWorld . lWorld . terminals . ix (_tmID tm) . tmStatus .~ TerminalOff) + . exitTerminalSubInv + . ( cWorld . lWorld . terminals . ix (_tmID tm) . tmFutureLines + .~ [TerminalLineTerminalEffect 0 TmTmClearDisplayedLines] + ) exitTerminalSubInv :: World -> World exitTerminalSubInv w = case w ^? hud . hudElement . subInventory . termID of @@ -235,9 +228,9 @@ exitTerminalSubInv w = case w ^? hud . hudElement . subInventory . termID of damageCodeCommand :: TerminalCommand damageCodeCommand = TerminalCommand - { _tcString = "DAMAGECODE" - , _tcAlias = ["DCODE", "DC"] - , _tcHelp = "DISPLAYS THE SHAPE AND COLOR ASSOCIATED WITH A GIVEN DAMAGE TYPE." + { _tcString = "damagecode" + , _tcAlias = ["dcode", "dc"] + , _tcHelp = "Displays the shape and color associated with a given damage type." , _tcEffect = TerminalCommandEffectDamageCoding -- \_ -> OneArgument "A DAMAGE TYPE" . getDamageCoding } @@ -253,21 +246,21 @@ 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 commandFutureLines :: String -> Terminal -> World -> [TerminalLine] -commandFutureLines s tm w = fromMaybe [errline "^ INVALID COMMAND"] $ do +commandFutureLines s tm w = fromMaybe [errline "^ Invalid command"] $ do (str, args) <- safeUncons $ words s command <- find (\tc -> _tcString tc == str || str `elem` _tcAlias tc) (getCommands tm) case doTerminalCommandEffect (_tcEffect command) tm w of NoArguments tls -> Just tls - OneArgument argtype m -> - let setpartial = TerminalLineTerminalEffect 0 (TmTmSetPartialCommand (Just str)) - : makeTermPara ("expects " ++ argtype ++ " as an argument") - in Just $ - fromMaybe setpartial $ - safeHead args >>= (m M.!?) + OneArgument argtype m -> + let setpartial = + TerminalLineTerminalEffect 0 (TmTmSetPartialCommand (Just str)) : + makeTermPara ("expects " ++ argtype ++ " as an argument") + in Just $ + fromMaybe setpartial $ + safeHead args >>= (m M.!?) where errline = makeColorTermLine red diff --git a/src/Dodge/Terminal/LeftButton.hs b/src/Dodge/Terminal/LeftButton.hs index 75f0725b7..e848d084e 100644 --- a/src/Dodge/Terminal/LeftButton.hs +++ b/src/Dodge/Terminal/LeftButton.hs @@ -1,36 +1,23 @@ -module Dodge.Terminal.LeftButton where +module Dodge.Terminal.LeftButton ( + doTerminalEffectLB, + terminalReturnEffect, +) where +import Control.Monad import Data.Maybe import Dodge.Data.World -import Dodge.Terminal--oops +import Dodge.Terminal.ReturnEffect import LensHelp doTerminalEffectLB :: Terminal -> World -> World -doTerminalEffectLB tm w = guardDisconnected tm w $ - fromMaybe w $ do - s <- w ^? cWorld . lWorld . terminals . ix (_tmID tm) . tmInput . tiText - if null (words s) - then Just $ defocusTerminalInput w - else return $ terminalReturnEffect tm w - -terminalReturnEffect :: Terminal -> World -> World -terminalReturnEffect tm w = guardDisconnected tm w $ - fromMaybe w $ do - s <- w ^? cWorld . lWorld . terminals . ix (_tmID tm) . tmInput . tiText - return $ - runTerminalString s tm $ - w - & cWorld . lWorld . terminals . ix (_tmID tm) . tmFutureLines .~ [makeTermLine ('>' : s)] +doTerminalEffectLB tm w = fromMaybe w $ do + guard (_tmStatus tm == TerminalReady) + s <- w ^? cWorld . lWorld . terminals . ix (_tmID tm) . tmInput . tiText + if null (words s) + then Just $ defocusTerminalInput w + else return $ terminalReturnEffect tm w defocusTerminalInput :: World -> World defocusTerminalInput w = fromMaybe w $ do tmid <- w ^? hud . hudElement . subInventory . termID return $ w & cWorld . lWorld . terminals . ix tmid . tmInput . tiFocus %~ const False - -runTerminalString :: String -> Terminal -> World -> World -runTerminalString s tm w = - w & cWorld . lWorld . terminals . ix (_tmID tm) - %~ ( (tmInput .~ TerminalInput mempty True (0, 0)) - . (tmFutureLines ++.~ commandFutureLines s tm w) - . (tmCommandHistory %~ take 10 . (s :)) - ) diff --git a/src/Dodge/Update/Input/InGame.hs b/src/Dodge/Update/Input/InGame.hs index 174c8313e..7fa147a5c 100644 --- a/src/Dodge/Update/Input/InGame.hs +++ b/src/Dodge/Update/Input/InGame.hs @@ -90,10 +90,9 @@ updatePressedButtonsCarte' pkeys w updateKeysInTerminal :: Int -> Universe -> Universe updateKeysInTerminal tmid u = - u & doTextInputOver tmpoint + u & doTextInputOver (uvWorld . cWorld . lWorld . terminals . ix tmid . tmInput . tiText) & checkEndStatus where - tmpoint = uvWorld . cWorld . lWorld . terminals . ix tmid . tmInput . tiText pkeys = u ^. uvWorld . input . pressedKeys checkEndStatus | pkeys ^. at ScancodeReturn == Just InitialPress = @@ -110,7 +109,6 @@ updateInitialPressInGame :: Universe -> Scancode -> Universe updateInitialPressInGame uv sc = case sc of ScancodeF1 -> useNormalCamera uv ScancodeF2 -> pauseAndFloatCam uv --- ScancodeF3 -> pauseAndPanCam uv ScancodeF5 -> doQuicksave uv ScancodeF9 -> doQuickload uv ScancodeEscape -> pauseGame uv @@ -152,7 +150,7 @@ doRegexInput u i sss any ((== Just InitialPress) . (`M.lookup` pkeys)) [ScancodeReturn, ScancodeSlash] - endmouse = (Just 0 == ) $ u ^? uvWorld . input . mouseButtons . ix ButtonLeft + endmouse = (Just 0 ==) $ u ^? uvWorld . input . mouseButtons . ix ButtonLeft backspacetonothing = sss ^? sssExtra . sssFilters . ix i . _Just == Just "" && ScancodeBackspace `M.lookup` pkeys == Just InitialPress diff --git a/src/Dodge/Update/Input/Text.hs b/src/Dodge/Update/Input/Text.hs index 7c5b1973b..a81c45ea9 100644 --- a/src/Dodge/Update/Input/Text.hs +++ b/src/Dodge/Update/Input/Text.hs @@ -4,7 +4,7 @@ module Dodge.Update.Input.Text ( ) where import Data.Either -import Data.Char +--import Data.Char import Dodge.Data.Universe import LensHelp import SDL @@ -14,7 +14,8 @@ doTextInputOver p u = doTextInputOver' u p u doTextInputOver' :: Universe -> ASetter' a String -> a -> a doTextInputOver' u p x = - x & p %~ (++ map toUpper (rights str)) + --x & p %~ (++ map toUpper (rights str)) + x & p %~ (++ rights str) & checkBackspace where str = u ^. uvWorld . input . textInput diff --git a/src/Dodge/WorldEffect.hs b/src/Dodge/WorldEffect.hs index 6d0a078a7..bf82d25a2 100644 --- a/src/Dodge/WorldEffect.hs +++ b/src/Dodge/WorldEffect.hs @@ -1,9 +1,9 @@ -module Dodge.WorldEffect - ( doWdWd - , accessTerminal - , doTmWdWd - , lineOutputTerminal - ) where +module Dodge.WorldEffect ( + doWdWd, + accessTerminal, + doTmWdWd, + lineOutputTerminal, +) where import Data.Foldable import qualified Data.Map.Strict as M @@ -46,20 +46,20 @@ doItCrWdWd icww = case icww of ItCrWdItemEffect -> flip itemEffect accessTerminal :: Maybe Int -> World -> World -accessTerminal mtmid w = case mtmid of - Nothing -> w - Just tmid -> +accessTerminal mtmid w = fromMaybe w $ do + tmid <- mtmid + return $ w & hud . hudElement . subInventory .~ DisplayTerminal tmid & cWorld . lWorld . terminals . ix tmid . tmInput . tiFocus .~ True & cWorld . lWorld . terminals . ix tmid %~ tryToBoot - where - tryToBoot tm = case _tmStatus tm of - TerminalReady -> tm - TerminalBusy -> tm - TerminalOff -> - tm - & tmFutureLines .~ doTerminalBootProgram (_tmBootProgram tm) tm w - & tmStatus .~ TerminalBusy + where + tryToBoot tm = case _tmStatus tm of + TerminalReady -> tm + TerminalBusy -> tm + TerminalOff -> + tm + & tmFutureLines .~ doTerminalBootProgram (_tmBootProgram tm) tm w + & tmStatus .~ TerminalBusy torqueCr :: Float -> Int -> World -> World torqueCr x cid w @@ -82,9 +82,7 @@ lineOutputTerminal tls = } doDeathTriggers :: Terminal -> World -> World -doDeathTriggers tm w = - w - & cWorld . lWorld . triggers %~ flip (foldl' $ flip doDeathToggle) xs +doDeathTriggers tm = cWorld . lWorld . triggers %~ flip (foldl' $ flip doDeathToggle) xs where xs = M.elems $ _tmToggles tm diff --git a/src/Picture/Base.hs b/src/Picture/Base.hs index 44a6234a8..fbb81d834 100644 --- a/src/Picture/Base.hs +++ b/src/Picture/Base.hs @@ -201,7 +201,6 @@ stackText = mconcat . zipWith (\y s -> translate 0 y $ centerText s) [0, 100 ..] text :: String -> Picture {-# INLINE text #-} ---text = translate (-50) (-100) . drawText (10) text = translate (-50) (-100) . drawText (-10) drawText :: Float -> String -> [Verx] @@ -209,7 +208,6 @@ drawText gap = map f . stringToList gap where f (pos, col, V3 a b c) = Verx pos col [a, b, c, 1] BottomLayer textNum - line :: [Point2] -> Picture {-# INLINE line #-} line = thickLine 1