Make all items have an id an associated location

This commit is contained in:
2022-08-01 23:50:26 +01:00
parent 237cd3e020
commit 82aedc3830
11 changed files with 123 additions and 84 deletions
+42 -46
View File
@@ -214,54 +214,50 @@ inventoryX c = case c of
, makeTypeCraftNum 1 CONCUSSMODULE , makeTypeCraftNum 1 CONCUSSMODULE
, makeTypeCraftNum 1 STATICMODULE , makeTypeCraftNum 1 STATICMODULE
] ]
'M' -> stackedInventory
'T' -> testInventory
_ -> [] _ -> []
testInventory :: IM.IntMap Item testInventory :: [Item]
testInventory = testInventory =
IM.fromList $ [ makeTypeCraftNum 9 PIPE
zip , autoAmr
[0 ..] , brainHat
[ makeTypeCraftNum 9 PIPE , headLamp
, autoAmr , autoDetector WALLDETECTOR
, brainHat , magShield
, headLamp , frontArmour
, autoDetector WALLDETECTOR , wristArmour
, magShield , flatShield
, frontArmour , sniperRifle
, wristArmour , makeTypeCraftNum 1 MOTOR
, flatShield , makeTypeCraft INCENDIARYMODULE
, sniperRifle , makeTypeCraft STATICMODULE
, makeTypeCraftNum 1 MOTOR , makeTypeCraft CONCUSSMODULE
, makeTypeCraft INCENDIARYMODULE , teleportModule
, makeTypeCraft STATICMODULE , makeTypeCraftNum 10 HARDWARE
, makeTypeCraft CONCUSSMODULE , makeTypeCraftNum 3 SPRING
, teleportModule , makeTypeCraftNum 10 CAN
, makeTypeCraftNum 10 HARDWARE , makeTypeCraftNum 3 PLANK
, makeTypeCraftNum 3 SPRING ]
, makeTypeCraftNum 10 CAN
, makeTypeCraftNum 3 PLANK
]
stackedInventory :: IM.IntMap Item stackedInventory :: [Item]
stackedInventory = stackedInventory =
IM.fromList $ [ burstRifle
zip , pipe
[0 ..] , rewindGun
[ burstRifle , tractorGun
, pipe , autoPistol
, rewindGun , pistol
, tractorGun , teslaGun
, autoPistol , blinkGun
, pistol , miniGunX 3
, teslaGun , boosterGun
, blinkGun , remoteLauncher
, miniGunX 3 , flatShield
, boosterGun , spawnGun (lamp 5)
, remoteLauncher , lasGun
, flatShield , flameThrower
, spawnGun (lamp 5) , poisonSprayer
, lasGun , launcher
, flameThrower ]
, poisonSprayer
, launcher
]
+1 -1
View File
@@ -31,7 +31,7 @@ import Dodge.Data.Item.Targeting
data Item = Item data Item = Item
{ _itUse :: ItemUse { _itUse :: ItemUse
, _itType :: ItemType , _itType :: ItemType
, _itID :: Maybe Int , _itID :: Int
, _itLocation :: ItemLocation , _itLocation :: ItemLocation
, _itIsHeld :: Bool , _itIsHeld :: Bool
, _itEffect :: ItEffect , _itEffect :: ItEffect
+2 -1
View File
@@ -35,8 +35,9 @@ data ItemValueType = MundaneItem | ArtefactItem
data ItemLocation data ItemLocation
= InInv {_ipCrID :: Int, _ipInvID :: Int} = InInv {_ipCrID :: Int, _ipInvID :: Int}
| OnTurret {_ipTuID :: Int}
| OnFloor {_ipFlID :: Int} | OnFloor {_ipFlID :: Int}
| VoidItm | InVoid
deriving (Eq, Show, Read) deriving (Eq, Show, Read)
makeLenses ''ItemDimension makeLenses ''ItemDimension
+3 -23
View File
@@ -2,6 +2,7 @@
module Dodge.Debug.Terminal where module Dodge.Debug.Terminal where
import Dodge.Item.Location.Initialize
import Control.Applicative import Control.Applicative
import Control.Lens import Control.Lens
import Control.Monad import Control.Monad
@@ -27,35 +28,14 @@ applyTerminalString ss = case ss of
applyTerminalCommand :: String -> Universe -> Universe applyTerminalCommand :: String -> Universe -> Universe
applyTerminalCommand s = case s of applyTerminalCommand s = case s of
"NOCLIP" -> uvConfig . debug_booleans . at Noclip %~ toggleJust "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] -> ['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) . (uvWorld . cWorld . creatures . ix 0 . crInvCapacity .~ 50)
"GODON" -> uvWorld . cWorld . creatures . ix 0 . crMaterial .~ Crystal "GODON" -> uvWorld . cWorld . creatures . ix 0 . crMaterial .~ Crystal
"GODOFF" -> uvWorld . cWorld . creatures . ix 0 . crMaterial .~ Flesh "GODOFF" -> uvWorld . cWorld . creatures . ix 0 . crMaterial .~ Flesh
"LOADTEST" ->
(uvWorld . cWorld . creatures . ix 0 . crInv .~ testInventory)
. (uvWorld . cWorld . creatures . ix 0 . crInvCapacity .~ 50)
_ -> id _ -> 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 :: String -> [String] -> Universe -> Universe
applyTerminalCommandArguments command args u = case command of applyTerminalCommandArguments command args u = case command of
"ITEM" -> fromMaybe u $ do "ITEM" -> fromMaybe u $ do
+2 -2
View File
@@ -18,11 +18,11 @@ defaultItem =
{ _itCurseStatus = Uncursed { _itCurseStatus = Uncursed
, _itType = defaultItemType , _itType = defaultItemType
, _itEffect = defaultItEffect , _itEffect = defaultItEffect
, _itID = Nothing , _itID = 0
, _itIsHeld = False , _itIsHeld = False
, _itInvColor = yellow , _itInvColor = yellow
, _itInvSize = 1 , _itInvSize = 1
, _itLocation = VoidItm , _itLocation = InVoid
, _itDimension = ItemDimension 2 0 (V3 10 (-5) 3) , _itDimension = ItemDimension 2 0 (V3 10 (-5) 3)
, _itUse = CraftUse (ItAmount 1) , _itUse = CraftUse (ItAmount 1)
, _itParams = NoParams , _itParams = NoParams
+1 -3
View File
@@ -25,9 +25,7 @@ copyItemToFloorID pos it w =
where where
(p', w') = findWallFreeDropPoint (_dimRad $ _itDimension it) pos w (p', w') = findWallFreeDropPoint (_dimRad $ _itDimension it) pos w
rot = fst . randomR (- pi, pi) $ _randGen w rot = fst . randomR (- pi, pi) $ _randGen w
updateLocation = case it ^? itID of updateLocation = cWorld . itemLocations . ix (_itID it) .~ OnFloor flid
Just (Just i') -> cWorld . itemLocations . ix i' .~ OnFloor flid
_ -> id
flid = IM.newKey $ _floorItems (_cWorld w) flid = IM.newKey $ _floorItems (_cWorld w)
theflit = theflit =
FlIt FlIt
+1 -3
View File
@@ -32,9 +32,7 @@ tryPutItemInInv cid flit w = case maybeInvSlot of
where where
it = _flIt flit it = _flIt flit
maybeInvSlot = checkInvSlotsYou it w maybeInvSlot = checkInvSlotsYou it w
updateItLocation invid w' = case _itID it of updateItLocation invid w' = w' & cWorld . itemLocations . ix (_itID it) .~ InInv cid invid
Nothing -> w'
Just j -> w' & cWorld . itemLocations . ix j .~ InInv cid invid
--{- | Pick up a specific item. -} --{- | Pick up a specific item. -}
--putItemInInv :: Int -> FloorItem -> World -> World --putItemInInv :: Int -> FloorItem -> World -> World
+4 -3
View File
@@ -11,7 +11,7 @@ setHeldItemLoc cr = fst . getHeldItemLoc cr
getHeldItemLoc :: Creature -> World -> (World, Int) getHeldItemLoc :: Creature -> World -> (World, Int)
getHeldItemLoc cr w = case maybeitid of getHeldItemLoc cr w = case maybeitid of
Nothing -> 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) & cWorld . itemLocations %~ IM.insert newitid (InInv cid j)
, itid , itid
) )
@@ -20,7 +20,7 @@ getHeldItemLoc cr w = case maybeitid of
cid = _crID cr cid = _crID cr
j = crSel cr j = crSel cr
newitid = IM.newKey $ _itemLocations (_cWorld w) newitid = IM.newKey $ _itemLocations (_cWorld w)
maybeitid = cr ^? crInv . ix j . itID . _Just maybeitid = cr ^? crInv . ix j . itID
itid = fromMaybe newitid maybeitid itid = fromMaybe newitid maybeitid
getItem :: Int -> World -> Maybe Item getItem :: Int -> World -> Maybe Item
@@ -29,7 +29,8 @@ getItem itid w = do
case itpos of case itpos of
OnFloor flitid -> w ^? cWorld . floorItems . ix flitid . flIt OnFloor flitid -> w ^? cWorld . floorItems . ix flitid . flIt
InInv cid invid -> w ^? cWorld . creatures . ix cid . crInv . ix invid 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 :: pointerToItemLocation ::
Applicative f => Applicative f =>
+63
View File
@@ -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
)
+3
View File
@@ -4,6 +4,7 @@ module Dodge.Layout (
) where ) where
import qualified Control.Foldl as L import qualified Control.Foldl as L
import Dodge.Item.Location.Initialize
import Control.Lens import Control.Lens
import Data.Foldable import Data.Foldable
import Data.Function import Data.Function
@@ -34,6 +35,7 @@ generateLevelFromRoomList gr' w =
over gwWorld initWallZoning over gwWorld initWallZoning
. over gwWorld randomCompass . over gwWorld randomCompass
. over gwWorld setupWorldBounds . over gwWorld setupWorldBounds
. over (gwWorld . cWorld) initItemLocations
. doAfterPlacements . doAfterPlacements
. doInPlacements . doInPlacements
. doOutPlacements . doOutPlacements
@@ -52,6 +54,7 @@ generateLevelFromRoomList gr' w =
rs = map doRoomShift $ IM.elems rs' rs = map doRoomShift $ IM.elems rs'
rs' = mapM shuffleRoomPos gr' & evalState $ _randGen w rs' = mapM shuffleRoomPos gr' & evalState $ _randGen w
randomCompass :: World -> World randomCompass :: World -> World
randomCompass w = w & cWorld . cameraRot .~ (takeOne [0, 0.5 * pi, pi, 1.5 * pi] & evalState $ _randGen w) randomCompass w = w & cWorld . cameraRot .~ (takeOne [0, 0.5 * pi, pi, 1.5 * pi] & evalState $ _randGen w)
+1 -2
View File
@@ -5,7 +5,6 @@ import Dodge.Item.Location
import Geometry import Geometry
import qualified IntMapHelp as IM import qualified IntMapHelp as IM
import LensHelp import LensHelp
import Data.Maybe
createProjectile :: ProjectileCreate -> Item -> Creature -> World -> World createProjectile :: ProjectileCreate -> Item -> Creature -> World -> World
createProjectile pt = case pt of createProjectile pt = case pt of
@@ -47,7 +46,7 @@ makeShell it cr theupdate w =
, _prjPayload = _amPayload $ _laAmmoType am , _prjPayload = _amPayload $ _laAmmoType am
, _prjTimer = 350 , _prjTimer = 350
, _prjUpdates = theupdate , _prjUpdates = theupdate
, _prjMITID = Just . fromJust $ _itID it , _prjMITID = Just $ _itID it
} }
where where
i = IM.newKey $ _props (_cWorld w) i = IM.newKey $ _props (_cWorld w)