133 lines
5.0 KiB
Haskell
133 lines
5.0 KiB
Haskell
{-# LANGUAGE TupleSections #-}
|
|
module Dodge.Inventory.Add (
|
|
tryPutItemInInv,
|
|
createItemYou,
|
|
pickUpItem,
|
|
pickUpItemAt,
|
|
) where
|
|
|
|
import Control.Lens
|
|
import Control.Monad
|
|
import Data.Maybe
|
|
import Dodge.Data.World
|
|
import Dodge.FloorItem
|
|
import Dodge.Inventory.CheckSlots
|
|
import Dodge.Inventory.Location
|
|
import Dodge.Inventory.Swap
|
|
import Dodge.SoundLogic
|
|
import qualified IntMapHelp as IM
|
|
import NewInt
|
|
|
|
-- should check that the item is not already in your inventory
|
|
-- this assumes that this is a floor item
|
|
tryPutItemInInv :: Int -> Int -> World -> Maybe (NewInt InvInt,World)
|
|
tryPutItemInInv cid itid w = do
|
|
itm <- w ^? cWorld . lWorld . items . ix itid
|
|
invid <- checkInvSlotsYou itm w
|
|
let itloc = InInv
|
|
{ _ilCrID = cid
|
|
, _ilInvID = invid
|
|
, _ilIsRoot = False
|
|
, _ilIsSelected = False
|
|
, _ilIsAttached = False
|
|
, _ilEquipSite = Nothing
|
|
}
|
|
newitm = itm & itLocation .~ itloc
|
|
return $ (invid,) $ w
|
|
& cWorld . lWorld %~ crUpdateItemLocations cid
|
|
-- not sure about the order of these...
|
|
& cWorld . lWorld . creatures . ix cid . crInv . at invid ?~ itid
|
|
& cWorld . lWorld . items . at itid ?~ newitm
|
|
-- & cWorld . lWorld . itemLocations . at itid ?~ itloc
|
|
& cWorld . lWorld . floorItems . at itid .~ Nothing
|
|
& updateselectionextra
|
|
where
|
|
updateselectionextra
|
|
| cid == 0 =
|
|
hud . hudElement . diSelection . _Just . _3 %~ const mempty
|
|
| otherwise = id
|
|
|
|
-- not sure why we have the cid here, this will probably only work for cid == 0
|
|
tryPutItemInInvAt :: Int -> Int -> Int -> World -> Maybe World
|
|
tryPutItemInInvAt i cid itid w = do
|
|
(j, w') <- tryPutItemInInv cid itid w
|
|
guard (i <= _unNInt j)
|
|
return $ foldr f w' [i + 1 .. _unNInt j]
|
|
where
|
|
f j = swapInvItems (\_ _ -> Just (j -1)) j
|
|
|
|
---- | Pick up a specific item.
|
|
--tryPutItemInInv :: Int -> Item -> Int -> World -> Maybe (Int, World)
|
|
--tryPutItemInInv cid flit itid w = do
|
|
-- i <- checkInvSlotsYou it w
|
|
-- Just
|
|
-- ( i
|
|
-- , w
|
|
-- & cWorld . lWorld . floorItems %~ IM.delete itid
|
|
-- & cWorld . lWorld . creatures . ix cid . crInv . at i ?~ it
|
|
-- & updateItLocation i
|
|
-- -- I forget whether using "at" rather than "IM.insert" here caused problems
|
|
-- -- & cWorld . lWorld . creatures . ix cid . crInv . at i ?~ it
|
|
-- -- note item locations are updated twice: first for the ilInvID,
|
|
-- -- second for the root/selected item bools
|
|
-- & cWorld . lWorld %~ crUpdateItemLocations cid
|
|
-- & setInvPosFromSS
|
|
-- & updateselectionextra
|
|
-- & cWorld . lWorld %~ crUpdateItemLocations cid
|
|
-- )
|
|
-- where
|
|
-- updateselectionextra
|
|
-- | cid == 0 =
|
|
-- hud . hudElement . diSelection . _Just . _3 %~ const mempty
|
|
-- | otherwise = id
|
|
-- it = _flIt flit
|
|
-- -- not sure if the following is necessary
|
|
-- updateItLocation invid w' =
|
|
-- w' & cWorld . lWorld . itemLocations . ix (_unNInt $ _itID it)
|
|
-- .~ InInv
|
|
-- { _ilCrID = cid
|
|
-- , _ilInvID = invid
|
|
-- , _ilIsRoot = False
|
|
-- , _ilIsSelected = False
|
|
-- , _ilIsAttached = False
|
|
-- , _ilEquipSite = Nothing
|
|
-- }
|
|
|
|
---- should select the item on the floor if no inventory space?
|
|
--createAndSelectItem :: Item -> World -> World
|
|
--createAndSelectItem itm w = case createPutItem itm w of
|
|
-- (Just i, w') ->
|
|
-- w'
|
|
-- & hud . hudElement . diSections . sssExtra . sssSelPos ?~ (0, i)
|
|
-- & cWorld . lWorld . creatures . ix 0 . crManipulation . manObject
|
|
-- .~ InInventory (SelectedItem i
|
|
-- $ fromMaybe (error "no root item1!") $ tryGetRootItemInvID i (you w))
|
|
-- (Nothing, w') -> w'
|
|
|
|
--createPutItem :: Item -> World -> (Maybe Int, World)
|
|
--createPutItem it w = fromMaybe (Nothing,w) $ do
|
|
-- (i,w') <- uncurry (tryPutItemIDInInv 0) $
|
|
-- copyItemToFloorID (_crPos $ you w) (applyModules it) w
|
|
-- return (Just i, w')
|
|
|
|
createItemYou :: Item -> World -> World
|
|
createItemYou itm w = fromMaybe w' $ fmap snd $ tryPutItemInInv 0 itid w'
|
|
where
|
|
itid = IM.newKey $ w ^. cWorld . lWorld . items
|
|
pos = w ^?! cWorld . lWorld . creatures . ix 0 . crPos
|
|
w' = copyItemToFloor pos (itm & itID .~ NInt itid) w
|
|
|
|
-- | Pick up a specific item.
|
|
pickUpItem :: Int -> Int -> World -> World
|
|
pickUpItem cid itid w = fromMaybe w $ do
|
|
(_,w') <- tryPutItemInInv cid itid w
|
|
p <- w ^? cWorld . lWorld . floorItems . ix itid . flItPos
|
|
return $ soundStart (CrSound cid) p pickUpS Nothing w'
|
|
|
|
-- | Pick up a specific item.
|
|
pickUpItemAt :: Int -> Int -> Int -> World -> World
|
|
pickUpItemAt invid cid itid w = fromMaybe w $ do
|
|
w' <- tryPutItemInInvAt invid cid itid w
|
|
p <- w ^? cWorld . lWorld . floorItems . ix itid . flItPos
|
|
return $ soundStart (CrSound cid) p pickUpS Nothing w'
|