justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Refactor, try to limit dependencies

Browse Source
This commit is contained in:
justin
2022-07-28 00:59:56 +01:00
parent 8aa5c17ab9
commit 160560af5f
418 changed files with 15104 additions and 13342 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Debug/Terminal.hs
+69 -64
View File
@@ -1,47 +1,47 @@
{-# LANGUAGE TupleSections #-}
module Dodge.Debug.Terminal
where
import MaybeHelp
import Dodge.Inventory.Add
import Dodge.Creature
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
module Dodge.Debug.Terminal where
import Control.Applicative
import LensHelp
import Control.Lens
import Control.Monad
import Data.List
import Data.Maybe
import qualified Data.Text as T
import Dodge.Creature
import Dodge.Data.Universe
import Dodge.Inventory.Add
import Dodge.Item
import Dodge.Menu.PushPop
import qualified IntMapHelp as IM
--import qualified Debug.Trace
--import Graphics.Rendering.OpenGL.GL.Shaders (validateProgram)
--import Dodge.Data (Universe(Universe))
import LensHelp
import MaybeHelp
import Text.Read (readMaybe)
applyTerminalString :: [String] -> Universe -> Universe
applyTerminalString ss = case ss of
[] -> id
[s] -> applyTerminalCommand s
(s:ss') -> applyTerminalCommandArguments s ss'
(s : ss') -> applyTerminalCommandArguments s ss'
applyTerminalCommand :: String -> Universe -> Universe
applyTerminalCommand s = case s of
"NOCLIP" -> uvConfig . debug_booleans . at Noclip %~ toggleJust
"LOADME" -> (uvWorld . cWorld . creatures . ix 0 . crInv .~ stackedInventory)
. (uvWorld . cWorld . creatures . ix 0 . crInvCapacity .~ 50)
"LM" -> applyTerminalCommand "LOADME"
"LT" -> applyTerminalCommand "LOADTEST"
['L',x] -> (uvWorld . cWorld . creatures . ix 0 . crInv .~ IM.fromList (zip [0..] $ inventoryX x))
. (uvWorld . cWorld . creatures . ix 0 . crInvCapacity .~ 50)
"GODON" -> uvWorld . cWorld . creatures . ix 0 . crMaterial .~ Crystal
"GODOFF" -> uvWorld . cWorld . creatures . ix 0 . crMaterial .~ Flesh
"LOADTEST" -> (uvWorld . cWorld . creatures . ix 0 . crInv .~ testInventory)
. (uvWorld . cWorld . creatures . ix 0 . crInvCapacity .~ 50)
"LOADME" ->
(uvWorld . cWorld . creatures . ix 0 . crInv .~ stackedInventory)
. (uvWorld . cWorld . creatures . ix 0 . crInvCapacity .~ 50)
"LM" -> applyTerminalCommand "LOADME"
"LT" -> applyTerminalCommand "LOADTEST"
['L', x] ->
(uvWorld . cWorld . creatures . ix 0 . crInv .~ IM.fromList (zip [0 ..] $ inventoryX x))
. (uvWorld . cWorld . creatures . ix 0 . crInvCapacity .~ 50)
"GODON" -> uvWorld . cWorld . creatures . ix 0 . crMaterial .~ Crystal
"GODOFF" -> uvWorld . cWorld . creatures . ix 0 . crMaterial .~ Flesh
"LOADTEST" ->
(uvWorld . cWorld . creatures . ix 0 . crInv .~ testInventory)
. (uvWorld . cWorld . 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
@@ -59,20 +59,20 @@ applyTerminalCommand s = case s of
applyTerminalCommandArguments :: String -> [String] -> Universe -> Universe
applyTerminalCommandArguments command args u = case command of
"ITEM" -> fromMaybe u $ do
(ibt,n) <- parseItem args
(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 :: [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
@@ -84,20 +84,21 @@ 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)
"" -> showTerminalError ("set " ++ var) ("Unable to read as argument as float: " ++ val)
"hp" -> uvWorld . cWorld . creatures . ix 0 . crHP .~ round (fromJust val')
"invcap" -> uvWorld . cWorld . creatures . ix 0 . crInvCapacity .~ round (fromJust val')
"mass" -> uvWorld . cWorld . creatures . ix 0 . crMass .~ fromJust val'
"mvspeed" -> uvWorld . cWorld . 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
"mvspeed" -> uvWorld . cWorld . 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))
autoCompleteTerminal s _ =
return
. (popScreen' >=> pushScreen' (InputScreen (T.pack input_str) valid_commands))
where
(key, val) = getSplitString $ tail s
command_options = case val of
@@ -105,24 +106,28 @@ autoCompleteTerminal s _ = return .
_ -> 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
(_, "") ->
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)
getSplitString str = case break (== ' ') str of
(a, _ : b) -> (a, b)
(a, _) -> (a, "")
isValidCommand :: String -> String -> Bool
@@ -141,6 +146,6 @@ longestCommonPrefix [] = []
longestCommonPrefix lists = foldr1 commonPrefix lists
commonPrefix :: Eq a => [a] -> [a] -> [a]
commonPrefix (x:xs) (y:ys)
| x == y = x : commonPrefix xs ys
commonPrefix (x : xs) (y : ys)
| x == y = x : commonPrefix xs ys
commonPrefix _ _ = []