100 lines
3.3 KiB
Haskell
100 lines
3.3 KiB
Haskell
module Dodge.Inventory
|
|
where
|
|
import Dodge.Data
|
|
import Dodge.Base
|
|
import Geometry
|
|
|
|
import Data.Maybe
|
|
import Data.List
|
|
import qualified Data.IntMap.Strict as IM
|
|
--import System.Random
|
|
import Control.Lens
|
|
|
|
checkInvSlotsYou :: Item -> World -> Maybe Int
|
|
checkInvSlotsYou it w = fst <$> find cond invListSelFirst
|
|
where
|
|
cond (_,NoItem) = True
|
|
cond (_,it' ) = itNotFull it' && _itName it == _itName it'
|
|
youCr = you w
|
|
youSel = _crInvSel youCr
|
|
invList = _crInv youCr
|
|
invListSelFirst = (youSel , invList IM.! youSel) : IM.toList invList
|
|
|
|
checkInvSlots :: Item -> IM.IntMap Item -> Maybe Int
|
|
checkInvSlots it its = fmap fst $ find cond $ IM.toList its
|
|
where
|
|
cond (_,NoItem) = True
|
|
cond (_,it' ) = itNotFull it' && _itName it == _itName it'
|
|
|
|
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
|
|
-- for now, left are floor items, right are buttons
|
|
closestActiveObject :: World -> Maybe (Either FloorItem Button)
|
|
closestActiveObject w = listToMaybe $ sortOn (dist ypos . pos) actObjs
|
|
where
|
|
ypos = _crPos $ you w
|
|
actObjs = filter (\obj -> dist ypos (pos obj) < 40 && hasLOS ypos (pos obj) w)
|
|
$ map Left (IM.elems $ _floorItems w) ++ activeButtons -- map Right (IM.elems $ _buttons w)
|
|
pos (Right x) = _btPos x
|
|
pos (Left x) = _flItPos x
|
|
activeButtons = map Right
|
|
. filter ( (/=) BtNoLabel . _btState)
|
|
. IM.elems
|
|
$ _buttons 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 = closeObjScrollUp
|
|
| x < 0 = closeObjScrollDown
|
|
| otherwise = id
|
|
|
|
closeObjScrollUp :: World -> World
|
|
closeObjScrollUp = over closeActiveObjects rotU
|
|
where rotU [] = []
|
|
rotU (x:xs) = xs ++ [x]
|
|
closeObjScrollDown :: World -> World
|
|
closeObjScrollDown = over closeActiveObjects rotD
|
|
where rotD [] = []
|
|
rotD xs = last xs : init xs
|