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

Allow creation of items via typed command

Browse Source
This commit is contained in:
justin
2022-06-19 11:04:16 +01:00
parent 075d4b1164
commit 6cc29813d8
7 changed files with 61 additions and 39 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Debug/Terminal.hs
+42 -30
View File
@@ -1,13 +1,16 @@
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)
@@ -20,37 +23,46 @@ import qualified IntMapHelp as IM
--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'
applyTerminalString :: String -> Universe -> Universe
applyTerminalString "NOCLIP" = config . debug_booleans . at Noclip %~ toggleJust
applyTerminalString "LOADME" = (uvWorld . creatures . ix 0 . crInv .~ stackedInventory)
. (uvWorld . creatures . ix 0 . crInvCapacity .~ 50)
applyTerminalString "LM" = applyTerminalString "LOADME"
applyTerminalString "LT" = applyTerminalString "LOADTEST"
applyTerminalString ['L',x] =
(uvWorld . creatures . ix 0 . crInv .~ IM.fromList (zip [0..] $ inventoryX x))
. (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 ('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
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 <- safeHead args >>= readMaybe
return $ u & uvWorld %~ createPutItem (itemFromBase ibt)
_ -> u
showTerminalError :: String -> String -> Universe -> Universe
showTerminalError cmd s = menuLayers .:~ InputScreen (T.pack cmd) s