From 6cc29813d8c5563925d1300b806099408188d05b Mon Sep 17 00:00:00 2001 From: justin Date: Sun, 19 Jun 2022 11:04:16 +0100 Subject: [PATCH] Allow creation of items via typed command --- src/Dodge/Combine/Data.hs | 6 ++-- src/Dodge/Debug/Terminal.hs | 72 +++++++++++++++++++++---------------- src/Dodge/Equipment/Data.hs | 2 +- src/Dodge/Event.hs | 11 +++--- src/Dodge/Event/Menu.hs | 2 +- src/Dodge/Inventory/Add.hs | 6 ++++ src/Dodge/Item.hs | 1 + 7 files changed, 61 insertions(+), 39 deletions(-) diff --git a/src/Dodge/Combine/Data.hs b/src/Dodge/Combine/Data.hs index 991c2ac3d..b66e00033 100644 --- a/src/Dodge/Combine/Data.hs +++ b/src/Dodge/Combine/Data.hs @@ -64,7 +64,7 @@ data CraftType | TIMEMODULE | SIZEMODULE | GRAVITYMODULE - deriving (Eq,Ord,Show,Enum) + deriving (Eq,Ord,Show,Enum,Read) -- TODO make this an enum somehow...? data ItemBaseType @@ -164,7 +164,7 @@ data ItemBaseType | MEDKIT Int | CRAFT CraftType -- - deriving (Eq,Ord,Show) + deriving (Eq,Ord,Show,Read) data ItemModuleType = EMPTYMODULE @@ -193,7 +193,7 @@ data Detector = ITEMDETECTOR | CREATUREDETECTOR | WALLDETECTOR - deriving (Eq,Ord,Show) + deriving (Eq,Ord,Show,Read) data ModuleSlot = ModBullet diff --git a/src/Dodge/Debug/Terminal.hs b/src/Dodge/Debug/Terminal.hs index 13730cc25..135858823 100644 --- a/src/Dodge/Debug/Terminal.hs +++ b/src/Dodge/Debug/Terminal.hs @@ -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 diff --git a/src/Dodge/Equipment/Data.hs b/src/Dodge/Equipment/Data.hs index b31b94e9a..b775bc761 100644 --- a/src/Dodge/Equipment/Data.hs +++ b/src/Dodge/Equipment/Data.hs @@ -6,7 +6,7 @@ data EquipSite | GoesOnWrist | GoesOnLegs | GoesOnSpecial - deriving (Eq,Ord,Show) + deriving (Eq,Ord,Show,Read) data EquipPosition = OnHead | OnChest diff --git a/src/Dodge/Event.hs b/src/Dodge/Event.hs index 6237dc540..238bd82eb 100644 --- a/src/Dodge/Event.hs +++ b/src/Dodge/Event.hs @@ -18,7 +18,8 @@ import Dodge.Combine import Dodge.Event.Keyboard --import Dodge.Event.Menu import Dodge.Base -import Dodge.Combine.Module +--import Dodge.Item +--import Dodge.Combine.Module import Dodge.Data --import Dodge.Base.Window import Dodge.PreloadData @@ -28,7 +29,7 @@ import Dodge.Inventory.Add import Dodge.SoundLogic --import Geometry --import Preload.Update -import Dodge.FloorItem +--import Dodge.FloorItem import qualified IntMapHelp as IM import ListHelp @@ -109,12 +110,14 @@ doCombine :: Int -> World -> World doCombine i w = case combineItemListYou w !? i of Nothing -> w Just (is,it) -> enterCombineInv - . uncurry (putItemInInvID yid) - . copyItemToFloorID (_crPos $ you w) (applyModules it) + . createPutItem it +-- . uncurry (putItemInInvID yid) +-- . copyItemToFloorID (_crPos $ you w) (applyModules it) $ foldr (rmInvItem yid) w (sort is) where yid = _yourID w + handleMouseWheelEvent :: MouseWheelEventData -> Universe -> Maybe Universe handleMouseWheelEvent mwev w = case _menuLayers w of [] -> case mouseWheelEventPos mwev of diff --git a/src/Dodge/Event/Menu.hs b/src/Dodge/Event/Menu.hs index c710de8c4..c77f18d75 100644 --- a/src/Dodge/Event/Menu.hs +++ b/src/Dodge/Event/Menu.hs @@ -22,7 +22,7 @@ handlePressedKeyInMenu mState scode = case mState of WaitScreen {} -> return . Just InputScreen s help -> case scode of ScancodeEscape -> popScreen - ScancodeReturn -> popScreen . applyTerminalString (T.unpack s) + ScancodeReturn -> popScreen . applyTerminalString (words $ T.unpack s) ScancodeTab -> autoCompleteTerminal (T.unpack s) help ScancodeBackspace -> return . Just . (menuLayers . ix 0 . scInput %~ doBackspace) -- text input handled by handleTextInput diff --git a/src/Dodge/Inventory/Add.hs b/src/Dodge/Inventory/Add.hs index 2462c46e1..a5630a010 100644 --- a/src/Dodge/Inventory/Add.hs +++ b/src/Dodge/Inventory/Add.hs @@ -1,6 +1,9 @@ module Dodge.Inventory.Add where import Dodge.Data import Dodge.Inventory.CheckSlots +import Dodge.FloorItem +import Dodge.Combine.Module +import Dodge.Base.You import Data.Maybe import Control.Lens @@ -42,3 +45,6 @@ tryPutItemInInv cid flit w = case maybeInvSlot of -- updateItLocation invid w' = case _itID it of -- Nothing -> w' -- Just j -> w' & itemPositions . ix j .~ InInv cid invid +createPutItem :: Item -> World -> World +createPutItem it w = uncurry (putItemInInvID (_yourID w)) + $ copyItemToFloorID (_crPos $ you w) (applyModules it) w diff --git a/src/Dodge/Item.hs b/src/Dodge/Item.hs index b765ef5c4..f04280684 100644 --- a/src/Dodge/Item.hs +++ b/src/Dodge/Item.hs @@ -255,3 +255,4 @@ baseToFamily ibt = case ibt of KEYCARD _ -> HeldFamily MEDKIT _ -> ConsumableFamily +