-- {-# OPTIONS_GHC -fno-full-laziness #-} module Dodge.DisplayInventory ( toggleCombineInv, updateInventoryPositioning, updateCombinePositioning, ) where import Dodge.CharacterEnums import Control.Applicative import Control.Lens import Control.Monad import Data.Bifunctor import qualified Data.IntMap.Strict as IM import Data.Maybe import Dodge.Base.You import Dodge.Combine import Dodge.Data.Combine import Dodge.Data.Config import Dodge.Data.DoubleTree import Dodge.Data.SelectionList import Dodge.Data.Universe import Dodge.Inventory import Dodge.Inventory.SelectionList import Dodge.Item.Grammar import Dodge.ListDisplayParams import Dodge.SelectionList import Dodge.SelectionSections import ListHelp import Picture.Base toggleCombineInv :: Universe -> Universe toggleCombineInv uv = case uv ^? uvWorld . hud . hudElement . subInventory of Just CombineInventory{} -> uv & uvWorld . hud . hudElement . subInventory .~ NoSubInventory MouseInvNothing _ -> uv & uvWorld %~ enterCombineInv (uv ^. uvConfig) updateCombinePositioning :: Universe -> Universe updateCombinePositioning u = u & uvWorld . hud . hudElement . subInventory . ciSections %~ updateCombineSections (_uvWorld u) (_uvConfig u) & checkCombineSelectionExists updateCombineSections :: World -> Configuration -> IM.IntMap (SelectionSection CombinableItem) -> IM.IntMap (SelectionSection CombinableItem) updateCombineSections w cfig = updateSectionsPositioning (w ^? hud . hudElement . subInventory . ciSelection . _Just) (getAvailableListLines secondColumnParams cfig) [(0, sclose), (-1, sfclose)] where filtcurs = case w ^? hud . hudElement . subInventory . ciSelection . _Just . _1 of Just (-1) -> [cFilledRect] _ -> [cWireRect] (sfclose, sclose) = filterSectionsPair filtcurs (flip . andOrRegex $ regexCombs invitms) (IM.fromDistinctAscList . zip [0 ..] $ combineList w) "COMBINATIONS" $ w ^? hud . hudElement . subInventory . ciFilter . _Just invitms = fromMaybe mempty $ w ^? hud . hudElement . diSections . ix 0 . ssItems 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 = all (orRegex f x) . wordsBy '&' 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) & checkInventorySelectionExists -- this is possibly not completely correct checkInventorySelectionExists :: Universe -> Universe checkInventorySelectionExists u = fromMaybe u $ do (i, j) <- (u ^? uvWorld . hud . hudElement . diSelection . _Just) <|> Just (0, -1) Just $ case u ^? uvWorld . hud . hudElement . diSections . ix i . ssItems . ix j of Nothing -> u & uvWorld %~ scrollAugNextInSection _ -> u checkCombineSelectionExists :: Universe -> Universe checkCombineSelectionExists u = fromMaybe u $ do sss <- u ^? uvWorld . hud . hudElement . subInventory . ciSections (i, j) <- u ^? uvWorld . hud . hudElement . subInventory . ciSelection . _Just <|> Just (0, 0) Just $ case u ^? uvWorld . hud . hudElement . subInventory . ciSections . ix i . ssItems . ix j of Nothing -> u & uvWorld . hud . hudElement . subInventory . ciSelection ?~ (0,-1) & uvWorld . hud . hudElement . subInventory . ciSelection %~ scrollSelectionSections (-1) sss _ -> u updateDisplaySections :: World -> Configuration -> IM.IntMap (SelectionSection ()) -> IM.IntMap (SelectionSection ()) updateDisplaySections w cfig = updateSectionsPositioning mselpos (getAvailableListLines (invDisplayParams w) cfig) addorder where mselpos = w ^? hud . hudElement . diSelection . _Just 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] Just (3, _) -> reverse [filtinv, filtclose, closex, invx, youx] _ -> reverse [filtinv, filtclose, invx, closex, youx] invfiltcurs = case mselpos ^? _Just . _1 of Just (-1) -> [toEnum 219] -- filled rect _ -> [toEnum 128] -- wire rect (sfinv, sinv) = filterSectionsPair invfiltcurs plainRegex invitems "INVENTORY" $ w ^? hud . hudElement . diInvFilter . _Just (filtinv, invx) = ((-1, sfinv), (0, sinv)) closefiltcurs = case mselpos ^? _Just . _1 of Just (2) -> [toEnum 219] -- filled rect _ -> [toEnum 128] -- wire rect (sfclose, sclose) = filterSectionsPair closefiltcurs plainRegex closeitms "NEARBY" $ w ^? hud . hudElement . diCloseFilter . _Just (filtclose, closex) = ((2, sfclose), (3, sclose)) youx = (1, youitems) youitems = IM.singleton 0 $ SelectionItem [thetext] 1 True invDimColor 2 () thetext = displayFreeSlots (crNumFreeSlots cr) closeitms = IM.fromDistinctAscList . zip [0 ..] $ map closeObjectToSelectionItem (w ^. hud . closeObjects) invitems = IM.mapWithKey (\k (indent, x) -> invSelectionItem indent cr k (x ^. locLDT . ldtValue)) (fmap (first removeindentiffiltering) . allInvLocs $ _crInv cr) -- this clearly deserves refactoring, also check if drawInventory/iextra -- needs it at the same time removeindentiffiltering = if maybe False isFilteringInv (w ^? hud . hudElement . diSections) then const 0 else id cr = you w filterSectionsPair :: String -> -- string at the end of the input (String -> SelectionItem a -> Bool) -> IM.IntMap (SelectionItem a) -> String -> Maybe String -> (IM.IntMap (SelectionItem a), IM.IntMap (SelectionItem a)) filterSectionsPair endstr filtfn itms filtdescription mfilt = ( filtsis , itms' ) where filtsis = fromMaybe mempty $ do str <- mfilt return $ IM.singleton 0 $ SelectionInfo [filtdescription ++ " FILTER/" ++ str ++ endstr, numfiltitems] 2 True white 0 itms' = fromMaybe itms $ do str <- mfilt return $ IM.filter (filtfn str) itms numfiltitems = " " ++ show (length itms - length itms') ++ " FILTERED" invDimColor :: Color invDimColor = greyN 0.7 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 & ssOffset .~ offset & ssShownItems .~ tweakfirst shownitems where oldoffset = ss ^. ssOffset 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 = color moreupcolor (text (theindent ++ replicate 15 (toEnum 30))) : xs | otherwise = x : xs tweakfirst [] = [] moreupcolor = fromMaybe white $ allstrings ^? ix offset . _1 shownitems | length shownstrings > availablelines = map h (take (availablelines - 1) shownstrings) ++ [color moredowncolor . text $ theindent ++ replicate 15 (toEnum 31)] | otherwise = map h shownstrings moredowncolor = fromMaybe white $ allstrings ^? ix (offset + availablelines - 1) . _1 allstrings = listSelectionColorPicture sis shownstrings = drop offset allstrings h (_, str) = translate (fromIntegral (_ssIndent ss) * 100) 0 str theindent = replicate (_ssIndent ss) ' ' listSelectionColorPicture :: Foldable t => t (SelectionItem a) -> [(Color, Picture)] listSelectionColorPicture = foldMap f where f si = map g (_siPictures si) where indent = 100 * fromIntegral (_siOffX si) g str = (_siColor si, translate indent 0 . color (_siColor si) $ text str) enterCombineInv :: Configuration -> World -> World enterCombineInv cfig w = w & hud . hudElement . subInventory .~ CombineInventory { _ciSections = sss , _ciSelection = selpos , _ciFilter = Nothing , _ciMouseOver = Nothing } & hud . hudElement . diInvFilter .~ Nothing where cm' = IM.fromDistinctAscList . zip [0 ..] $ combineList w cm | null cm' = IM.singleton 0 $ SelectionInfo ["No possible combinations"] 1 False white 0 | otherwise = cm' sss = IM.fromDistinctAscList [(-1, filtsection), (0, combsection)] selpos | null cm' = Nothing | otherwise = Just (0, 0) availablelines = getAvailableListLines secondColumnParams cfig filtsection = SelectionSection { _ssItems = mempty , _ssMinSize = 0 , _ssOffset = 0 , _ssShownItems = mempty , _ssIndent = 0 , _ssDescriptor = "COMB FILTER" } combsection = updateSection cm (Just 0) availablelines SelectionSection { _ssItems = cm , _ssMinSize = 5 , _ssOffset = 0 , _ssShownItems = mempty , _ssIndent = 0 , _ssDescriptor = "COMBINATIONS" } regexList :: String -> [String] -> Bool regexList x = any (isInfixOf x)