150 lines
6.1 KiB
Haskell
150 lines
6.1 KiB
Haskell
{-# LANGUAGE TupleSections #-}
|
|
module Dodge.Debug.Terminal
|
|
where
|
|
import MaybeHelp
|
|
import Dodge.Inventory.Add
|
|
import Dodge.Creature
|
|
import Dodge.Creature.Damage
|
|
--import Dodge.Creature.State
|
|
--import Dodge.Creature.YourControl
|
|
import Dodge.Data
|
|
import Dodge.Menu.PushPop
|
|
import Dodge.Item
|
|
import Control.Monad
|
|
--import Dodge.Base
|
|
|
|
import Control.Lens
|
|
import Text.Read (readMaybe)
|
|
import Data.List --(isPrefixOf, isInfixOf, intercalate)
|
|
import Data.Maybe
|
|
import Control.Applicative
|
|
import LensHelp
|
|
import qualified Data.Text as T
|
|
import qualified IntMapHelp as IM
|
|
--import qualified Debug.Trace
|
|
--import Graphics.Rendering.OpenGL.GL.Shaders (validateProgram)
|
|
--import Dodge.Data (Universe(Universe))
|
|
|
|
applyTerminalString :: [String] -> Universe -> Universe
|
|
applyTerminalString ss = case ss of
|
|
[] -> id
|
|
[s] -> applyTerminalCommand s
|
|
(s:ss') -> applyTerminalCommandArguments s ss'
|
|
|
|
applyTerminalCommand :: String -> Universe -> Universe
|
|
applyTerminalCommand s = case s of
|
|
"NOCLIP" -> config . debug_booleans . at Noclip %~ toggleJust
|
|
"LOADME" -> (uvWorld . creatures . ix 0 . crInv .~ stackedInventory)
|
|
. (uvWorld . creatures . ix 0 . crInvCapacity .~ 50)
|
|
"LM" -> applyTerminalCommand "LOADME"
|
|
"LT" -> applyTerminalCommand "LOADTEST"
|
|
['L',x] -> (uvWorld . creatures . ix 0 . crInv .~ IM.fromList (zip [0..] $ inventoryX x))
|
|
. (uvWorld . creatures . ix 0 . crInvCapacity .~ 50)
|
|
"GODON" -> uvWorld . creatures . ix 0 . crApplyDamage .~ applyNoDamage
|
|
"GODOFF" -> uvWorld . creatures . ix 0 . crApplyDamage .~ defaultApplyDamage
|
|
"LOADTEST" -> (uvWorld . creatures . ix 0 . crInv .~ testInventory)
|
|
. (uvWorld . creatures . ix 0 . crInvCapacity .~ 50)
|
|
_ -> id
|
|
--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' ('s': 'p': 'a': 'w': 'n': ' ': var)
|
|
-- | var /= [] = id -- work out how to spawn stuff
|
|
-- | otherwise = id
|
|
--applyTerminalString' _ = id
|
|
|
|
applyTerminalCommandArguments :: String -> [String] -> Universe -> Universe
|
|
applyTerminalCommandArguments command args u = case command of
|
|
"ITEM" -> fromMaybe u $ do
|
|
(ibt,n) <- parseItem args
|
|
return $ u & uvWorld %~ flip (foldr ($)) (replicate n (snd . createPutItem (itemFromBase ibt)))
|
|
_ -> u
|
|
|
|
parseItem :: [String] -> Maybe (ItemBaseType,Int)
|
|
parseItem (x:xs)
|
|
= (readMaybe (x++" {_xNum=" ++ show (parseNum xs)++"}") <&> (,1))
|
|
<|> (readMaybe x <&> (,parseNum xs) )
|
|
<|> (readMaybe ("CRAFT "++x) <&> (,parseNum xs))
|
|
<|> (readMaybe ("HELD {_ibtHeld="++x++"}") <&> (,parseNum xs))
|
|
<|> (readMaybe ("EQUIP {_ibtEquip="++x++"}") <&> (,parseNum xs))
|
|
<|> (readMaybe ("LEFT {_ibtLEFT="++x++"}") <&> (,parseNum xs))
|
|
<|> (readMaybe ("HELD ("++x++" {_xNum=" ++ show (parseNum xs)++"}") <&> (,1))
|
|
<|> parseItem (xs & ix 0 .++~ (x ++ " "))
|
|
parseItem [] = Nothing
|
|
|
|
parseNum :: [String] -> Int
|
|
parseNum xs = fromMaybe 1 $ xs ^? ix 0 >>= readMaybe
|
|
|
|
showTerminalError :: String -> String -> Universe -> Universe
|
|
showTerminalError cmd s = menuLayers .:~ InputScreen (T.pack 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')
|
|
"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 (T.pack 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 _ _ = []
|