{-# LANGUAGE TupleSections #-} --{-# OPTIONS_GHC -fno-full-laziness #-} 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" }