|
|
@@ -1,6 +1,6 @@
|
|
|
|
{-# LANGUAGE TupleSections #-}
|
|
|
|
{-# LANGUAGE TupleSections #-}
|
|
|
|
|
|
|
|
|
|
|
|
module Dodge.Debug.Terminal where
|
|
|
|
module Dodge.Debug.Console where
|
|
|
|
|
|
|
|
|
|
|
|
import Data.Foldable
|
|
|
|
import Data.Foldable
|
|
|
|
import Dodge.Item.Location.Initialize
|
|
|
|
import Dodge.Item.Location.Initialize
|
|
|
@@ -19,14 +19,14 @@ import LensHelp
|
|
|
|
import MaybeHelp
|
|
|
|
import MaybeHelp
|
|
|
|
import Text.Read (readMaybe)
|
|
|
|
import Text.Read (readMaybe)
|
|
|
|
|
|
|
|
|
|
|
|
applyTerminalString :: [String] -> Universe -> Universe
|
|
|
|
applyConsoleString :: [String] -> Universe -> Universe
|
|
|
|
applyTerminalString ss = case ss of
|
|
|
|
applyConsoleString ss = case ss of
|
|
|
|
[] -> id
|
|
|
|
[] -> id
|
|
|
|
[s] -> applyTerminalCommand s
|
|
|
|
[s] -> applyConsoleCommand s
|
|
|
|
(s : ss') -> applyTerminalCommandArguments s ss'
|
|
|
|
(s : ss') -> applyConsoleCommandArguments s ss'
|
|
|
|
|
|
|
|
|
|
|
|
applyTerminalCommand :: String -> Universe -> Universe
|
|
|
|
applyConsoleCommand :: String -> Universe -> Universe
|
|
|
|
applyTerminalCommand s = case s of
|
|
|
|
applyConsoleCommand s = case s of
|
|
|
|
"NOCLIP" -> uvConfig . debug_booleans . at Noclip %~ toggleJust
|
|
|
|
"NOCLIP" -> uvConfig . debug_booleans . at Noclip %~ toggleJust
|
|
|
|
['L', x] ->
|
|
|
|
['L', x] ->
|
|
|
|
(uvWorld . cWorld . lWorld %~ initSpecificCrItemLocations 0)
|
|
|
|
(uvWorld . cWorld . lWorld %~ initSpecificCrItemLocations 0)
|
|
|
@@ -39,8 +39,8 @@ applyTerminalCommand s = case s of
|
|
|
|
(ibt, n) <- parseItem [x]
|
|
|
|
(ibt, n) <- parseItem [x]
|
|
|
|
return $ uvWorld %~ flip (foldl' (&)) (replicate n (snd . createItemYou (itemFromBase ibt)))
|
|
|
|
return $ uvWorld %~ flip (foldl' (&)) (replicate n (snd . createItemYou (itemFromBase ibt)))
|
|
|
|
|
|
|
|
|
|
|
|
applyTerminalCommandArguments :: String -> [String] -> Universe -> Universe
|
|
|
|
applyConsoleCommandArguments :: String -> [String] -> Universe -> Universe
|
|
|
|
applyTerminalCommandArguments command args u = case command of
|
|
|
|
applyConsoleCommandArguments command args u = case command of
|
|
|
|
"IT" -> fromMaybe u $ do
|
|
|
|
"IT" -> fromMaybe u $ do
|
|
|
|
(ibt, n) <- parseItem args
|
|
|
|
(ibt, n) <- parseItem args
|
|
|
|
return $ u & uvWorld %~ flip (foldl' (&)) (replicate n (snd . createItemYou (itemFromBase ibt)))
|
|
|
|
return $ u & uvWorld %~ flip (foldl' (&)) (replicate n (snd . createItemYou (itemFromBase ibt)))
|
|
|
@@ -75,33 +75,33 @@ parseItem [] = Nothing
|
|
|
|
parseNum :: [String] -> Int
|
|
|
|
parseNum :: [String] -> Int
|
|
|
|
parseNum xs = fromMaybe 1 $ xs ^? ix 0 >>= readMaybe
|
|
|
|
parseNum xs = fromMaybe 1 $ xs ^? ix 0 >>= readMaybe
|
|
|
|
|
|
|
|
|
|
|
|
showTerminalError :: String -> String -> Universe -> Universe
|
|
|
|
showConsoleError :: String -> String -> Universe -> Universe
|
|
|
|
showTerminalError cmd s = uvScreenLayers .:~ InputScreen cmd s
|
|
|
|
showConsoleError cmd s = uvScreenLayers .:~ InputScreen cmd s
|
|
|
|
|
|
|
|
|
|
|
|
applySetTerminalString :: String -> Universe -> Universe
|
|
|
|
applySetConsoleString :: String -> Universe -> Universe
|
|
|
|
applySetTerminalString [] = id
|
|
|
|
applySetConsoleString [] = id
|
|
|
|
applySetTerminalString var = case key' of
|
|
|
|
applySetConsoleString var = case key' of
|
|
|
|
"" -> showTerminalError ("set " ++ var) ("Unable to read as argument as float: " ++ val)
|
|
|
|
"" -> showConsoleError ("set " ++ var) ("Unable to read as argument as float: " ++ val)
|
|
|
|
"hp" -> uvWorld . cWorld . lWorld . creatures . ix 0 . crHP .~ round (fromJust val')
|
|
|
|
"hp" -> uvWorld . cWorld . lWorld . creatures . ix 0 . crHP .~ round (fromJust val')
|
|
|
|
-- "invcap" -> uvWorld . cWorld . lWorld . creatures . ix 0 . crInvCapacity .~ round (fromJust val')
|
|
|
|
-- "invcap" -> uvWorld . cWorld . lWorld . creatures . ix 0 . crInvCapacity .~ round (fromJust val')
|
|
|
|
-- "mass" -> uvWorld . cWorld . lWorld . creatures . ix 0 . crMass .~ fromJust val'
|
|
|
|
-- "mass" -> uvWorld . cWorld . lWorld . creatures . ix 0 . crMass .~ fromJust val'
|
|
|
|
-- "mvspeed" -> uvWorld . cWorld . lWorld . creatures . ix 0 . crMvType . mvSpeed .~ fromJust val'
|
|
|
|
-- "mvspeed" -> uvWorld . cWorld . lWorld . creatures . ix 0 . crMvType . mvSpeed .~ fromJust val'
|
|
|
|
"mvspeed" -> uvWorld . cWorld . lWorld . creatures . ix 0 . crType . avMoveSpeed .~ fromJust val'
|
|
|
|
"mvspeed" -> uvWorld . cWorld . lWorld . creatures . ix 0 . crType . avMoveSpeed .~ fromJust val'
|
|
|
|
_ -> showTerminalError ("set " ++ var) ("Invalid set command: " ++ key) -- never reached?
|
|
|
|
_ -> showConsoleError ("set " ++ var) ("Invalid set command: " ++ key) -- never reached?
|
|
|
|
where
|
|
|
|
where
|
|
|
|
(key, val) = getSplitString var
|
|
|
|
(key, val) = getSplitString var
|
|
|
|
val' = readMaybe val :: Maybe Float
|
|
|
|
val' = readMaybe val :: Maybe Float
|
|
|
|
key' = if isNothing val' then "" else key
|
|
|
|
key' = if isNothing val' then "" else key
|
|
|
|
|
|
|
|
|
|
|
|
--autoCompleteTerminal :: String -> String -> Universe -> IO (Maybe Universe)
|
|
|
|
--autoCompleteConsole :: String -> String -> Universe -> IO (Maybe Universe)
|
|
|
|
--autoCompleteTerminal s _ =
|
|
|
|
--autoCompleteConsole s _ =
|
|
|
|
-- return
|
|
|
|
-- return
|
|
|
|
-- . (popScreen' >=> pushScreen' (InputScreen (T.pack input_str) valid_commands))
|
|
|
|
-- . (popScreen' >=> pushScreen' (InputScreen (T.pack input_str) valid_commands))
|
|
|
|
-- where
|
|
|
|
-- where
|
|
|
|
-- (key, val) = getSplitString $ tail s
|
|
|
|
-- (key, val) = getSplitString $ tail s
|
|
|
|
-- command_options = case val of
|
|
|
|
-- command_options = case val of
|
|
|
|
-- "" -> filter (isInfixOf key) (validTerminalCommands "")
|
|
|
|
-- "" -> filter (isInfixOf key) (validConsoleCommands "")
|
|
|
|
-- _ -> filter (isInfixOf val) (validTerminalCommands key)
|
|
|
|
-- _ -> filter (isInfixOf val) (validConsoleCommands key)
|
|
|
|
-- -- basic autocomplete if single option available (or as far as possible)
|
|
|
|
-- -- basic autocomplete if single option available (or as far as possible)
|
|
|
|
-- input_str = case (key, val) of
|
|
|
|
-- input_str = case (key, val) of
|
|
|
|
-- (_, "") ->
|
|
|
|
-- (_, "") ->
|
|
|
@@ -117,7 +117,7 @@ applySetTerminalString var = case key' of
|
|
|
|
-- else ">" ++ key ++ " " ++ longestCommonPrefix command_options
|
|
|
|
-- else ">" ++ key ++ " " ++ longestCommonPrefix command_options
|
|
|
|
-- command_options' =
|
|
|
|
-- command_options' =
|
|
|
|
-- if not (null command_options) && head command_options == key
|
|
|
|
-- if not (null command_options) && head command_options == key
|
|
|
|
-- then validTerminalCommands key
|
|
|
|
-- then validConsoleCommands key
|
|
|
|
-- else command_options
|
|
|
|
-- else command_options
|
|
|
|
--
|
|
|
|
--
|
|
|
|
-- --val' = Debug.Trace.trace key tail val
|
|
|
|
-- --val' = Debug.Trace.trace key tail val
|
|
|
@@ -129,12 +129,12 @@ getSplitString str = case break (== ' ') str of
|
|
|
|
(a, _) -> (a, "")
|
|
|
|
(a, _) -> (a, "")
|
|
|
|
|
|
|
|
|
|
|
|
isValidCommand :: String -> String -> Bool
|
|
|
|
isValidCommand :: String -> String -> Bool
|
|
|
|
isValidCommand arg1 arg2 = arg2 `elem` validTerminalCommands arg1
|
|
|
|
isValidCommand arg1 arg2 = arg2 `elem` validConsoleCommands arg1
|
|
|
|
|
|
|
|
validConsoleCommands :: String -> [String]
|
|
|
|
validTerminalCommands :: String -> [String]
|
|
|
|
validConsoleCommands "set" = ["hp", "invcap", "invsel", "mass", "mvspeed"]
|
|
|
|
validTerminalCommands "set" = ["hp", "invcap", "invsel", "mass", "mvspeed"]
|
|
|
|
validConsoleCommands "god" = ["on", "off"]
|
|
|
|
validTerminalCommands "god" = ["on", "off"]
|
|
|
|
validConsoleCommands _ = ["set", "spawn", "god"]
|
|
|
|
validTerminalCommands _ = ["set", "spawn", "god"]
|
|
|
|
validConsoleCommands _ = ["set", "spawn", "god"]
|
|
|
|
|
|
|
|
|
|
|
|
loadme :: a
|
|
|
|
loadme :: a
|
|
|
|
loadme = undefined
|
|
|
|
loadme = undefined
|