diff --git a/src/Dodge/Creature.hs b/src/Dodge/Creature.hs index fd7f95a58..3dd70a4ce 100644 --- a/src/Dodge/Creature.hs +++ b/src/Dodge/Creature.hs @@ -214,54 +214,50 @@ inventoryX c = case c of , makeTypeCraftNum 1 CONCUSSMODULE , makeTypeCraftNum 1 STATICMODULE ] + 'M' -> stackedInventory + 'T' -> testInventory _ -> [] -testInventory :: IM.IntMap Item +testInventory :: [Item] testInventory = - IM.fromList $ - zip - [0 ..] - [ makeTypeCraftNum 9 PIPE - , autoAmr - , brainHat - , headLamp - , autoDetector WALLDETECTOR - , magShield - , frontArmour - , wristArmour - , flatShield - , sniperRifle - , makeTypeCraftNum 1 MOTOR - , makeTypeCraft INCENDIARYMODULE - , makeTypeCraft STATICMODULE - , makeTypeCraft CONCUSSMODULE - , teleportModule - , makeTypeCraftNum 10 HARDWARE - , makeTypeCraftNum 3 SPRING - , makeTypeCraftNum 10 CAN - , makeTypeCraftNum 3 PLANK - ] + [ makeTypeCraftNum 9 PIPE + , autoAmr + , brainHat + , headLamp + , autoDetector WALLDETECTOR + , magShield + , frontArmour + , wristArmour + , flatShield + , sniperRifle + , makeTypeCraftNum 1 MOTOR + , makeTypeCraft INCENDIARYMODULE + , makeTypeCraft STATICMODULE + , makeTypeCraft CONCUSSMODULE + , teleportModule + , makeTypeCraftNum 10 HARDWARE + , makeTypeCraftNum 3 SPRING + , makeTypeCraftNum 10 CAN + , makeTypeCraftNum 3 PLANK + ] -stackedInventory :: IM.IntMap Item +stackedInventory :: [Item] stackedInventory = - IM.fromList $ - zip - [0 ..] - [ burstRifle - , pipe - , rewindGun - , tractorGun - , autoPistol - , pistol - , teslaGun - , blinkGun - , miniGunX 3 - , boosterGun - , remoteLauncher - , flatShield - , spawnGun (lamp 5) - , lasGun - , flameThrower - , poisonSprayer - , launcher - ] + [ burstRifle + , pipe + , rewindGun + , tractorGun + , autoPistol + , pistol + , teslaGun + , blinkGun + , miniGunX 3 + , boosterGun + , remoteLauncher + , flatShield + , spawnGun (lamp 5) + , lasGun + , flameThrower + , poisonSprayer + , launcher + ] diff --git a/src/Dodge/Data/Item.hs b/src/Dodge/Data/Item.hs index 8b8c0aa2c..6a201d667 100644 --- a/src/Dodge/Data/Item.hs +++ b/src/Dodge/Data/Item.hs @@ -31,7 +31,7 @@ import Dodge.Data.Item.Targeting data Item = Item { _itUse :: ItemUse , _itType :: ItemType - , _itID :: Maybe Int + , _itID :: Int , _itLocation :: ItemLocation , _itIsHeld :: Bool , _itEffect :: ItEffect diff --git a/src/Dodge/Data/Item/Misc.hs b/src/Dodge/Data/Item/Misc.hs index 6041e819b..6a31c2f67 100644 --- a/src/Dodge/Data/Item/Misc.hs +++ b/src/Dodge/Data/Item/Misc.hs @@ -35,8 +35,9 @@ data ItemValueType = MundaneItem | ArtefactItem data ItemLocation = InInv {_ipCrID :: Int, _ipInvID :: Int} + | OnTurret {_ipTuID :: Int} | OnFloor {_ipFlID :: Int} - | VoidItm + | InVoid deriving (Eq, Show, Read) makeLenses ''ItemDimension diff --git a/src/Dodge/Debug/Terminal.hs b/src/Dodge/Debug/Terminal.hs index c48c040eb..4f0b170a3 100644 --- a/src/Dodge/Debug/Terminal.hs +++ b/src/Dodge/Debug/Terminal.hs @@ -2,6 +2,7 @@ module Dodge.Debug.Terminal where +import Dodge.Item.Location.Initialize import Control.Applicative import Control.Lens import Control.Monad @@ -27,35 +28,14 @@ applyTerminalString ss = case ss of 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 %~ initSpecificCrItemLocations 0) + . (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 ---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 diff --git a/src/Dodge/Default/Item.hs b/src/Dodge/Default/Item.hs index 57d9988c3..f0af75f2b 100644 --- a/src/Dodge/Default/Item.hs +++ b/src/Dodge/Default/Item.hs @@ -18,11 +18,11 @@ defaultItem = { _itCurseStatus = Uncursed , _itType = defaultItemType , _itEffect = defaultItEffect - , _itID = Nothing + , _itID = 0 , _itIsHeld = False , _itInvColor = yellow , _itInvSize = 1 - , _itLocation = VoidItm + , _itLocation = InVoid , _itDimension = ItemDimension 2 0 (V3 10 (-5) 3) , _itUse = CraftUse (ItAmount 1) , _itParams = NoParams diff --git a/src/Dodge/FloorItem.hs b/src/Dodge/FloorItem.hs index 31c7a9ae3..cbd7c8876 100644 --- a/src/Dodge/FloorItem.hs +++ b/src/Dodge/FloorItem.hs @@ -25,9 +25,7 @@ copyItemToFloorID pos it w = where (p', w') = findWallFreeDropPoint (_dimRad $ _itDimension it) pos w rot = fst . randomR (- pi, pi) $ _randGen w - updateLocation = case it ^? itID of - Just (Just i') -> cWorld . itemLocations . ix i' .~ OnFloor flid - _ -> id + updateLocation = cWorld . itemLocations . ix (_itID it) .~ OnFloor flid flid = IM.newKey $ _floorItems (_cWorld w) theflit = FlIt diff --git a/src/Dodge/Inventory/Add.hs b/src/Dodge/Inventory/Add.hs index eafd9df15..38a9239fe 100644 --- a/src/Dodge/Inventory/Add.hs +++ b/src/Dodge/Inventory/Add.hs @@ -32,9 +32,7 @@ tryPutItemInInv cid flit w = case maybeInvSlot of where it = _flIt flit maybeInvSlot = checkInvSlotsYou it w - updateItLocation invid w' = case _itID it of - Nothing -> w' - Just j -> w' & cWorld . itemLocations . ix j .~ InInv cid invid + updateItLocation invid w' = w' & cWorld . itemLocations . ix (_itID it) .~ InInv cid invid --{- | Pick up a specific item. -} --putItemInInv :: Int -> FloorItem -> World -> World diff --git a/src/Dodge/Item/Location.hs b/src/Dodge/Item/Location.hs index 7feca20f8..b46d97f15 100644 --- a/src/Dodge/Item/Location.hs +++ b/src/Dodge/Item/Location.hs @@ -11,7 +11,7 @@ setHeldItemLoc cr = fst . getHeldItemLoc cr getHeldItemLoc :: Creature -> World -> (World, Int) getHeldItemLoc cr w = case maybeitid of Nothing -> - ( w & cWorld . creatures . ix cid . crInv . ix j . itID ?~ newitid + ( w & cWorld . creatures . ix cid . crInv . ix j . itID .~ newitid & cWorld . itemLocations %~ IM.insert newitid (InInv cid j) , itid ) @@ -20,7 +20,7 @@ getHeldItemLoc cr w = case maybeitid of cid = _crID cr j = crSel cr newitid = IM.newKey $ _itemLocations (_cWorld w) - maybeitid = cr ^? crInv . ix j . itID . _Just + maybeitid = cr ^? crInv . ix j . itID itid = fromMaybe newitid maybeitid getItem :: Int -> World -> Maybe Item @@ -29,7 +29,8 @@ getItem itid w = do case itpos of OnFloor flitid -> w ^? cWorld . floorItems . ix flitid . flIt InInv cid invid -> w ^? cWorld . creatures . ix cid . crInv . ix invid - VoidItm -> Nothing + OnTurret mcid -> w ^? cWorld . machines . ix mcid . mcType . _McTurret . tuWeapon + InVoid -> Nothing pointerToItemLocation :: Applicative f => diff --git a/src/Dodge/Item/Location/Initialize.hs b/src/Dodge/Item/Location/Initialize.hs new file mode 100644 index 000000000..cc1dda5ac --- /dev/null +++ b/src/Dodge/Item/Location/Initialize.hs @@ -0,0 +1,63 @@ +module Dodge.Item.Location.Initialize + where +import Dodge.Data.CWorld +import Control.Lens +import qualified IntMapHelp as IM +import Data.Traversable + +initItemLocations :: CWorld -> CWorld +initItemLocations = initCrsItemLocations . initFlItemsLocations . initTusItemLocations + +initCrsItemLocations :: CWorld -> CWorld +initCrsItemLocations w = w' & creatures .~ newcreatures + where + (w', newcreatures) = mapAccumR initCrItemLocations w (_creatures w) + +initFlItemsLocations :: CWorld -> CWorld +initFlItemsLocations w = w' & floorItems .~ newfloorItems + where + (w', newfloorItems) = mapAccumR initFlItemLocation w (_floorItems w) + +initTusItemLocations :: CWorld -> CWorld +initTusItemLocations w = w' & machines .~ newmachines + where + (w', newmachines) = mapAccumR initTuItemLocation w (_machines w) + +initSpecificCrItemLocations :: Int -> CWorld -> CWorld +initSpecificCrItemLocations crid w = w' & creatures . ix crid .~ newcr + where + (w',newcr) = initCrItemLocations w (w ^?! creatures . ix crid) + +initCrItemLocations :: CWorld -> Creature -> (CWorld, Creature) +initCrItemLocations w cr = (w', cr & crInv .~ newinv) + where + (w',newinv) = imapAccumR (initCrItemLocation cr) w (_crInv cr) + +initCrItemLocation :: Creature -> Int -> CWorld -> Item -> (CWorld,Item) +initCrItemLocation cr invid w it = (w & itemLocations . at locid ?~ loc + ,it & itID .~ locid + & itLocation .~ loc) + where + locid = IM.newKey (_itemLocations w) + loc = InInv (_crID cr) invid + + +initFlItemLocation :: CWorld -> FloorItem -> (CWorld, FloorItem) +initFlItemLocation w flit = (w & itemLocations . at locid ?~ loc + , flit & flIt . itID .~ locid + & flIt . itLocation .~ loc + ) + where + locid = IM.newKey (_itemLocations w) + loc = OnFloor (_flItID flit) + +initTuItemLocation :: CWorld -> Machine -> (CWorld, Machine) +initTuItemLocation w mc = case mc ^? mcType . _McTurret . tuWeapon of + Nothing -> (w, mc) + Just _ -> + let locid = IM.newKey (_itemLocations w) + loc = OnTurret (_mcID mc) + in ( w & itemLocations . at locid ?~ loc + , mc & mcType . _McTurret . tuWeapon . itID .~ locid + & mcType . _McTurret . tuWeapon . itLocation .~ loc + ) diff --git a/src/Dodge/Layout.hs b/src/Dodge/Layout.hs index 9a38e2d66..4438533a8 100644 --- a/src/Dodge/Layout.hs +++ b/src/Dodge/Layout.hs @@ -4,6 +4,7 @@ module Dodge.Layout ( ) where import qualified Control.Foldl as L +import Dodge.Item.Location.Initialize import Control.Lens import Data.Foldable import Data.Function @@ -34,6 +35,7 @@ generateLevelFromRoomList gr' w = over gwWorld initWallZoning . over gwWorld randomCompass . over gwWorld setupWorldBounds + . over (gwWorld . cWorld) initItemLocations . doAfterPlacements . doInPlacements . doOutPlacements @@ -52,6 +54,7 @@ generateLevelFromRoomList gr' w = rs = map doRoomShift $ IM.elems rs' rs' = mapM shuffleRoomPos gr' & evalState $ _randGen w + randomCompass :: World -> World randomCompass w = w & cWorld . cameraRot .~ (takeOne [0, 0.5 * pi, pi, 1.5 * pi] & evalState $ _randGen w) diff --git a/src/Dodge/Projectile/Create.hs b/src/Dodge/Projectile/Create.hs index 3ac889e88..020a64a65 100644 --- a/src/Dodge/Projectile/Create.hs +++ b/src/Dodge/Projectile/Create.hs @@ -5,7 +5,6 @@ import Dodge.Item.Location import Geometry import qualified IntMapHelp as IM import LensHelp -import Data.Maybe createProjectile :: ProjectileCreate -> Item -> Creature -> World -> World createProjectile pt = case pt of @@ -47,7 +46,7 @@ makeShell it cr theupdate w = , _prjPayload = _amPayload $ _laAmmoType am , _prjTimer = 350 , _prjUpdates = theupdate - , _prjMITID = Just . fromJust $ _itID it + , _prjMITID = Just $ _itID it } where i = IM.newKey $ _props (_cWorld w)