Refactor floor items, removing ids (not fully checked)

This commit is contained in:
2025-08-23 22:10:33 +01:00
parent 32d7120177
commit fcccd63844
24 changed files with 94 additions and 109 deletions
+1 -1
View File
File diff suppressed because one or more lines are too long
+1 -5
View File
@@ -10,11 +10,7 @@ plNewID l x w = (i,w & l #%~ IM.insert i x)
i = IM.newKey $ w ^# l i = IM.newKey $ w ^# l
-- | place an new object into an intmap and update its id -- | place an new object into an intmap and update its id
plNewUpID :: ALens' b (IM.IntMap a) plNewUpID :: ALens' b (IM.IntMap a) -> ALens' a Int -> a -> b -> (Int,b)
-> ALens' a Int
-> a
-> b
-> (Int,b)
plNewUpID l li x w = (i,w & l #%~ IM.insert i (x & li #~ i)) plNewUpID l li x w = (i,w & l #%~ IM.insert i (x & li #~ i))
where where
i = IM.newKey $ w ^# l i = IM.newKey $ w ^# l
+1 -2
View File
@@ -5,7 +5,6 @@
module Dodge.Data.FloorItem where module Dodge.Data.FloorItem where
import NewInt
import Control.Lens import Control.Lens
import Data.Aeson import Data.Aeson
import Data.Aeson.TH import Data.Aeson.TH
@@ -13,7 +12,7 @@ import Dodge.Data.Item
import Geometry.Data import Geometry.Data
data FloorItem = FlIt {_flIt :: Item, _flItPos :: Point2, _flItRot :: Float, _flItID :: NewInt FloorInt} data FloorItem = FlIt {_flIt :: Item, _flItPos :: Point2, _flItRot :: Float}--, _flItID :: NewInt FloorInt}
--deriving (Eq, Show, Read) --Generic, Flat) --deriving (Eq, Show, Read) --Generic, Flat)
makeLenses ''FloorItem makeLenses ''FloorItem
+1 -1
View File
@@ -44,7 +44,7 @@ data HUD = HUD
, _carteCenter :: Point2 , _carteCenter :: Point2
, _carteZoom :: Float , _carteZoom :: Float
, _carteRot :: Float , _carteRot :: Float
, _closeItems :: [NewInt FloorInt] , _closeItems :: [NewInt ItmInt]
, _closeButtons :: [Int] , _closeButtons :: [Int]
} }
+1 -2
View File
@@ -9,7 +9,6 @@ import Dodge.Data.Equipment.Misc
import Control.Lens import Control.Lens
import Data.Aeson import Data.Aeson
import Data.Aeson.TH import Data.Aeson.TH
import NewInt
-- it would be nice to have these as empty types, but I'm not sure how to get -- it would be nice to have these as empty types, but I'm not sure how to get
-- aeson to handle that -- aeson to handle that
@@ -35,7 +34,7 @@ data ItemLocation
, _ilEquipSite :: Maybe EquipSite , _ilEquipSite :: Maybe EquipSite
} }
| OnTurret {_ilTuID :: Int} | OnTurret {_ilTuID :: Int}
| OnFloor {_ilFlID :: NewInt FloorInt} | OnFloor-- {_ilFlID :: NewInt FloorInt}
| InVoid | InVoid
deriving (Eq, Show, Ord, Read) --Generic, Flat) deriving (Eq, Show, Ord, Read) --Generic, Flat)
+1 -1
View File
@@ -131,7 +131,7 @@ data LWorld = LWorld
, _blocks :: IM.IntMap Block , _blocks :: IM.IntMap Block
, _coordinates :: IM.IntMap Point2 , _coordinates :: IM.IntMap Point2
, _triggers :: IM.IntMap Bool , _triggers :: IM.IntMap Bool
, _floorItems :: NewIntMap FloorInt FloorItem , _floorItems :: IM.IntMap FloorItem
, _modifications :: IM.IntMap Modification , _modifications :: IM.IntMap Modification
, _worldEvents :: [WdWd] , _worldEvents :: [WdWd]
, _delayedEvents :: [(Int, WdWd)] , _delayedEvents :: [(Int, WdWd)]
+1 -1
View File
@@ -25,7 +25,7 @@ defaultEquipment :: Item
defaultEquipment = defaultHeldItem & itUse .~ UseNothing defaultEquipment = defaultHeldItem & itUse .~ UseNothing
defaultFlIt :: FloorItem defaultFlIt :: FloorItem
defaultFlIt = FlIt{_flItRot = 0, _flIt = defaultHeldItem, _flItPos = V2 0 0, _flItID = 0} defaultFlIt = FlIt{_flItRot = 0, _flIt = defaultHeldItem, _flItPos = V2 0 0}
defaultMachine :: Machine defaultMachine :: Machine
defaultMachine = defaultMachine =
+2 -7
View File
@@ -1,6 +1,4 @@
module Dodge.Default.World ( module Dodge.Default.World (defaultWorld) where
defaultWorld,
) where
import Data.Graph.Inductive.Graph hiding ((&)) import Data.Graph.Inductive.Graph hiding ((&))
import qualified Data.Map as M import qualified Data.Map as M
@@ -8,7 +6,6 @@ import Dodge.Data.World
import Geometry.Data import Geometry.Data
import Geometry.Polygon import Geometry.Polygon
import qualified IntMapHelp as IM import qualified IntMapHelp as IM
import NewInt
import System.Random import System.Random
defaultInput :: Input defaultInput :: Input
@@ -87,7 +84,6 @@ defaultCWorld =
{ _lWorld = defaultLWorld { _lWorld = defaultLWorld
, _cwGen = defaultCWGen , _cwGen = defaultCWGen
, _cClock = 0 , _cClock = 0
-- , _seenWalls = mempty
, _pathGraph = Data.Graph.Inductive.Graph.empty , _pathGraph = Data.Graph.Inductive.Graph.empty
, _cwTiles = mempty , _cwTiles = mempty
, _numberFloorVerxs = 0 , _numberFloorVerxs = 0
@@ -133,7 +129,7 @@ defaultLWorld =
, _doors = IM.empty , _doors = IM.empty
, _coordinates = IM.empty , _coordinates = IM.empty
, _triggers = IM.empty , _triggers = IM.empty
, _floorItems = NIntMap IM.empty , _floorItems = mempty
, _worldEvents = [] , _worldEvents = []
, _delayedEvents = [] , _delayedEvents = []
, _pressPlates = IM.empty , _pressPlates = IM.empty
@@ -176,7 +172,6 @@ defaultDisplayInventory =
{ _subInventory = NoSubInventory { _subInventory = NoSubInventory
, _diSections = mempty , _diSections = mempty
, _diSelection = Just (1, 0, mempty) , _diSelection = Just (1, 0, mempty)
-- , _diSelectionExtra = mempty
, _diInvFilter = mempty , _diInvFilter = mempty
, _diCloseFilter = mempty , _diCloseFilter = mempty
} }
+2 -1
View File
@@ -9,6 +9,7 @@ module Dodge.DisplayInventory (
toggleCombineInv, toggleCombineInv,
) where ) where
import NewInt
import Control.Applicative import Control.Applicative
import Control.Lens import Control.Lens
import Control.Monad import Control.Monad
@@ -158,7 +159,7 @@ updateDisplaySections w cfig =
cr = you w cr = you w
closeitms = closeitms =
IM.fromDistinctAscList . zip [0 ..] $ IM.fromDistinctAscList . zip [0 ..] $
mapMaybe (closeItemToSelectionItem w) (w ^. hud . closeItems) mapMaybe (closeItemToSelectionItem w) (map _unNInt $ w ^. hud . closeItems)
invitems = invitems =
IM.map IM.map
(uncurry (invSelectionItem w)) (uncurry (invSelectionItem w))
+6 -9
View File
@@ -16,28 +16,25 @@ import System.Random
-- | Copy an item to the floor. -- | Copy an item to the floor.
copyItemToFloor :: Point2 -> Item -> World -> World copyItemToFloor :: Point2 -> Item -> World -> World
copyItemToFloor pos it = snd . copyItemToFloorID pos it copyItemToFloor pos it = copyItemToFloorID pos it
-- | Copy an item to the floor, returns the floor item's id. -- | Copy an item to the floor, returns the floor item's id.
copyItemToFloorID :: Point2 -> Item -> World -> (NewInt FloorInt, World) copyItemToFloorID :: Point2 -> Item -> World -> World
copyItemToFloorID pos it w = copyItemToFloorID pos it w =
(,) (NInt flid) $
w' w'
& cWorld . lWorld . floorItems . unNIntMap %~ IM.insert flid theflit & cWorld . lWorld . floorItems %~ IM.insert (_unNInt $ _itID it) theflit
& cWorld . lWorld . itemLocations %~ IM.insert (_unNInt $ _itID it) (OnFloor $ NInt flid) & cWorld . lWorld . itemLocations %~ IM.insert (_unNInt $ _itID it) OnFloor
& hud . closeItems %~ (NInt flid:) & hud . closeItems %~ (_itID it:)
-- & hud . hudElement . diSections . ix 3 . ssOffset .~ 0 -- & hud . hudElement . diSections . ix 3 . ssOffset .~ 0
-- ensures dropped item is at the top of the close item selection list -- ensures dropped item is at the top of the close item selection list
where where
(p', w') = findWallFreeDropPoint (_dimRad $ itDim it) pos w (p', w') = findWallFreeDropPoint (_dimRad $ itDim it) pos w
rot = fst . randomR (- pi, pi) $ _randGen w rot = fst . randomR (- pi, pi) $ _randGen w
flid = IM.newKey . _unNIntMap . _floorItems . _lWorld $ _cWorld w
theflit = theflit =
FlIt FlIt
{ _flIt = it & itLocation .~ OnFloor (NInt flid) { _flIt = it & itLocation .~ OnFloor
, _flItPos = p' , _flItPos = p'
, _flItRot = rot , _flItRot = rot
, _flItID = NInt flid
} }
cardinalVectors :: [Point2] cardinalVectors :: [Point2]
+3 -3
View File
@@ -66,9 +66,9 @@ destroyItem itid w = case w ^? cWorld . lWorld . itemLocations . ix itid of
Nothing -> error $ "Tried to destroy item that does not exist; item id: " ++ show itid Nothing -> error $ "Tried to destroy item that does not exist; item id: " ++ show itid
Just InInv{_ilCrID = cid, _ilInvID = invid} -> destroyInvItem cid invid w Just InInv{_ilCrID = cid, _ilInvID = invid} -> destroyInvItem cid invid w
Just OnTurret{} -> error "need to write code for destroying items on turrets" Just OnTurret{} -> error "need to write code for destroying items on turrets"
Just (OnFloor (NInt i)) -> Just OnFloor ->
w & cWorld . lWorld . itemLocations . at itid .~ Nothing w & cWorld . lWorld . itemLocations . at itid .~ Nothing
& cWorld . lWorld . floorItems . unNIntMap . at i .~ Nothing & cWorld . lWorld . floorItems . at itid .~ Nothing
Just InVoid -> w & cWorld . lWorld . itemLocations . at itid .~ Nothing Just InVoid -> w & cWorld . lWorld . itemLocations . at itid .~ Nothing
-- note rmInvItem does not fully destroy the item, other updates to the item -- note rmInvItem does not fully destroy the item, other updates to the item
@@ -125,7 +125,7 @@ updateCloseObjects w =
g oldbts = intersect oldbts cbts `union` cbts g oldbts = intersect oldbts cbts `union` cbts
f olditems = intersect olditems citems `union` citems f olditems = intersect olditems citems `union` citems
lw = w ^. cWorld . lWorld lw = w ^. cWorld . lWorld
citems = lw^..floorItems . unNIntMap . each . filtered (isclose . _flItPos) . to _flItID citems = lw^..floorItems . each . filtered (isclose . _flItPos) . to (_itID . _flIt)
isclose x = dist y x < 40 && hasButtonLOS y x w isclose x = dist y x < 40 && hasButtonLOS y x w
y = _crPos $ you w y = _crPos $ you w
cbts = lw^..buttons . each . filtered canpress . filtered (isclose . _btPos) . to _btID cbts = lw^..buttons . each . filtered canpress . filtered (isclose . _btPos) . to _btID
+7 -7
View File
@@ -23,9 +23,9 @@ import Dodge.FloorItem
import Dodge.Inventory.CheckSlots import Dodge.Inventory.CheckSlots
import qualified IntMapHelp as IM import qualified IntMapHelp as IM
tryPutFloorItemIDInInv :: Int -> NewInt FloorInt -> World -> Maybe (Int, World) tryPutFloorItemIDInInv :: Int -> Int -> World -> Maybe (Int, World)
tryPutFloorItemIDInInv cid flitid w = do tryPutFloorItemIDInInv cid i w = do
flit <- w ^? cWorld . lWorld . floorItems . unNIntMap . ix (_unNInt flitid) flit <- w ^? cWorld . lWorld . floorItems . ix i
tryPutItemInInv cid flit w tryPutItemInInv cid flit w
-- not sure why we have the cid here, this will probably only work for cid == 0 -- not sure why we have the cid here, this will probably only work for cid == 0
@@ -46,7 +46,7 @@ tryPutItemInInv cid flit w = case maybeInvSlot of
Just Just
( i ( i
, w , w
& cWorld . lWorld . floorItems . unNIntMap %~ IM.delete (_unNInt $ _flItID flit) & cWorld . lWorld . floorItems %~ IM.delete (flit ^. flIt . itID . unNInt)
& cWorld . lWorld . creatures . ix cid . crInv %~ IM.insert i it & cWorld . lWorld . creatures . ix cid . crInv %~ IM.insert i it
& updateItLocation i & updateItLocation i
-- I forget whether using "at" rather than "IM.insert" here caused problems -- I forget whether using "at" rather than "IM.insert" here caused problems
@@ -93,14 +93,14 @@ tryPutItemInInv cid flit w = case maybeInvSlot of
-- return (Just i, w') -- return (Just i, w')
createItemYou :: Item -> World -> (ItemLocation, World) createItemYou :: Item -> World -> (ItemLocation, World)
createItemYou itm w = fromMaybe (OnFloor flid, w') $ do createItemYou itm w = fromMaybe (OnFloor, w') $ do
(invid, w'') <- tryPutFloorItemIDInInv 0 flid w' (invid, w'') <- tryPutFloorItemIDInInv 0 itid w'
itloc <- w'' ^? cWorld . lWorld . creatures . ix 0 . crInv . ix invid . itLocation itloc <- w'' ^? cWorld . lWorld . creatures . ix 0 . crInv . ix invid . itLocation
return (itloc, w'') return (itloc, w'')
where where
itid = IM.newKey $ w ^. cWorld . lWorld . itemLocations itid = IM.newKey $ w ^. cWorld . lWorld . itemLocations
pos = w ^?! cWorld . lWorld . creatures . ix 0 . crPos pos = w ^?! cWorld . lWorld . creatures . ix 0 . crPos
(flid,w') = copyItemToFloorID pos (itm & itID .~ NInt itid) w w' = copyItemToFloorID pos (itm & itID .~ NInt itid) w
-- | Pick up a specific item. -- | Pick up a specific item.
+3 -3
View File
@@ -202,9 +202,9 @@ hotkeyToChar = \case
Hotkey9 -> '9' Hotkey9 -> '9'
Hotkey0 -> '0' Hotkey0 -> '0'
closeItemToSelectionItem :: World -> NewInt FloorInt -> Maybe (SelectionItem ()) closeItemToSelectionItem :: World -> Int -> Maybe (SelectionItem ())
closeItemToSelectionItem w (NInt i) = do closeItemToSelectionItem w i = do
e <- w ^? cWorld . lWorld . floorItems . unNIntMap . ix i e <- w ^? cWorld . lWorld . floorItems . ix i
let (pics, col) = closeItemToTextPictures e let (pics, col) = closeItemToTextPictures e
return return
SelItem SelItem
+26 -27
View File
@@ -1,6 +1,6 @@
module Dodge.Item.Location ( module Dodge.Item.Location (
pointerToItemID, pointerToItemID,
pointerToItemLocation, --pointerToItemLocation,
pointerToItem, pointerToItem,
pointerYourSelectedItem, pointerYourSelectedItem,
pointerYourRootItem, pointerYourRootItem,
@@ -11,42 +11,41 @@ import Control.Lens
import Data.Maybe import Data.Maybe
import Dodge.Data.World import Dodge.Data.World
pointerToItemLocation :: --pointerToItemLocation ::
Applicative f => -- Applicative f =>
ItemLocation -> -- ItemLocation ->
(Item -> f Item) -> -- (Item -> f Item) ->
World -> -- World ->
f World -- f World
pointerToItemLocation InInv {_ilCrID = cid, _ilInvID = invid} --pointerToItemLocation InInv {_ilCrID = cid, _ilInvID = invid}
= cWorld . lWorld . creatures . ix cid . crInv . ix invid -- = cWorld . lWorld . creatures . ix cid . crInv . ix invid
pointerToItemLocation (OnFloor flid) = cWorld . lWorld . floorItems . unNIntMap . ix (_unNInt flid) . flIt --pointerToItemLocation (OnFloor) = \f w ->
pointerToItemLocation _ = const pure ---- cWorld . lWorld . floorItems . ix (_unNInt flid) . flIt
--pointerToItemLocation _ = const pure
pointerYourSelectedItem :: Applicative a => (Item -> a Item) -> World -> a World pointerYourSelectedItem :: Applicative a => (Item -> a Item) -> World -> a World
pointerYourSelectedItem f w = fromMaybe (pure w) $ do pointerYourSelectedItem f w = fromMaybe (pure w) $ do
itinvid <- w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . imSelectedItem itinvid <- w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . imSelectedItem
Just $ pointerToItemLocation (InInv 0 itinvid True True True Nothing) f w Just $ (cWorld . lWorld . creatures . ix 0 . crInv . ix itinvid) f w
-- note the ilIsRoot/Selected/Attached booleans are irrelevant -- note the ilIsRoot/Selected/Attached booleans are irrelevant
pointerYourRootItem :: Applicative a => (Item -> a Item) -> World -> a World pointerYourRootItem :: Applicative a => (Item -> a Item) -> World -> a World
pointerYourRootItem f w = fromMaybe (pure w) $ do pointerYourRootItem f w = fromMaybe (pure w) $ do
itinvid <- w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . imRootSelectedItem itinvid <- w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . imRootSelectedItem
Just $ pointerToItemLocation (InInv 0 itinvid True True True Nothing) f w Just $ (cWorld . lWorld . creatures . ix 0 . crInv . ix itinvid) f w
pointerToItem :: pointerToItem :: Applicative f => Item -> (Item -> f Item) -> World -> f World
Applicative f => pointerToItem x = case x ^. itLocation of
Item -> OnFloor -> cWorld . lWorld . floorItems . ix (x ^. itID . unNInt) . flIt
(Item -> f Item) -> OnTurret tid -> cWorld . lWorld . machines . ix tid . mcType . mctTurret . tuWeapon
World -> InInv cid invid _ _ _ _ -> cWorld . lWorld . creatures . ix cid . crInv . ix invid
f World InVoid -> const pure
pointerToItem = pointerToItemLocation . _itLocation
pointerToItemID :: pointerToItemID :: Applicative f => NewInt ItmInt -> (Item -> f Item) -> World -> f World
Applicative f =>
NewInt ItmInt ->
(Item -> f Item) ->
World ->
f World
pointerToItemID itid f w = fromMaybe (pure w) $ do pointerToItemID itid f w = fromMaybe (pure w) $ do
itloc <- w ^? cWorld . lWorld . itemLocations . ix (_unNInt itid) itloc <- w ^? cWorld . lWorld . itemLocations . ix (_unNInt itid)
return $ pointerToItemLocation itloc f w return $ (\x -> x f w) $ case itloc of
OnFloor -> cWorld . lWorld . floorItems . ix (_unNInt itid) . flIt
OnTurret tid -> cWorld . lWorld . machines . ix tid . mcType . mctTurret . tuWeapon
InInv cid invid _ _ _ _ -> cWorld . lWorld . creatures . ix cid . crInv . ix invid
InVoid -> const pure
+14 -13
View File
@@ -10,17 +10,18 @@ import qualified IntMapHelp as IM
import Data.Traversable import Data.Traversable
initItemLocations :: LWorld -> LWorld initItemLocations :: LWorld -> LWorld
initItemLocations = initCrsItemLocations . initFlItemsLocations . initTusItemLocations --initItemLocations = initCrsItemLocations . initFlItemsLocations . initTusItemLocations
initItemLocations = initCrsItemLocations . initTusItemLocations
initCrsItemLocations :: LWorld -> LWorld initCrsItemLocations :: LWorld -> LWorld
initCrsItemLocations w = w' & creatures .~ newcreatures initCrsItemLocations w = w' & creatures .~ newcreatures
where where
(w', newcreatures) = mapAccumR initCrItemLocations w (w ^. creatures) (w', newcreatures) = mapAccumR initCrItemLocations w (w ^. creatures)
initFlItemsLocations :: LWorld -> LWorld --initFlItemsLocations :: LWorld -> LWorld
initFlItemsLocations w = w' & floorItems .~ NIntMap newfloorItems --initFlItemsLocations w = w' & floorItems .~ newfloorItems
where -- where
(w', newfloorItems) = mapAccumR initFlItemLocation w (w ^. floorItems . unNIntMap) -- (w', newfloorItems) = mapAccumR initFlItemLocation w (w ^. floorItems)
initTusItemLocations :: LWorld -> LWorld initTusItemLocations :: LWorld -> LWorld
initTusItemLocations w = w' & machines .~ newmachines initTusItemLocations w = w' & machines .~ newmachines
@@ -54,14 +55,14 @@ initCrItemLocation cr invid w it = (w & itemLocations . at locid ?~ loc
} }
initFlItemLocation :: LWorld -> FloorItem -> (LWorld, FloorItem) --initFlItemLocation :: LWorld -> FloorItem -> (LWorld, FloorItem)
initFlItemLocation w flit = (w & itemLocations . at locid ?~ loc --initFlItemLocation w flit = (w & itemLocations . at locid ?~ loc
, flit & flIt . itID .~ NInt locid -- , flit & flIt . itID .~ NInt locid
& flIt . itLocation .~ loc -- & flIt . itLocation .~ loc
) -- )
where -- where
locid = IM.newKey (w ^. itemLocations ) -- locid = IM.newKey (w ^. itemLocations )
loc = OnFloor (_flItID flit) -- loc = OnFloor (_flItID flit)
initTuItemLocation :: LWorld -> Machine -> (LWorld, Machine) initTuItemLocation :: LWorld -> Machine -> (LWorld, Machine)
initTuItemLocation w mc = case mc ^? mcType . _McTurret . tuWeapon of initTuItemLocation w mc = case mc ^? mcType . _McTurret . tuWeapon of
+11 -11
View File
@@ -2,9 +2,7 @@
{- | deals with placement of objects within the world {- | deals with placement of objects within the world
after they have had their coordinates set by the layout after they have had their coordinates set by the layout
-} -}
module Dodge.Placement.PlaceSpot ( module Dodge.Placement.PlaceSpot (placeSpot) where
placeSpot,
) where
import Color import Color
import LensHelp import LensHelp
@@ -22,7 +20,6 @@ import Dodge.Placement.Shift
import Dodge.ShiftPoint import Dodge.ShiftPoint
import Geometry import Geometry
import qualified IntMapHelp as IM import qualified IntMapHelp as IM
import NewInt
import System.Random import System.Random
-- when placing a placement, we update the world and the room and assign an id -- when placing a placement, we update the world and the room and assign an id
@@ -111,12 +108,15 @@ placeSpotID' ps pt w = case pt of
PutProp prp -> plNewUpID (cWorld . lWorld . props) prID (mvProp p rot prp) w PutProp prp -> plNewUpID (cWorld . lWorld . props) prID (mvProp p rot prp) w
PutButton bt -> plNewUpID (cWorld . lWorld . buttons) btID (mvButton p rot bt) w PutButton bt -> plNewUpID (cWorld . lWorld . buttons) btID (mvButton p rot bt) w
PutTerminal tm -> plNewUpID (cWorld . lWorld . terminals) tmID tm w PutTerminal tm -> plNewUpID (cWorld . lWorld . terminals) tmID tm w
PutFlIt itm -> PutFlIt itm -> let i = IM.newKey (w ^. cWorld . lWorld . itemLocations)
plNewUpID in (i, w & cWorld . lWorld . itemLocations . at i ?~ OnFloor
(cWorld . lWorld . floorItems . unNIntMap) & cWorld . lWorld . floorItems . at i ?~ createFlIt p rot itm
(flItID . unNInt) )
(createFlIt p rot itm) -- plNewUpID
w -- (cWorld . lWorld . floorItems . unNIntMap)
-- (flItID . unNInt)
-- (createFlIt p rot itm)
-- w
PutCrit cr -> plNewUpID (cWorld . lWorld . creatures) crID (mvCr p rot cr) w PutCrit cr -> plNewUpID (cWorld . lWorld . creatures) crID (mvCr p rot cr) w
PutForeground fs -> plNewUpID (cWorld . lWorld . foregroundShapes) fsID (mvFS p rot fs) w PutForeground fs -> plNewUpID (cWorld . lWorld . foregroundShapes) fsID (mvFS p rot fs) w
PutMachine pps mc wl -> plMachine (map doShift pps) mc wl p rot w PutMachine pps mc wl -> plMachine (map doShift pps) mc wl p rot w
@@ -180,7 +180,7 @@ mvButton p a = (btRot +~ a) . (btPos %~ ((p +.+) . rotateV a))
{- Creates a floor item at a given point.-} {- Creates a floor item at a given point.-}
createFlIt :: Point2 -> Float -> Item -> FloorItem createFlIt :: Point2 -> Float -> Item -> FloorItem
createFlIt p rot itm = FlIt{_flItPos = p, _flItRot = rot, _flItID = 0, _flIt = itm} createFlIt p rot itm = FlIt{_flItPos = p, _flItRot = rot, _flIt = itm}
mvPP :: Point2 -> Float -> PressPlate -> PressPlate mvPP :: Point2 -> Float -> PressPlate -> PressPlate
mvPP p rot pp = pp{_ppPos = p, _ppRot = rot} mvPP p rot pp = pp{_ppPos = p, _ppRot = rot}
+3 -3
View File
@@ -163,9 +163,9 @@ destroyProjectile mitid pjid w =
& removelink & removelink
where where
removelink = fromMaybe id $ do removelink = fromMaybe id $ do
itid <- fmap _unNInt mitid itid <- mitid
loc <- w ^? cWorld . lWorld . itemLocations . ix itid -- loc <- w ^? cWorld . lWorld . itemLocations . ix itid
return $ pointerToItemLocation loc . itUse . uaParams . apProjectiles %~ delete pjid return $ pointerToItemID itid . itUse . uaParams . apProjectiles %~ delete pjid
trySpin :: Projectile -> World -> World trySpin :: Projectile -> World -> World
trySpin pj = fromMaybe id $ do trySpin pj = fromMaybe id $ do
+1 -1
View File
@@ -91,7 +91,7 @@ crBlips p r = (,mempty) . IM.elems . IM.filter f . fmap _crPos . IM.filter g . _
g cr = _crID cr /= 0 g cr = _crID cr /= 0
itemBlips :: Point2 -> Float -> World -> ([Point2], S.Set (Point2, Point2)) itemBlips :: Point2 -> Float -> World -> ([Point2], S.Set (Point2, Point2))
itemBlips p r = (,mempty) . IM.elems . IM.filter f . fmap _flItPos . _unNIntMap . _floorItems . _lWorld . _cWorld itemBlips p r = (,mempty) . IM.elems . IM.filter f . fmap _flItPos . _floorItems . _lWorld . _cWorld
where where
f q = dist p q <= r && dist p q > r - 4 f q = dist p q <= r && dist p q > r - 4
+1 -1
View File
@@ -234,7 +234,7 @@ yourAugmentedItem f x g w = case you w ^? crManipulation . manObject of
Just (SelectedItem i _ _) -> f $ yourInv w ^?! ix i Just (SelectedItem i _ _) -> f $ yourInv w ^?! ix i
Just (SelCloseItem i) -> fromMaybe x $ do Just (SelCloseItem i) -> fromMaybe x $ do
j <- w ^? hud . closeItems . ix i . unNInt j <- w ^? hud . closeItems . ix i . unNInt
flit <- w ^? cWorld . lWorld . floorItems . unNIntMap . ix j flit <- w ^? cWorld . lWorld . floorItems . ix j
return . g $ Left flit return . g $ Left flit
Just (SelCloseButton i) -> fromMaybe x $ do Just (SelCloseButton i) -> fromMaybe x $ do
j <- w ^? hud . closeButtons . ix i j <- w ^? hud . closeButtons . ix i
+1 -2
View File
@@ -13,7 +13,6 @@ import Dodge.RadarBlip
import Dodge.Render.Picture import Dodge.Render.Picture
import Geometry import Geometry
import qualified IntMapHelp as IM import qualified IntMapHelp as IM
import NewInt
import Picture import Picture
import Shape import Shape
import ShapePicture import ShapePicture
@@ -30,7 +29,7 @@ worldSPic cfig u =
<> foldup (shiftDraw _fsPos _fsDir (const _fsSPic)) (filtOn _fsPos _foregroundShapes) <> foldup (shiftDraw _fsPos _fsDir (const _fsSPic)) (filtOn _fsPos _foregroundShapes)
<> foldup (shiftDraw' _cpPos _cpDir _cpSPic) (filtOn _cpPos _corpses) <> foldup (shiftDraw' _cpPos _cpDir _cpSPic) (filtOn _cpPos _corpses)
<> foldup drawCreature (filtOn _crPos _creatures) <> foldup drawCreature (filtOn _crPos _creatures)
<> foldup floorItemSPic (filtOn _flItPos (_unNIntMap . _floorItems)) <> foldup floorItemSPic (filtOn _flItPos (_floorItems))
<> foldup btSPic (filtOn _btPos _buttons) <> foldup btSPic (filtOn _btPos _buttons)
<> foldup (mcSPic (u ^. uvWorld . cWorld . lWorld)) (filtOn _mcPos _machines) <> foldup (mcSPic (u ^. uvWorld . cWorld . lWorld)) (filtOn _mcPos _machines)
<> foldMap' drawChasm (u ^. uvWorld . cWorld . chasms) <> foldMap' drawChasm (u ^. uvWorld . cWorld . chasms)
+1 -1
View File
@@ -17,7 +17,7 @@ getSelectedCloseObj w = do
case i of case i of
3 -> do 3 -> do
NInt k <- w ^? hud . closeItems . ix j NInt k <- w ^? hud . closeItems . ix j
fmap Left $ w ^? cWorld . lWorld . floorItems . unNIntMap . ix k fmap Left $ w ^? cWorld . lWorld . floorItems . ix k
5 -> do 5 -> do
k <- w ^? hud . closeButtons . ix j k <- w ^? hud . closeButtons . ix j
fmap Right $ w ^? cWorld . lWorld . buttons . ix k fmap Right $ w ^? cWorld . lWorld . buttons . ix k
+1 -1
View File
@@ -64,7 +64,7 @@ getCommand w tm = \case
TCSensorInfo -> sensorCommand w tm TCSensorInfo -> sensorCommand w tm
damageCodeCommand :: World -> Terminal -> PTE.TrieMap Char (PTE.TrieMap Char [TerminalLine]) damageCodeCommand :: World -> Terminal -> PTE.TrieMap Char (PTE.TrieMap Char [TerminalLine])
damageCodeCommand w tm damageCodeCommand w _
= PTE.singleton "DAMAGECODE" $ PTE.fromList $ mapMaybe f [minBound ..] = PTE.singleton "DAMAGECODE" $ PTE.fromList $ mapMaybe f [minBound ..]
where where
f :: SensorType -> Maybe (String, [TerminalLine]) f :: SensorType -> Maybe (String, [TerminalLine])
+2 -3
View File
@@ -1,6 +1,5 @@
module Dodge.TractorBeam.Update where module Dodge.TractorBeam.Update (updateTractorBeam) where
import NewInt
import Control.Lens import Control.Lens
import Dodge.Data.World import Dodge.Data.World
import Geometry import Geometry
@@ -12,7 +11,7 @@ updateTractorBeam w pj
| otherwise = | otherwise =
( w ( w
& cWorld . lWorld . creatures %~ IM.map (tractCr pullVel pos outpos) & cWorld . lWorld . creatures %~ IM.map (tractCr pullVel pos outpos)
& cWorld . lWorld . floorItems . unNIntMap %~ IM.map (tractFlIt pullVel pos outpos) & cWorld . lWorld . floorItems %~ IM.map (tractFlIt pullVel pos outpos)
, Just (pj & tbTime -~ 1) , Just (pj & tbTime -~ 1)
) )
where where
+2 -2
View File
@@ -150,7 +150,7 @@ tryPickupSelected k mpos w = do
where where
g i = do g i = do
NInt j <- w ^? hud . closeItems . ix i NInt j <- w ^? hud . closeItems . ix i
w ^? cWorld . lWorld . floorItems . unNIntMap . ix j w ^? cWorld . lWorld . floorItems . ix j
updateMouseReleaseInGame :: World -> World updateMouseReleaseInGame :: World -> World
updateMouseReleaseInGame w = case w ^. input . mouseContext of updateMouseReleaseInGame w = case w ^. input . mouseContext of
@@ -531,7 +531,7 @@ getCloseObj w = getSelectedCloseObj w <|> topcitem <|> topcbut
k' <- (w ^? hud . hudElement . diSections . ix 3 . ssItems) k' <- (w ^? hud . hudElement . diSections . ix 3 . ssItems)
>>= (fmap fst . IM.lookupMin) >>= (fmap fst . IM.lookupMin)
NInt k <- w ^? hud . closeItems . ix k' NInt k <- w ^? hud . closeItems . ix k'
Left <$> w ^? cWorld . lWorld . floorItems . unNIntMap . ix k Left <$> w ^? cWorld . lWorld . floorItems . ix k
topcbut = do topcbut = do
k <- w ^? hud . closeButtons . ix 0 k <- w ^? hud . closeButtons . ix 0
Right <$> w ^? cWorld . lWorld . buttons . ix k Right <$> w ^? cWorld . lWorld . buttons . ix k