119 lines
5.1 KiB
Haskell
119 lines
5.1 KiB
Haskell
module Dodge.Debug.Terminal
|
|
where
|
|
import Dodge.Creature
|
|
import Dodge.Creature.Damage
|
|
--import Dodge.Creature.State
|
|
--import Dodge.Creature.YourControl
|
|
import Dodge.Data
|
|
import Dodge.Menu.PushPop
|
|
import Control.Monad
|
|
|
|
import Control.Lens
|
|
import Text.Read (readMaybe)
|
|
import Data.List --(isPrefixOf, isInfixOf, intercalate)
|
|
import Data.Maybe
|
|
import LensHelp
|
|
--import qualified Debug.Trace
|
|
--import Graphics.Rendering.OpenGL.GL.Shaders (validateProgram)
|
|
--import Dodge.Data (Universe(Universe))
|
|
|
|
applyTerminalString :: String -> Universe -> Universe
|
|
applyTerminalString "NOCLIP" = config . debug_noclip %~ not
|
|
applyTerminalString "LOADME" = (uvWorld . creatures . ix 0 . crInv .~ stackedInventory)
|
|
. (uvWorld . creatures . ix 0 . crInvCapacity .~ 50)
|
|
applyTerminalString "LA" = (uvWorld . creatures . ix 0 . crInv .~ inventoryA)
|
|
. (uvWorld . creatures . ix 0 . crInvCapacity .~ 50)
|
|
applyTerminalString "LB" = (uvWorld . creatures . ix 0 . crInv .~ inventoryB)
|
|
. (uvWorld . creatures . ix 0 . crInvCapacity .~ 50)
|
|
applyTerminalString "GODON" = uvWorld . creatures . ix 0 . crApplyDamage .~ applyNoDamage
|
|
applyTerminalString "GODOFF" = uvWorld . creatures . ix 0 . crApplyDamage .~ defaultApplyDamage
|
|
applyTerminalString "LOADTEST" = (uvWorld . creatures . ix 0 . crInv .~ testInventory)
|
|
. (uvWorld . creatures . ix 0 . crInvCapacity .~ 50)
|
|
applyTerminalString "LM" = applyTerminalString "LOADME"
|
|
applyTerminalString "LT" = applyTerminalString "LOADTEST"
|
|
applyTerminalString ('s': 'e': 't': '_': 'h': 'p': ' ': hp)
|
|
| isNothing (readMaybe hp :: Maybe Int) = id
|
|
| otherwise = uvWorld . creatures . ix 0 . crHP .~ read hp
|
|
applyTerminalString ('s': 'e': 't': '_': 'i': 'n': 'v': 'c': 'a': 'p': ' ': n)
|
|
| isNothing (readMaybe n :: Maybe Int) = id
|
|
| otherwise = uvWorld . creatures . ix 0 . crInvCapacity .~ read n
|
|
applyTerminalString ('s': 'e': 't': ' ': var)
|
|
| var /= [] = applySetTerminalString var
|
|
| otherwise = id
|
|
applyTerminalString ('g': 'o': 'd': ' ': var)
|
|
| var == "on" = applyTerminalString "GODON"
|
|
| var == "off" = applySetTerminalString "GODOFF"
|
|
| otherwise = showTerminalError ("god "++var) ("Invalid god argument: " ++ var)
|
|
applyTerminalString ('s': 'p': 'a': 'w': 'n': ' ': var)
|
|
| var /= [] = id -- work out how to spawn stuff
|
|
| otherwise = id
|
|
applyTerminalString _ = id
|
|
|
|
showTerminalError :: String -> String -> Universe -> Universe
|
|
showTerminalError cmd s = menuLayers .:~ InputScreen cmd s
|
|
|
|
applySetTerminalString :: String -> Universe -> Universe
|
|
applySetTerminalString [] = id
|
|
applySetTerminalString var = case key' of
|
|
"" -> showTerminalError ("set "++var) ("Unable to read as argument as float: " ++ val)
|
|
"hp" -> uvWorld . creatures . ix 0 . crHP .~ round (fromJust val')
|
|
"invcap" -> uvWorld . creatures . ix 0 . crInvCapacity .~ round (fromJust val')
|
|
"invsel" -> uvWorld . creatures . ix 0 . crInvSel .~ round (fromJust val')
|
|
"mass" -> uvWorld . creatures . ix 0 . crMass .~ fromJust val'
|
|
"mvspeed" -> uvWorld . creatures . ix 0 . crMvType .mvSpeed .~ fromJust val'
|
|
_ -> showTerminalError ("set "++var) ("Invalid set command: " ++ key) -- never reached?
|
|
where
|
|
(key, val) = getSplitString var
|
|
val' = readMaybe val :: Maybe Float
|
|
key' = if isNothing val' then "" else key
|
|
|
|
autoCompleteTerminal :: String -> String -> Universe -> IO (Maybe Universe)
|
|
autoCompleteTerminal s _ = return .
|
|
(popScreen' >=> pushScreen' (InputScreen input_str valid_commands))
|
|
where
|
|
(key, val) = getSplitString $ tail s
|
|
command_options = case val of
|
|
"" -> filter (isInfixOf key) (validTerminalCommands "")
|
|
_ -> filter (isInfixOf val) (validTerminalCommands key)
|
|
-- basic autocomplete if single option available (or as far as possible)
|
|
input_str = case (key, val) of
|
|
(_, "") -> if length command_options == 1
|
|
then ">" ++ head command_options ++ " "
|
|
else ">" ++ longestCommonPrefix command_options
|
|
_ -> if length command_options == 1
|
|
then ">" ++ key ++ " " ++ head command_options ++ " "
|
|
else if null command_options
|
|
then s
|
|
else ">" ++ key ++ " " ++ longestCommonPrefix command_options
|
|
command_options' = if not (null command_options) && head command_options == key
|
|
then validTerminalCommands key
|
|
else command_options
|
|
|
|
--val' = Debug.Trace.trace key tail val
|
|
valid_commands = "Options: " ++ intercalate ", " command_options'
|
|
|
|
getSplitString :: [Char] -> ([Char], [Char])
|
|
getSplitString str = case break (==' ') str of
|
|
(a, _:b) -> (a, b)
|
|
(a, _) -> (a, "")
|
|
|
|
isValidCommand :: String -> String -> Bool
|
|
isValidCommand arg1 arg2 = arg2 `elem` validTerminalCommands arg1
|
|
|
|
validTerminalCommands :: String -> [String]
|
|
validTerminalCommands "set" = ["hp", "invcap", "invsel", "mass", "mvspeed"]
|
|
validTerminalCommands "god" = ["on", "off"]
|
|
validTerminalCommands _ = ["set", "spawn", "god"]
|
|
|
|
loadme :: a
|
|
loadme = undefined
|
|
|
|
longestCommonPrefix :: Eq a => [[a]] -> [a]
|
|
longestCommonPrefix [] = []
|
|
longestCommonPrefix lists = foldr1 commonPrefix lists
|
|
|
|
commonPrefix :: Eq a => [a] -> [a] -> [a]
|
|
commonPrefix (x:xs) (y:ys)
|
|
| x == y = x : commonPrefix xs ys
|
|
commonPrefix _ _ = []
|