232 lines
8.2 KiB
Haskell
232 lines
8.2 KiB
Haskell
{-# LANGUAGE TupleSections #-}
|
|
module Dodge.Inventory
|
|
( checkInvSlotsYou
|
|
, rmSelectedInvItem
|
|
, invSelPos
|
|
, invSelSize
|
|
, selNumPos
|
|
, selNumTextPos
|
|
, selNumCol
|
|
, selNumSlots
|
|
, selNumMidHeight
|
|
, augmentedInvSizes
|
|
, rmInvItem
|
|
, updateCloseObjects
|
|
, updateTerminal
|
|
, closeObjScrollDir
|
|
, closeObjectCol
|
|
-- , swapInvDir
|
|
, changeInvSel
|
|
, changeSwapInvSel
|
|
, changeAugInvSel
|
|
, crNumFreeSlots
|
|
, crInvSize
|
|
, selectedCloseObject
|
|
)
|
|
where
|
|
import Dodge.Data
|
|
import Dodge.Inventory.CloseObject
|
|
import Dodge.Inventory.CheckSlots
|
|
import Dodge.Inventory.ItemSpace
|
|
import Dodge.Base
|
|
import Geometry
|
|
--import FoldableHelp
|
|
import Padding
|
|
import Color
|
|
import qualified IntMapHelp as IM
|
|
import ListHelp
|
|
import LensHelp
|
|
|
|
--import qualified Data.IntSet as IS
|
|
import Data.Maybe
|
|
--import Data.List
|
|
--import System.Random
|
|
|
|
-- | after this the item at the inventory position will no longer exist
|
|
rmInvItem :: Int -- ^ Creature id
|
|
-> Int -- ^ Inventory position
|
|
-> World -> World
|
|
rmInvItem cid invid w = case w ^? creatures . ix cid . crInv . ix invid . itConsumption . itAmount of
|
|
Just x | x > 1 -> w & creatures . ix cid . crInv . ix invid . itConsumption . itAmount %~ subtract 1
|
|
_ -> w & creatures . ix cid . crInv %~ f
|
|
& creatures . ix cid . crInvSel %~ g
|
|
& creatures . ix cid . crLeftInvSel . _Just %~ g
|
|
& creatures . ix cid . crInvEquipped %~ IM.delete invid
|
|
& creatures . ix cid . crInvEquipped %~ IM.mapKeys g
|
|
-- TODO check whether this can be mapKeysMonotonic
|
|
where
|
|
maxk = fmap fst $ IM.lookupMax $ _crInv $ _creatures w IM.! cid
|
|
f inv = let (xs,ys) = IM.split invid inv
|
|
in xs `IM.union` IM.mapKeys (subtract 1) ys
|
|
g x | x > invid || Just x == maxk = max 0 $ x - 1
|
|
| otherwise = x
|
|
|
|
rmSelectedInvItem :: Int -> World -> World
|
|
rmSelectedInvItem cid w = rmInvItem cid (_crInvSel (_creatures w IM.! cid)) w
|
|
|
|
augmentedInvSizes :: World -> IM.IntMap Int
|
|
augmentedInvSizes = bimapAugmentInv itSlotsTaken closeObjectSize
|
|
|
|
bimapAugmentInv :: (Item -> a) -> (Either FloorItem Button -> a) -> World -> IM.IntMap a
|
|
bimapAugmentInv f g w = IM.union
|
|
(f <$> yourInv w)
|
|
(IM.fromAscList $ zip [length (yourInv w) ..] $ map g $ _closeObjects w)
|
|
|
|
invSelSize :: Int -> World -> Int
|
|
invSelSize i w = fromMaybe 1 $ augmentedInvSizes w IM.!? i
|
|
|
|
closeObjectSize :: Either FloorItem Button -> Int
|
|
closeObjectSize e = case e of
|
|
Left flit -> itSlotsTaken $ _flIt flit
|
|
Right _ -> 1
|
|
closeObjectCol :: Either FloorItem Button -> Color
|
|
closeObjectCol e = case e of
|
|
Left flit -> _itInvColor $ _flIt flit
|
|
Right _ -> yellow
|
|
|
|
selNumSlots :: Int -> World -> Int
|
|
selNumSlots i w = fromMaybe 1 $ augmentedInvSizes w IM.!? i
|
|
|
|
selNumPos :: Int -> World -> Int
|
|
selNumPos i w = splitgap + (foldl' (+) 0 . fst $ IM.split i (augmentedInvSizes w))
|
|
where
|
|
splitgap
|
|
| i < length (yourInv w) = 0
|
|
| otherwise = 1
|
|
|
|
selNumTextPos :: Configuration -> World -> Int -> Point2
|
|
selNumTextPos cfig w i = V2 (150 - hw) ( hh + 20 * fromIntegral ipos + 7.5)
|
|
where
|
|
hh = halfHeight cfig
|
|
hw = halfWidth cfig
|
|
ipos = selNumPos i w
|
|
|
|
selNumMidHeight :: Configuration -> World -> Int -> Point2
|
|
selNumMidHeight cfig w i = V2 (150 - hw) ( hh + bump - (20 * fromIntegral ipos + 7.5))
|
|
where
|
|
hh = halfHeight cfig
|
|
hw = halfWidth cfig
|
|
ipos = selNumPos i w
|
|
bump = negate $ 10 * fromIntegral (selNumSlots i w)
|
|
|
|
selNumCol :: Int -> World -> Color
|
|
selNumCol i w = fromMaybe white $ bimapAugmentInv _itInvColor closeObjectCol w IM.!? i
|
|
|
|
invSelPos :: World -> Int
|
|
invSelPos w = splitgap + (foldl' (+) 0 . fst $ IM.split invsel (augmentedInvSizes w))
|
|
where
|
|
invsel = yourInvSel w
|
|
splitgap
|
|
| yourInvSel w < length (yourInv w) = 0
|
|
| otherwise = 1
|
|
|
|
updateTerminal :: World -> World
|
|
updateTerminal = checkTermDist . updateTerminalLine
|
|
|
|
checkTermDist :: World -> World
|
|
checkTermDist w = case w ^? hud . hudElement . subInventory . termID of
|
|
Just btid -> fromMaybe (w & hud . hudElement .~ DisplayInventory NoSubInventory) $ do
|
|
btpos <- w ^? buttons . ix btid . btPos
|
|
if dist btpos (_crPos $ you w) < 40 then Just w else Nothing
|
|
Nothing -> w
|
|
|
|
updateTerminalLine :: World -> World
|
|
updateTerminalLine w = case w ^? hud . hudElement . subInventory . termParams . termFutureLines . ix 0 of
|
|
Nothing -> w
|
|
Just tl | _tlPause tl > 0 -> w
|
|
& hud . hudElement . subInventory . termParams . termFutureLines . ix 0 . tlPause -~ 1
|
|
Just (TerminalLineDisplay _ f) -> w
|
|
& hud . hudElement . subInventory . termParams . termFutureLines %~ tail
|
|
& hud . hudElement . subInventory . termParams . termDisplayedLines .:~ f
|
|
Just (TerminalLineEffect _ eff) -> w
|
|
& hud . hudElement . subInventory . termParams . termFutureLines %~ tail
|
|
& eff (_subInventory . _hudElement $ _hud w)
|
|
|
|
-- this looks ugly...
|
|
updateCloseObjects :: World -> World
|
|
updateCloseObjects w = w & closeObjects .~ unionBy closeObjEq oldCloseFiltered currentClose
|
|
& creatures . ix (_yourID w) . crInvSel %~ updateinvsel
|
|
where
|
|
updateinvsel curinvsel
|
|
| length (augmentedInvSizes w) <= curinvsel = max 0 $ length (augmentedInvSizes w) - 1
|
|
| otherwise = curinvsel
|
|
filt = filter $ \obj -> dist ypos (closeObjPos obj) < 40 && hasButtonLOS ypos (closeObjPos obj) w
|
|
ypos = _crPos $ you w
|
|
activeButtons = map Right
|
|
. filter ( (/=) BtNoLabel . _btState)
|
|
. IM.elems
|
|
$ _buttons w
|
|
currentClose = filt $ map Left (IM.elems $ _floorItems w) ++ activeButtons
|
|
oldClose = filt $ _closeObjects w
|
|
oldCloseFiltered = intersectBy closeObjEq oldClose currentClose
|
|
|
|
closeObjScrollDir :: Float -> World -> World
|
|
closeObjScrollDir x
|
|
| x > 0 = over closeObjects rotU
|
|
| x < 0 = over closeObjects rotD
|
|
| otherwise = id
|
|
|
|
changeInvSel :: Int -> World -> World
|
|
changeInvSel i w
|
|
| n == 0 = w
|
|
| yourInvSel w < n = w & creatures . ix (_yourID w) . crInvSel %~ (`mod` n) . subtract i
|
|
| otherwise = w & creatures . ix (_yourID w) . crInvSel %~ ((+n) . (`mod` numCO) . subtract (i+n))
|
|
-- arguably this should jump the invpos into the inventory proper
|
|
where
|
|
n = length $ _crInv $ _creatures w IM.! _yourID w
|
|
numCO = length $ _closeObjects w
|
|
|
|
changeSwapInvSel :: Int -> World -> World
|
|
changeSwapInvSel k w
|
|
| n == 0 = w
|
|
| yourInvSel w < n = w
|
|
& creatures . ix (_yourID w) %~ updatecreature
|
|
| otherwise = w & creatures . ix (_yourID w) . crInvSel .~ ico'
|
|
& closeObjects %~ swapIndices (i - n) (ico' - n)
|
|
where
|
|
updatecreature = ( crInv %~ IM.swapKeys (i `mod` n) swapi )
|
|
. (crLeftInvSel . _Just %~ updateLeftInvSel)
|
|
. (crInvSel %~ (`mod` n) . subtract k)
|
|
. (crInvEquipped %~ IM.swapKeys i swapi)
|
|
swapi = (i - k) `mod` n
|
|
updateLeftInvSel li | i == li = swapi
|
|
| swapi == li = i
|
|
| otherwise = li
|
|
i = _crInvSel $ you w
|
|
ico' = ( (i - (k+n)) `mod` numCO ) + n
|
|
n = length $ _crInv $ _creatures w IM.! _yourID w
|
|
numCO = length $ _closeObjects w
|
|
|
|
--swapIntSetKeys :: Int -> Int -> IS.IntSet -> IS.IntSet
|
|
--swapIntSetKeys i j is
|
|
-- | i `IS.member` is && j `IS.member` is = is
|
|
-- | i `IS.member` is = j `IS.insert` (i `IS.delete` is)
|
|
-- | j `IS.member` is = i `IS.insert` (j `IS.delete` is)
|
|
-- | otherwise = is
|
|
|
|
changeAugInvSel :: Int -> World -> World
|
|
changeAugInvSel i w
|
|
| n == 0 = w
|
|
| otherwise = w & creatures . ix (_yourID w) . crInvSel %~ (`mod` n) . subtract i
|
|
where
|
|
n = length (yourInv w) + length (_closeObjects w)
|
|
|
|
bestCloseObjectIndex :: World -> Maybe Int
|
|
bestCloseObjectIndex w = findIndex f $ _closeObjects w
|
|
where
|
|
f (Right _) = True
|
|
f (Left flit) = itSlotsTaken (_flIt flit) <= _crInvCapacity ycr - crInvSize ycr
|
|
ycr = you w
|
|
|
|
selectedCloseObject :: World -> Maybe (Int,Either FloorItem Button)
|
|
selectedCloseObject w
|
|
| invsel >= length inv = selectNthCloseObject w (invsel - length inv)
|
|
| otherwise = selectNthCloseObject w =<< bestCloseObjectIndex w
|
|
where
|
|
invsel = _crInvSel cr
|
|
cr = you w
|
|
inv = _crInv cr
|
|
|
|
selectNthCloseObject :: World -> Int -> Maybe (Int,Either FloorItem Button)
|
|
selectNthCloseObject w n = (length (yourInv w) + n,) <$> (_closeObjects w !? n)
|