Add file

src/Dodge/Terminal.hs

@@ -0,0 +1,127 @@
+module Dodge.Terminal where
+import Dodge.Data
+import Color
+import Justify
+import LensHelp
+
+import Data.Maybe
+import qualified Data.Text as T
+import Data.List (find)
+
+quitCommand :: TerminalCommand
+quitCommand = TerminalCommand
+    { _tcString = "QUIT"
+    , _tcAlias  = ["Q","EXIT","X","SHUTDOWN",""]
+    , _tcHelp   = "DISCONNECTS THE TERMINAL."
+    , _tcArgumentType = Nothing
+    , _tcArguments  = const []
+    , _tcEffect = const $ \w -> Right $ w & disconnectTerminal
+    }
+disconnectTerminal :: World -> World
+disconnectTerminal = hud . hudElement . subInventory . termParams %~
+    ( (termInput .~ Nothing)
+    . (termFutureLines ++.~ [TerminalLineDisplay 0 $ const ("DISCONNECTION COMPLETE",white)] )
+    )
+helpCommand :: TerminalCommand
+helpCommand = TerminalCommand
+    { _tcString = "HELP"
+    , _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 <- w ^? hud . hudElement . subInventory . termParams . termCommands
+        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 <- w ^? hud . hudElement . subInventory . termParams . termCommands
+    command <- find (\tc -> _tcString tc == str || str `elem` _tcAlias tc) commands
+    return $ w & infoClearInput 
+        ([TerminalLineDisplay 0 $ const ("COMMAND:" ++ _tcString command,white) 
+         ,TerminalLineDisplay 0 $ const ("ALIASES:" ++ unwords (_tcAlias command),white) ] 
+         ++ stringToTermPara (_tcHelp command ++ " " ++ argumentHelp (_tcArgumentType command))
+         )
+
+infoClearInput :: [TerminalLine] -> World -> World
+infoClearInput tls = hud . hudElement . subInventory . termParams %~
+    ( (termInput ?~ T.empty)
+    . (termFutureLines ++.~ tls
+      )
+    )
+
+
+argumentHelp :: Maybe String -> String
+argumentHelp mstr = case mstr of
+    Nothing -> "ANY ARGUMENTS PROVIDED TO THIS COMMAND ARE IGNORED."
+    Just str -> "EXPECTS " ++ str ++ " AS ARGUMENT."
+
+stringToTermPara :: String -> [TerminalLine]
+stringToTermPara str = map (\s -> TerminalLineDisplay 0 $ const (s,white))
+                    (makeParagraph 60 str)
+
+infoCommand :: String -> TerminalCommand
+infoCommand str = TerminalCommand
+    { _tcString = "INFORMATION"
+    , _tcAlias  = ["INFO","I"]
+    , _tcHelp   = "DISPLAYS INFORMATION CONCERNING THE TERMINAL."
+    , _tcArgumentType = Nothing
+    , _tcArguments = const []
+    , _tcEffect = const $ \w -> Right $ w & infoClearInput
+                ( stringToTermPara str)
+    }
+
+commandsCommand :: TerminalCommand
+commandsCommand = TerminalCommand
+    { _tcString = "COMMANDS"
+    , _tcAlias  = ["COMMAND","COM"]
+    , _tcHelp   = "DISPLAYS AVAILABLE COMMANDS."
+    , _tcArgumentType = Nothing
+    , _tcArguments = const []
+    , _tcEffect = const $ \w -> Right $ w & infoClearInput 
+        (TerminalLineDisplay 0 (const ("AVAILABLE COMMANDS:",white))
+        : stringToTermPara (unwords (maybe [""] (map _tcString) $ w ^? hud . hudElement . subInventory . termParams . termCommands))
+                )
+    }
+
+singleCommand :: String -> [String] -> String -> (World -> World) -> TerminalCommand
+singleCommand command aliases htext eff = TerminalCommand
+    {_tcString = command
+    ,_tcAlias = aliases
+    ,_tcHelp = htext
+    ,_tcArgumentType = Nothing
+    , _tcArguments = const []
+    ,_tcEffect = const $ \w -> Right $ eff $ disconnectTerminal 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 .~ [TerminalLineDisplay 0 (const ('>':s,greyN 0.9))]
+
+doTerminalEffect' :: String -> World -> World
+doTerminalEffect' s w = fromMaybe (w & badinput) $ do
+    commands <- w ^? hud . hudElement . subInventory . termParams . termCommands
+    if null (words s) then Just $ disconnectTerminal 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
+            Right w' -> return w'
+            Left err -> return $ w & hud . hudElement . subInventory . termParams %~
+                ( (termInput ?~ T.empty)
+                . (termFutureLines ++.~ 
+                    [TerminalLineDisplay 0 
+                    $ const ("^ INVALID ARGUMENT: EXPECTS "++fromJust (_tcArgumentType command)++ err ,red)
+                    ]
+                    )
+                )
+  where
+    badinput =  hud . hudElement . subInventory . termParams %~
+        ( (termInput ?~ T.empty)
+        . (termFutureLines ++.~ [TerminalLineDisplay 0 $ const ("^ INVALID INPUT",red)
+            ]
+            )
+        )
+