Allow creation of items via typed command

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

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
+applyTerminalCommand :: String -> Universe -> Universe
-applyTerminalString "NOCLIP" = config . debug_booleans . at Noclip %~ toggleJust
+applyTerminalCommand s = case s of
-applyTerminalString "LOADME" = (uvWorld . creatures . ix 0 . crInv .~ stackedInventory)
+    "NOCLIP" -> config . debug_booleans . at Noclip %~ toggleJust
+    "LOADME" -> (uvWorld . creatures . ix 0 . crInv .~ stackedInventory)
         . (uvWorld . creatures . ix 0 . crInvCapacity .~ 50)
-applyTerminalString "LM" = applyTerminalString "LOADME"
+    "LM"    -> applyTerminalCommand "LOADME"
-applyTerminalString "LT" = applyTerminalString "LOADTEST"
+    "LT"    -> applyTerminalCommand "LOADTEST"
-applyTerminalString ['L',x] = 
+    ['L',x]     -> (uvWorld . creatures . ix 0 . crInv .~ IM.fromList (zip [0..] $ inventoryX 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
+    "GODON"     -> uvWorld . creatures . ix 0 . crApplyDamage .~ applyNoDamage
-applyTerminalString "GODOFF" = uvWorld . creatures . ix 0 . crApplyDamage .~ defaultApplyDamage
+    "GODOFF"    -> uvWorld . creatures . ix 0 . crApplyDamage .~ defaultApplyDamage
-applyTerminalString "LOADTEST" = (uvWorld . creatures . ix 0 . crInv .~ testInventory)
+    "LOADTEST"  -> (uvWorld . creatures . ix 0 . crInv .~ testInventory)
         . (uvWorld . creatures . ix 0 . crInvCapacity .~ 50)
-applyTerminalString ('s': 'e': 't': '_': 'h': 'p': ' ': hp)
+    _ -> id
-    | isNothing (readMaybe hp :: Maybe Int) = id
+--applyTerminalString' ('s': 'e': 't': '_': 'h': 'p': ' ': hp)
-    | otherwise = uvWorld . creatures . ix 0 . crHP .~ read hp
+--    | isNothing (readMaybe hp :: Maybe Int) = id
-applyTerminalString ('s': 'e': 't': '_': 'i': 'n': 'v': 'c': 'a': 'p': ' ': n)
+--    | otherwise = uvWorld . creatures . ix 0 . crHP .~ read hp
-    | isNothing (readMaybe n :: Maybe Int) = id
+--applyTerminalString' ('s': 'e': 't': '_': 'i': 'n': 'v': 'c': 'a': 'p': ' ': n)
-    | otherwise = uvWorld . creatures . ix 0 . crInvCapacity .~ read n
+--    | isNothing (readMaybe n :: Maybe Int) = id
-applyTerminalString ('s': 'e': 't': ' ': var)
+--    | otherwise = uvWorld . creatures . ix 0 . crInvCapacity .~ read n
-    | var /= [] = applySetTerminalString var
+--applyTerminalString' ('s': 'e': 't': ' ': var)
-    | otherwise = id
+--    | var /= [] = applySetTerminalString var
-applyTerminalString ('g': 'o': 'd': ' ': var)
+--    | otherwise = id
-    | var == "on" = applyTerminalString "GODON"
+--applyTerminalString' ('s': 'p': 'a': 'w': 'n': ' ': var)
-    | var == "off" = applySetTerminalString "GODOFF"
+--    | var /= [] = id -- work out how to spawn stuff
-    | otherwise = showTerminalError ("god "++var) ("Invalid god argument: " ++ var)
+--    | otherwise = id
-applyTerminalString ('s': 'p': 'a': 'w': 'n': ' ': var)
+--applyTerminalString' _   = id
-    | var /= [] = id -- work out how to spawn stuff
+
-    | otherwise = id
+applyTerminalCommandArguments :: String -> [String] -> Universe -> Universe
-applyTerminalString _   = id
+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

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

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)
+        . createPutItem it
-        . copyItemToFloorID (_crPos $ you w) (applyModules 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

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

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

src/Dodge/Item.hs

@@ -255,3 +255,4 @@ baseToFamily ibt = case ibt of
     KEYCARD _   -> HeldFamily
     
     MEDKIT _    -> ConsumableFamily
+