Files
loop/src/Dodge/Inventory.hs
T
2021-11-28 11:45:53 +00:00

113 lines
3.5 KiB
Haskell

module Dodge.Inventory
( checkInvSlotsYou
, rmSelectedInvItem
, addItem
, rmInvItem
, updateCloseObjects
, closeObjScrollDir
, swapInvDir
, dirInvPos
)
where
import Dodge.Data
import Dodge.Base
import Dodge.Base.Collide
import Geometry
import FoldableHelp
import Padding
import qualified IntMapHelp as IM
--import Data.Maybe
import Data.List
--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 = case it ^? itMaxStack of
Just themax -> themax > _itAmount it
Nothing -> False
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 & closeObjects .~ 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 $ _closeObjects w
oldCloseFiltered = intersectBy eTest oldClose currentClose
closeObjScrollDir :: Float -> World -> World
closeObjScrollDir x
| x > 0 = over closeObjects rotU
| x < 0 = over closeObjects rotD
| otherwise = id
swapInvDir :: Int -> World -> World
swapInvDir k w = w & creatures . ix (_yourID w) %~ updatecreature
where
updatecreature = ( crInv %~ IM.swapKeys (i `mod` n) swapi )
. (crLeftInvSel . _Just %~ updateLeftInvSel)
swapi = (i + k) `mod` n
updateLeftInvSel li | i == li = swapi
| swapi == li = i
| otherwise = li
i = _crInvSel $ you w
n = length $ IM.keys $ _crInv $ _creatures w IM.! _yourID w
dirInvPos :: Int -> World -> World
dirInvPos i w = w
& creatures . ix (_yourID w) . crInvSel %~ (`mod` n) . subtract i
where
n = length $ IM.keys $ _crInv $ _creatures w IM.! _yourID w