285 lines
10 KiB
Haskell
285 lines
10 KiB
Haskell
{-# LANGUAGE TupleSections #-}
|
|
|
|
module Dodge.DisplayInventory (
|
|
toggleCombineInv,
|
|
updateInventorySectionItems,
|
|
updateInventoryPositioning,
|
|
updateCombinePositioning,
|
|
) where
|
|
|
|
import Dodge.ListDisplayParams
|
|
import ListHelp
|
|
import Dodge.Data.Combine
|
|
import Control.Monad
|
|
import qualified Data.IntMap.Strict as IM
|
|
import Data.Maybe
|
|
import Dodge.Base.You
|
|
import Dodge.Combine
|
|
import Dodge.Data.Config
|
|
import Dodge.Data.SelectionList
|
|
import Dodge.Data.Universe
|
|
import Dodge.Inventory.CheckSlots
|
|
import Dodge.Inventory.Color
|
|
import Dodge.Inventory.SelectionList
|
|
import Dodge.SelectionList
|
|
import LensHelp
|
|
import Picture.Base
|
|
import Regex
|
|
|
|
toggleCombineInv :: Universe -> Universe
|
|
toggleCombineInv uv = case uv ^? uvWorld . hud . hudElement . subInventory of
|
|
Just CombineInventory{} -> uv & uvWorld . hud . hudElement . subInventory .~ NoSubInventory
|
|
_ -> uv & uvWorld %~ enterCombineInv (uv ^. uvConfig)
|
|
|
|
updateCombinePositioning :: Universe -> Universe
|
|
updateCombinePositioning u = u & uvWorld . hud . hudElement . subInventory . ciSections
|
|
%~ updateCombineSections (_uvWorld u) (_uvConfig u)
|
|
|
|
updateCombineSections :: World -> Configuration -> SelectionSections CombinableItem -> SelectionSections CombinableItem
|
|
updateCombineSections w cfig sss =
|
|
sss & sssSections
|
|
%~ updateSectionsPositioning
|
|
mselpos
|
|
availablelines
|
|
[(0, showncombs), (-1, filtinv)]
|
|
where
|
|
mselpos = sss ^. sssExtra . sssSelPos
|
|
availablelines = getAvailableListLines secondColumnParams cfig
|
|
allcombs = IM.fromAscList $ zip [0 ..] $ combineList' w
|
|
filtcombs = fromMaybe allcombs $ do
|
|
str <- mstr
|
|
invitms <- w ^? hud . hudElement . diSections . sssSections . ix 0 . ssItems
|
|
return $ IM.filter (flip (andOrRegex $ regexCombs invitms) str) allcombs
|
|
showncombs
|
|
| null filtcombs = IM.singleton 0 $ SelectionInfo ["No possible combinations"] 1 False white 0
|
|
| otherwise = filtcombs
|
|
filtinv = fromMaybe mempty $ do
|
|
str <- mstr
|
|
return $
|
|
IM.singleton
|
|
0
|
|
(SelectionInfo ["COMBINATIONS FILTER: " ++ str, numfiltitems] 2 True white 0)
|
|
mstr = w ^? hud . hudElement . subInventory . ciSections . sssExtra . sssFilters . ix (-1) . _Just
|
|
numfiltitems = " " ++ show (length allcombs - length filtcombs) ++ " FILTERED"
|
|
|
|
regexCombs :: IM.IntMap (SelectionItem ()) -> SelectionItem CombinableItem -> String -> Bool
|
|
regexCombs inv ci str = case str of
|
|
'<':str' -> f str' ci
|
|
_ -> (regexList str . _siPictures) ci
|
|
where
|
|
f str' si = any (g str') (_ciInvIDs $ _siPayload si)
|
|
g str' i = fromMaybe False $ do
|
|
si' <- inv ^? ix i
|
|
return $ regexList str' $ _siPictures si'
|
|
|
|
andOrRegex :: (a -> String -> Bool) -> a -> String -> Bool
|
|
andOrRegex f x str = all (orRegex f x) (wordsBy '&' str)
|
|
|
|
orRegex :: (a -> String -> Bool) -> a -> String -> Bool
|
|
orRegex f x str = case words str of
|
|
[] -> True
|
|
xs -> any (f x) xs
|
|
|
|
updateInventoryPositioning :: Universe -> Universe
|
|
updateInventoryPositioning u = u & uvWorld . hud . hudElement . diSections
|
|
%~ updateDisplaySections (_uvWorld u) (_uvConfig u)
|
|
|
|
updateDisplaySections :: World -> Configuration -> SelectionSections () -> SelectionSections ()
|
|
updateDisplaySections w cfig sss =
|
|
sss & sssSections
|
|
%~ updateSectionsPositioning
|
|
mselpos
|
|
availablelines
|
|
addorder
|
|
where
|
|
mselpos = sss ^. sssExtra . sssSelPos
|
|
addorder = case mselpos of
|
|
Just (-1, _) -> reverse [filtinv, filtclose, invx, youx, closex]
|
|
Just (0, _) -> reverse [filtinv, filtclose, invx, youx, closex]
|
|
Just (1, _) -> reverse [filtinv, filtclose, invx, youx, closex]
|
|
Just (2, _) -> reverse [filtinv, filtclose, closex, invx, youx]
|
|
_ -> reverse [filtinv, filtclose, closex, invx, youx]
|
|
(filtinv, invx) = filtpair (-1) invitems' "INV. "
|
|
(filtclose, closex) = filtpair 2 coitems' "NEARBY "
|
|
youx = (1, youitems)
|
|
youitems = IM.singleton 0 $ SelectionItem [thetext] 1 True invDimColor 2 ()
|
|
thetext = displayFreeSlots nfreeslots
|
|
availablelines = getAvailableListLines (invDisplayParams w) cfig
|
|
coitems' =
|
|
IM.fromDistinctAscList . zip [0 ..] $
|
|
map closeObjectToSelectionItem (w ^. hud . closeObjects)
|
|
invitems' = IM.mapWithKey (invSelectionItem cr) inv
|
|
cr = you w
|
|
inv = _crInv (you w)
|
|
nfreeslots = crNumFreeSlots cr
|
|
filtpair i itms filtdescription =
|
|
( (i, filtsis)
|
|
, (i + 1, itms')
|
|
)
|
|
where
|
|
mstr = w ^? hud . hudElement . diSections . sssExtra . sssFilters . ix i . _Just
|
|
filtsis = fromMaybe mempty $ do
|
|
str <- mstr
|
|
return $
|
|
IM.singleton
|
|
0
|
|
(SelectionInfo [filtdescription ++ "FILTER: " ++ str, numfiltitems] 2 True white 0)
|
|
itms' = fromMaybe itms $ do
|
|
str <- mstr
|
|
return $ IM.filter (plainRegex str) itms
|
|
numfiltitems = " " ++ show (length itms - length itms') ++ " FILTERED"
|
|
|
|
-- it is annoying that this is necessary
|
|
updateInventorySectionItems :: World -> World
|
|
updateInventorySectionItems w = w
|
|
& hud . hudElement . diSections . sssSections . ix 0 . ssItems %~ f
|
|
where
|
|
f olditems = fromMaybe olditems $ do
|
|
cr <- w ^? cWorld . lWorld . creatures . ix 0
|
|
invitms <- IM.mapWithKey (invSelectionItem cr) <$> cr ^? crInv
|
|
return $ case w ^? hud . hudElement . diSections . sssExtra . sssFilters . ix (-1) . _Just of
|
|
Just str -> IM.filter (plainRegex str) invitms
|
|
_ -> invitms
|
|
|
|
plainRegex :: String -> SelectionItem a -> Bool
|
|
plainRegex = flip $ andOrRegex (\si str -> regexList str (_siPictures si))
|
|
|
|
displayFreeSlots :: Int -> String
|
|
displayFreeSlots x = case x of
|
|
0 -> "INVENTORY FULL"
|
|
1 -> "1 FREE SLOT"
|
|
_ -> show x ++ " FREE SLOTS"
|
|
|
|
updateSectionsPositioning ::
|
|
Maybe (Int, Int) ->
|
|
Int ->
|
|
[(Int, IM.IntMap (SelectionItem a))] ->
|
|
IM.IntMap (SelectionSection a) ->
|
|
IM.IntMap (SelectionSection a)
|
|
updateSectionsPositioning _ _ [] _ = mempty
|
|
updateSectionsPositioning mselpos allavailablelines ((k, y) : xs) sss =
|
|
IM.insert k ss previoussections
|
|
where
|
|
mscel = do
|
|
(i, j) <- mselpos
|
|
guard $ i == k
|
|
return j
|
|
ss = updateSection y mscel linesleft x
|
|
x = sss ^?! ix k
|
|
availablelines = allavailablelines - _ssMinSize x
|
|
linesleft = allavailablelines - sum (linestaken <$> previoussections)
|
|
linestaken ss' = max (length $ _ssShownItems ss') (_ssMinSize ss')
|
|
previoussections = updateSectionsPositioning mselpos availablelines xs sss
|
|
|
|
updateSection ::
|
|
IM.IntMap (SelectionItem a) ->
|
|
Maybe Int ->
|
|
Int ->
|
|
SelectionSection a ->
|
|
SelectionSection a
|
|
updateSection sis mcsel availablelines ss =
|
|
ss
|
|
{ _ssItems = sis
|
|
, _ssCursor = scurs
|
|
, _ssOffset = offset
|
|
, _ssShownItems = shownitems
|
|
}
|
|
where
|
|
oldoffset = ss ^. ssOffset
|
|
scurs = do
|
|
csel <- mcsel
|
|
(_, si) <- IM.lookupGE csel sis -- this is not right
|
|
let cpos = sum (fmap (length . _siPictures) . fst . IM.split csel $ sis)
|
|
csize = length $ _siPictures si
|
|
ccolor = _siColor si
|
|
return $ SectionCursor (cpos - offset) csize ccolor
|
|
nocursoroffset = if length allstrings - oldoffset <= availablelines
|
|
then max 0 (length allstrings - availablelines)
|
|
else oldoffset
|
|
offset = fromMaybe nocursoroffset $ do
|
|
csel <- mcsel
|
|
maxcsel <- fst <$> IM.lookupMax sis
|
|
si <- sis ^? ix csel
|
|
let xselsize = length $ _siPictures si
|
|
return $ case sum $ fmap (length . _siPictures) . fst . IM.split csel $ sis of
|
|
pos
|
|
| pos == 0 || length allstrings <= availablelines ->
|
|
0
|
|
pos
|
|
| pos - 1 < oldoffset ->
|
|
pos - 1
|
|
pos
|
|
| maxcsel == csel ->
|
|
pos - availablelines + xselsize
|
|
pos
|
|
| pos + 1 + xselsize - availablelines > oldoffset ->
|
|
pos - availablelines + 1 + xselsize
|
|
_
|
|
| length allstrings - oldoffset < availablelines ->
|
|
length allstrings - availablelines
|
|
_ -> oldoffset
|
|
tweakfirst (x : xs)
|
|
| offset > 0 = xtra "<<<" : map h xs
|
|
| otherwise = map h (x : xs)
|
|
tweakfirst [] = []
|
|
shownitems
|
|
| length shownstrings > availablelines =
|
|
tweakfirst (take (availablelines - 1) shownstrings)
|
|
++ [xtra ">>>"]
|
|
| otherwise = tweakfirst shownstrings
|
|
allstrings :: [(Color, String)]
|
|
allstrings = foldMap g sis
|
|
shownstrings = drop offset allstrings
|
|
h (col, str) = color col . text $ theindent ++ str
|
|
theindent = replicate (_ssIndent ss) ' '
|
|
xtra str = color white . text $ theindent ++ str ++ " MORE " ++ _ssDescriptor ss
|
|
g si = map (_siColor si,) $ _siPictures si
|
|
|
|
enterCombineInv :: Configuration -> World -> World
|
|
enterCombineInv cfig w =
|
|
w & hud . hudElement . subInventory
|
|
.~ CombineInventory
|
|
cm'
|
|
sss
|
|
where
|
|
cm' = IM.fromAscList $ zip [0 ..] $ combineList' w
|
|
cm
|
|
| null cm' = IM.singleton 0 $ SelectionInfo ["No possible combinations"] 1 False white 0
|
|
| otherwise = cm'
|
|
sss =
|
|
SelectionSections
|
|
{ _sssSections = IM.fromDistinctAscList [(-1, filtsection), (0, combsection)]
|
|
, _sssExtra =
|
|
SSSExtra
|
|
{ _sssSelPos = selpos
|
|
, _sssFilters = IM.singleton (-1) Nothing
|
|
}
|
|
}
|
|
selpos
|
|
| null cm' = Nothing
|
|
| otherwise = Just (0, 0)
|
|
availablelines = getAvailableListLines secondColumnParams cfig
|
|
filtsection =
|
|
SelectionSection
|
|
{ _ssItems = IM.singleton 0 $ SelectionInfo ["No possible combinations"] 1 False white 0
|
|
, _ssCursor = Nothing
|
|
, _ssMinSize = 0
|
|
, _ssOffset = 0
|
|
, _ssShownItems = mempty
|
|
, _ssIndent = 0
|
|
, _ssDescriptor = "COMB FILTER"
|
|
}
|
|
combsection = updateSection cm (Just 0) availablelines combinationssection'
|
|
combinationssection' =
|
|
SelectionSection
|
|
{ _ssItems = cm
|
|
, _ssCursor = do
|
|
(_, si) <- IM.lookupMin cm
|
|
return $ SectionCursor 0 (length (_siPictures si)) (_siColor si)
|
|
, _ssMinSize = 5
|
|
, _ssOffset = 0
|
|
, _ssShownItems = mempty
|
|
, _ssIndent = 0
|
|
, _ssDescriptor = "COMBINATIONS"
|
|
}
|