Commit towards merge

src/Dodge/Debug/Terminal.hs

@@ -1,14 +1,32 @@
 module Dodge.Debug.Terminal
+<<<<<<< HEAD
     ( applyTerminalString
     ) where
 import Dodge.Data
 import Dodge.Creature
 import Dodge.Creature.YourControl
 import Dodge.Creature.State
+=======
+    where
+import           Dodge.Creature
+import           Dodge.Creature.State
+import           Dodge.Creature.YourControl
+import           Dodge.Data
+import Dodge.Menu.PushPop
+import Control.Monad
+>>>>>>> ross/loop-master
 
-import Control.Lens
+import           Control.Lens
+import Text.Read (readMaybe)
+import Data.List (isPrefixOf, isInfixOf, intercalate)
+import Data.Maybe (fromJust)
+import LensHelp
+import qualified Debug.Trace
+import Graphics.Rendering.OpenGL.GL.Shaders (validateProgram)
+import Dodge.Data (Universe(Universe))
 
 applyTerminalString :: String -> Universe -> Universe
+<<<<<<< HEAD
 applyTerminalString str = case str of
     "NOCLIP" -> config . debug_noclip %~ not
     "LOADME" -> (uvWorld . creatures . ix 0 . crInv .~ stackedInventory)
@@ -23,3 +41,98 @@ applyTerminalString str = case str of
 
 loadme :: a -> a
 loadme = id
+=======
+applyTerminalString "NOCLIP" = config . debug_noclip %~ not
+applyTerminalString "LOADME" = (uvWorld . creatures . ix 0 . crInv .~ stackedInventory)
+    . (uvWorld . creatures . ix 0 . crInvCapacity .~ 50)
+applyTerminalString "GODON" =
+    uvWorld . creatures . ix 0 . crUpdate .~ stateUpdateDamage clearDamage yourControl
+applyTerminalString "GODOFF" = uvWorld . creatures . ix 0 . crUpdate .~ stateUpdate yourControl
+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)
+    | (readMaybe hp :: Maybe Int) == Nothing = id
+    | otherwise = uvWorld . creatures . ix 0 . crHP .~ read hp
+applyTerminalString ('s': 'e': 't': '_': 'i': 'n': 'v': 'c': 'a': 'p': ' ': n)
+    | (readMaybe n :: Maybe Int) == Nothing = 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 val' == Nothing then "" else key
+
+autoCompleteTerminal :: String -> String -> Universe -> IO (Maybe Universe)
+autoCompleteTerminal s help = 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 length command_options > 0 && 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` v = True
+    | otherwise = False
+    where
+        v = 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 _ _ = []
+>>>>>>> ross/loop-master