95 lines
3.5 KiB
Haskell
95 lines
3.5 KiB
Haskell
{-# LANGUAGE TupleSections #-}
|
|
|
|
module Dodge.Inventory.Add (
|
|
createItemYou,
|
|
pickUpItem,
|
|
pickUpItemAt,
|
|
) where
|
|
|
|
import qualified IntSetHelp as IS
|
|
import Dodge.Data.SelectionList
|
|
import Linear
|
|
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
|
|
|
|
-- this assumes that this item is currently on the floor
|
|
tryPutItemInInv :: Maybe Int -> Int -> Int -> World -> Maybe (NewInt InvInt, World)
|
|
tryPutItemInInv mcipos 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
|
|
}
|
|
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 . ix itid . itLocation .~ itloc
|
|
& cWorld . lWorld . floorItems . at itid .~ Nothing
|
|
& updateselectionextra invid
|
|
& updatecloseitemset
|
|
& maybeselect invid
|
|
& cWorld . highlightItems . at itid ?~ 20
|
|
where
|
|
maybeselect invid = fromMaybe id $ do
|
|
i <- mcipos
|
|
is <- w ^? hud . diSections . ix 3 . ssSet
|
|
guard $ i `IS.member` is
|
|
return $ hud . diSections . ix 0 . ssSet %~ IS.insert (invid ^. unNInt)
|
|
updatecloseitemset = fromMaybe id $ do
|
|
i <- mcipos
|
|
return $ hud . diSections . ix 3 . ssSet %~ IS.deleteShift i
|
|
updateselectionextra i
|
|
-- | cid == 0 = (hud . diSelection . _Just . slSet %~ IS.map (f i))
|
|
| cid == 0 = (hud . diSections . ix 0 . ssSet %~ IS.map (f i))
|
|
. (hud . diSelection . _Just . slInt %~ f i)
|
|
| otherwise = id
|
|
f j i | i >= _unNInt j = i + 1
|
|
| otherwise = i
|
|
|
|
-- not sure why we have the cid here, this will probably only work for cid == 0
|
|
tryPutItemInInvAt :: Maybe Int -> Int -> Int -> Int -> World -> Maybe World
|
|
tryPutItemInInvAt mcipos i cid itid w = do
|
|
(j, w') <- tryPutItemInInv mcipos cid itid w
|
|
guard (i <= _unNInt j)
|
|
return $ foldr f w' [i + 1 .. _unNInt j]
|
|
where
|
|
f j = swapInvItems (\_ _ -> Just (j -1)) j
|
|
|
|
createItemYou :: Item -> World -> World
|
|
createItemYou itm w = maybe w' snd $ tryPutItemInInv Nothing 0 itid w'
|
|
where
|
|
itid = IM.newKey $ w ^. cWorld . lWorld . items
|
|
pos = w ^?! cWorld . lWorld . creatures . ix 0 . crPos . _xy
|
|
w' = copyItemToFloor pos (itm & itID .~ NInt itid) w
|
|
|
|
-- the duplication is annoying...
|
|
pickUpItem :: Int -> (Int,Int) -> World -> World
|
|
pickUpItem cid (i,itid) w = fromMaybe w $ do
|
|
p <- w ^? cWorld . lWorld . floorItems . ix itid . flItPos
|
|
soundStart (CrSound cid) p pickUpS Nothing . snd <$> tryPutItemInInv (Just i) cid itid w
|
|
|
|
pickUpItemAt :: Int -> Int -> (Int,Int) -> World -> World
|
|
pickUpItemAt invid cid (i,itid) w = fromMaybe w $ do
|
|
p <- w ^? cWorld . lWorld . floorItems . ix itid . flItPos
|
|
soundStart (CrSound cid) p pickUpS Nothing <$> tryPutItemInInvAt (Just i) invid cid itid w
|
|
& _Just . hud . diSections . ix 0 . ssSet %~ IS.map f
|
|
where
|
|
f j | j >= invid = j +1
|
|
| otherwise = j
|