106 lines
4.1 KiB
Haskell
106 lines
4.1 KiB
Haskell
module Dodge.Inventory
|
|
where
|
|
import Dodge.Data
|
|
import Dodge.Base
|
|
--import Dodge.SoundLogic
|
|
|
|
import Geometry
|
|
|
|
import Data.Maybe
|
|
import Data.List
|
|
import Data.Function (on)
|
|
import qualified Data.IntMap.Strict as IM
|
|
|
|
import System.Random
|
|
|
|
import Control.Lens
|
|
|
|
checkInvSlotsYou' :: Maybe Item -> World -> Maybe Int
|
|
checkInvSlotsYou' it w = fmap fst $ find cond invListSelFirst
|
|
where cond (_,NoItem) = True
|
|
cond (_,it' ) = itNotFull it' && fmap _itName it == Just (_itName it')
|
|
youCr = you w
|
|
youSel = _crInvSel youCr
|
|
invList = _crInv youCr
|
|
invListSelFirst = (youSel , invList IM.! youSel) : IM.toList invList
|
|
|
|
checkInvSlotsYou :: Item -> World -> Maybe Int
|
|
checkInvSlotsYou it w = fmap 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' = it' & itAmount +~ 1
|
|
|
|
numInventorySlots :: Int
|
|
numInventorySlots = 9
|
|
|
|
itNotFull :: Item -> Bool
|
|
itNotFull it = _itMaxStack it > _itAmount it
|
|
|
|
rmInvItem :: Int -> World -> World
|
|
rmInvItem n w =
|
|
let i = _crInvSel (_creatures w IM.! n)
|
|
item = _crInv (_creatures w IM.! n) IM.! i
|
|
itRef = creatures . ix n . crInv . ix i
|
|
in case item of
|
|
Consumable {_itAmount = 1} -> set itRef NoItem w
|
|
Craftable {_itAmount = 1} -> set itRef NoItem w
|
|
Equipment {_itAmount = 1} -> set itRef NoItem w
|
|
Throwable {_itAmount = 1} -> set itRef NoItem w
|
|
Consumable {_itAmount = x} -> over (itRef . itAmount) (\y-> y-1) w
|
|
Craftable {_itAmount = x} -> over (itRef . itAmount) (\y-> y-1) w
|
|
Equipment {_itAmount = x} -> over (itRef . itAmount) (\y-> y-1) w
|
|
Throwable {_itAmount = x} -> over (itRef . itAmount) (\y-> y-1) w
|
|
_ -> set itRef NoItem w
|
|
|
|
-- for now, left are floor items, right are buttons
|
|
closestActiveObject :: World -> Maybe (Either FloorItem Button)
|
|
closestActiveObject w = listToMaybe $ sortBy (compare `on` 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
|
|
|
|
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
|