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

Make all items have an id an associated location

Browse Source
This commit is contained in:
justin
2022-08-01 23:50:26 +01:00
parent 237cd3e020
commit 82aedc3830
11 changed files with 123 additions and 84 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature.hs
+42 -46
View File
@@ -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
]
src/Dodge/Data/Item.hs
+1 -1
View File
@@ -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
src/Dodge/Data/Item/Misc.hs
+2 -1
View File
@@ -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
src/Dodge/Debug/Terminal.hs
+3 -23
View File
@@ -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
src/Dodge/Default/Item.hs
+2 -2
View File
@@ -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
src/Dodge/FloorItem.hs
+1 -3
View File
@@ -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
src/Dodge/Inventory/Add.hs
+1 -3
View File
@@ -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
src/Dodge/Item/Location.hs
+4 -3
View File
@@ -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 =>
src/Dodge/Item/Location/Initialize.hs
+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
)
src/Dodge/Layout.hs
+3
View File
@@ -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)
src/Dodge/Projectile/Create.hs
+1 -2
View File
@@ -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)