91 lines
2.8 KiB
Haskell
91 lines
2.8 KiB
Haskell
module Dodge.Inventory
|
|
( checkInvSlotsYou
|
|
, rmSelectedInvItem
|
|
, addItem
|
|
, updateCloseObjects
|
|
, closeObjScrollDir
|
|
)
|
|
where
|
|
import Dodge.Data
|
|
import Dodge.Base
|
|
import Dodge.Base.Collide
|
|
import Geometry
|
|
import FoldableHelp
|
|
import Padding
|
|
|
|
--import Data.Maybe
|
|
import Data.List
|
|
import qualified Data.IntMap.Strict as IM
|
|
--import System.Random
|
|
import Control.Lens
|
|
|
|
-- | Finds first available slot where a new item may be placed in your inventory
|
|
checkInvSlotsYou :: Item -> World -> Maybe Int
|
|
checkInvSlotsYou it w = checkInvSlotsH it invListSelFirst
|
|
where
|
|
youCr = you w
|
|
youSel = _crInvSel youCr
|
|
invList = _crInv youCr
|
|
invListSelFirst = (youSel , invList IM.! youSel) : IM.toList invList
|
|
|
|
checkInvSlotsH :: Item -> [(Int,Item)] -> Maybe Int
|
|
checkInvSlotsH it = fmap fst . find cond
|
|
where
|
|
cond (_,NoItem) = True
|
|
cond (_,it' ) = itNotFull it' && _itName it == _itName it'
|
|
|
|
---- | Finds first available slot where a new item may be placed in the inventory
|
|
--checkInvSlots :: Item -> IM.IntMap Item -> Maybe Int
|
|
--checkInvSlots it = checkInvSlotsH it . IM.toList
|
|
|
|
addItem :: Item -> Item -> Item
|
|
addItem it NoItem = it
|
|
addItem _ it' = it' & itAmount +~ 1
|
|
|
|
--numInventorySlots :: Int
|
|
--numInventorySlots = 9
|
|
|
|
itNotFull :: Item -> Bool
|
|
itNotFull it = _itMaxStack it > _itAmount it
|
|
|
|
rmInvItem
|
|
:: Int -- ^ Creature id
|
|
-> Int -- ^ Inventory position
|
|
-> World
|
|
-> World
|
|
rmInvItem cid itid w = case w ^? creatures . ix cid . crInv . ix itid . itAmount of
|
|
Just x | x > 1 -> w & creatures . ix cid . crInv . ix itid . itAmount %~ subtract 1
|
|
_ -> w & creatures . ix cid . crInv . ix itid .~ NoItem
|
|
{- Delete a creature's selected item, the item will no longer exist. -}
|
|
rmSelectedInvItem
|
|
:: Int -- ^ Creature id
|
|
-> World
|
|
-> World
|
|
rmSelectedInvItem cid w = rmInvItem cid (_crInvSel (_creatures w IM.! cid)) w
|
|
|
|
updateCloseObjects :: World -> World
|
|
updateCloseObjects w = w & closeActiveObjects .~ unionBy eTest oldCloseFiltered currentClose
|
|
where
|
|
filt = filter $ \obj -> dist ypos (pos obj) < 40 && hasLOS ypos (pos obj) w
|
|
ypos = _crPos $ you w
|
|
objs = map Left (IM.elems $ _floorItems w) ++ activeButtons
|
|
activeButtons = map Right
|
|
. filter ( (/=) BtNoLabel . _btState)
|
|
. IM.elems
|
|
$ _buttons w
|
|
pos (Right x) = _btPos x
|
|
pos (Left x) = _flItPos x
|
|
eTest (Right x) (Right y) = _btID x == _btID y
|
|
eTest (Left x) (Left y) = _flItID x == _flItID y
|
|
eTest _ _ = False
|
|
currentClose = filt objs
|
|
oldClose = filt $ _closeActiveObjects w
|
|
oldCloseFiltered = intersectBy eTest oldClose currentClose
|
|
|
|
closeObjScrollDir :: Float -> World -> World
|
|
closeObjScrollDir x
|
|
| x > 0 = over closeActiveObjects rotU
|
|
| x < 0 = over closeActiveObjects rotD
|
|
| otherwise = id
|
|
|