-- {-# OPTIONS_GHC -fno-full-laziness #-} --{-# LANGUAGE TupleSections #-} {-# LANGUAGE LambdaCase #-} --{-# LANGUAGE BangPatterns #-} module Dodge.DisplayInventory ( updateInventoryPositioning, updateCombinePositioning, toggleCombineInv, ) where import Control.Applicative import Control.Lens import Control.Monad import Data.IntMap.Merge.Strict import qualified Data.IntMap.Strict as IM import Data.Maybe import Data.Monoid import Dodge.Base.You import Dodge.CharacterEnums import Dodge.Combine import Dodge.Data.Combine import Dodge.Data.Config import Dodge.Data.HUD import Dodge.Data.SelectionList import Dodge.Data.Universe import Dodge.Inventory import Dodge.Inventory.CheckSlots import Dodge.Inventory.SelectionList import Dodge.Item.Display import Dodge.Item.Grammar import Dodge.ListDisplayParams import Dodge.SelectionList import Dodge.SelectionSections import qualified ListHelp as List import NewInt import Picture.Base updateCombinePositioning :: Universe -> Universe updateCombinePositioning u = u & uvWorld . hud . subInventory . ciSections %~ updateCombineSections (_uvWorld u) (_uvConfig u) & uvWorld . hud . subInventory %~ checkCombineSelectionExists updateCombineSections :: World -> Config -> IM.IntMap (SelSection CombItem) -> IM.IntMap (SelSection CombItem) updateCombineSections w cfig = updateSectionsPositioning (const 0) (w ^? hud . subInventory . ciSelection . _Just) (getAvailableListLines secondColumnLDP cfig) (IM.fromDistinctAscList [(-1, sfclose), (0, sclose')]) where filtcurs = w ^? hud . subInventory . ciSelection . _Just . slSec == Just (-1) (sfclose, sclose) = filterSectionsPair filtcurs (flip . andOrRegex $ regexCombs invitms) (IM.fromDistinctAscList . zip [0 ..] $ combineList w) "POSSIBLE COMBINATIONS" $ w ^? hud . subInventory . ciFilter . _Just invitms = _unNIntMap $ fmap (\k -> w ^?! cWorld . lWorld . items . ix k) $ fold $ w ^? cWorld . lWorld . creatures . ix 0 . crInv sclose' | null sclose = IM.singleton 0 $ SelItem ["NONE"] 1 25 False white 2 Nothing DropShadowSI | otherwise = sclose regexCombs :: IM.IntMap Item -> SelectionItem CombItem -> String -> Bool regexCombs inv ci = \case '#' : str -> any (g str) (_ciInvIDs $ fromJust $ _siPayload ci) str -> (regexList str . _siPictures) ci where g str i = maybe False (regexList str . basicItemDisplay) (inv ^? ix i) andOrRegex :: (a -> String -> Bool) -> a -> String -> Bool andOrRegex f x = all (orRegex f x) . List.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 . diSections %~ updateDisplaySections (_uvWorld u) (_uvConfig u) & uvWorld %~ checkInventorySelectionExists checkInventorySelectionExists :: World -> World checkInventorySelectionExists w | isJust $ w ^? hud . diSections . ix i . ssItems . ix j = w | otherwise = scrollAugNextInSection w where Sel i j _ = fromMaybe (Sel 1 (-1) mempty) $ w ^? hud . diSelection . _Just checkCombineSelectionExists :: SubInventory -> SubInventory checkCombineSelectionExists si | Just sss <- si ^? ciSections , Sel i j _ <- fromMaybe (Sel 0 0 mempty) $ si ^? ciSelection . _Just , isNothing $ si ^? ciSections . ix i . ssItems . ix j = si & ciSelection ?~ Sel 0 (-1) mempty & ciSelection %~ scrollSelectionSections (-1) sss | otherwise = si displayIndents :: Int -> Int displayIndents 0 = 2 displayIndents 3 = 2 displayIndents 5 = 2 displayIndents _ = 0 updateDisplaySections :: World -> Config -> IMSS () -> IMSS () updateDisplaySections w cfig = updateSectionsPositioning displayIndents mselpos (getAvailableListLines invDP cfig) $ IM.fromDistinctAscList $ zip [-1 .. 5] [ sfinv , sinv , IM.singleton 0 $ SelItem [displayFreeSlots (crNumFreeSlots (w ^. cWorld . lWorld . items) cr)] 1 15 True invDimColor 2 Nothing DropShadowSI , sfclose1 , sclose , interfaceshead , btitems ] where mselpos = w ^? hud . diSelection . _Just invfiltcurs = mselpos ^? _Just . slSec == Just (-1) (sfinv, sinv) = filterSectionsPair invfiltcurs plainRegex invitems "INVENTORY" $ w ^? hud . diInvFilter . _Just closefiltcurs = mselpos ^? _Just . slSec == Just 2 sfclose1 | null sclose && sfclose ^? ix 0 . siIsSelectable == Just False = mempty | otherwise = sfclose (sfclose, sclose) = filterSectionsPair closefiltcurs plainRegex closeitms "NEARBY ITEMS" $ w ^? hud . diCloseFilter . _Just interfaceshead = if null btitems then mempty else makehead "NEARBY INTERFACES" btitems = IM.fromDistinctAscList . zip [0 ..] $ mapMaybe (closeButtonToSelectionItem w) (w ^. hud . closeButtons) makehead str = IM.singleton 0 $ SelItem [str] 1 15 False white 0 Nothing InventoryHeadSI cr = you w closeitms = IM.fromDistinctAscList . zip [0 ..] $ mapMaybe (closeItemToSelectionItem w . _unNInt) (w ^. hud . closeItems) invitems = IM.map (uncurry (invSelectionItem w)) (invIndents $ (\k -> w ^?! cWorld . lWorld . items . ix k) <$> _crInv cr) filterSectionsPair :: Bool -> -- check for whether filter is in focus, changes string at the end (String -> SelectionItem a -> Bool) -> IM.IntMap (SelectionItem a) -> String -> Maybe String -> (IM.IntMap (SelectionItem a), IM.IntMap (SelectionItem a)) filterSectionsPair infocus filtfn itms s mfilt = (x, itms') where filtcurs = if infocus then cFilledRect else cWireRect x = IM.singleton 0 $ fromMaybe (SelItem [s] 1 (length s) False white 0 Nothing InventoryHeadSI) $ do str <- mfilt return $ SelItem [s ++ " FILTER/" ++ str ++ [filtcurs], numfiltitems] 2 (length (s ++ " FILTER/" ++ str ++ [filtcurs])) True white 0 Nothing InventoryHeadFilterSI f y = y -- | null y = -- IM.singleton 0 $ SelItem ["(NONE)"] 1 (length s) True (greyN 0.5) 0 Nothing -- | otherwise = y itms' = f $ maybe id (IM.filter . filtfn) mfilt 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" sectionsDesiredLines :: IM.IntMap (IM.IntMap (SelectionItem a)) -> IM.IntMap Int sectionsDesiredLines = fmap $ alaf Sum foldMap _siHeight sectionsSizes :: Int -> -- total available lines [Int] -> -- ordering in which to consider sections (others to be done lowest to highest) IM.IntMap Int -> -- desired lines IM.IntMap Int sectionsSizes x is sss = doSectionSize extraavailable mintaken is sss mempty where mintaken = IM.mapWithKey (min . const 10) sss extraavailable = x - sum mintaken doSectionSize :: Int -> -- extra available lines IM.IntMap Int -> -- minimum line bounds for each section [Int] -> -- ordering in which to consider sections (others to be done lowest to highest) IM.IntMap Int -> -- desired lines in sections not yet considered IM.IntMap Int -> -- sections already sized IM.IntMap Int doSectionSize extraavailable mintaken is sss done = fromMaybe done $ do (v, others, k, ks) <- getsecusingis <|> getminsec minv <- mintaken ^? ix k let extradesired = v - minv linesgiven = min extraavailable extradesired return $ doSectionSize (extraavailable - linesgiven) mintaken ks others $ done & at k ?~ linesgiven + minv where getsecusingis = do (k, ks) <- List.uncons is let (my, s') = IM.updateLookupWithKey (\_ _ -> Nothing) k sss y <- my return (y, s', k, ks) getminsec = do ((k, v), s') <- IM.minViewWithKey sss return (v, s', k, []) updateSectionsPositioning :: (Int -> Int) -> -- for determining each sections indent Maybe Selection -> Int -> IM.IntMap (IM.IntMap (SelectionItem a)) -> IM.IntMap (SelSection a) -> IM.IntMap (SelSection a) updateSectionsPositioning h mselpos allavailablelines lsss sss = IM.intersectionWithKey (\k -> updateSection (h k) (m k)) ls ssizes `g` offsets where offsets = fmap _ssOffset sss m k = do Sel k' i _ <- mselpos guard $ k == k' return i ls = lsss -- defaults non-existing offsets to 0 g = merge (mapMissing (const ($ 0))) dropMissing (zipWithMatched (const ($))) lk = mselpos ^.. _Just . slSec ssizes = sectionsSizes allavailablelines lk $ sectionsDesiredLines ls updateSection :: Int -> Maybe Int -> IMSI a -> Int -> Int -> SelSection a updateSection indent mcsel sis availablelines oldoffset = SelSection { _ssItems = sis , _ssOffset = offset , _ssShownItems = shownitems , _ssShownLength = min aslength availablelines , _ssIndent = indent } where shownitems = tweakfirst . tweaklast $ take availablelines shownstrings oldoffsetbounded = max 0 . min oldoffset $ aslength - availablelines offset = fromMaybe oldoffsetbounded $ do csel <- mcsel maxcsel <- fst <$> IM.lookupMax sis xselsize <- sis ^? ix csel . siHeight return $ case sum $ fmap _siHeight . fst . IM.split csel $ sis of pos | pos == 0 || aslength <= availablelines -> 0 pos | pos - 1 < oldoffset -> pos - 1 pos | maxcsel == csel -> pos - availablelines + xselsize pos | pos + 1 + xselsize - availablelines > oldoffset -> pos - availablelines + 1 + xselsize _ | aslength - availablelines < oldoffset -> aslength - availablelines _ -> oldoffsetbounded tweakfirst | offset > 0 = ix 0 .~ color white (text (replicate 15 (toEnum 30))) | otherwise = id tweaklast | aslength - offset > availablelines = ix (availablelines - 1) .~ color white (text . replicate 15 $ toEnum 31) | otherwise = id (allstrings, Sum aslength) = foldMap listSelectionColorPicture sis shownstrings = drop offset allstrings listSelectionColorPicture :: SelectionItem a -> ([Picture], Sum Int) listSelectionColorPicture si = (g <$> _siPictures si, Sum $ _siHeight si) where g = translate lindent 0 . case si ^. siDisplayMod of NoSIDisplayMod -> docolor . text HighlightSI -> docolor . hackBoldText DropShadowSI -> hackDropShadow (si ^. siColor) black InventoryHeadSI -> hackInvertText black white . dopad InventoryHeadFilterSI -> docolor . text dopad s = " "<>s<>" " docolor = color (si ^. siColor) lindent = 100 * fromIntegral (_siOffX si) regexList :: String -> [String] -> Bool regexList = any . List.isInfixOf toggleCombineInv :: Universe -> Universe toggleCombineInv uv = uv & case uv ^? uvWorld . hud . subInventory of Just CombineInventory{} -> uvWorld . hud . subInventory .~ NoSubInventory _ -> uvWorld %~ enterCombineInv (uv ^. uvConfig) enterCombineInv :: Config -> World -> World enterCombineInv cfig w = w & hud . subInventory .~ CombineInventory { _ciSections = updateCombineSections w cfig mempty , _ciSelection = Just (Sel 0 0 mempty) , _ciFilter = Nothing } & hud . diInvFilter .~ Nothing