-- {-# OPTIONS_GHC -fno-full-laziness #-} {-# LANGUAGE TupleSections #-} module Dodge.DisplayInventory ( toggleCombineInv, updateInventoryPositioning, updateCombinePositioning, ) where import Data.Monoid import qualified Data.List as List 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 (const 0) (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 = fold $ 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 displaySectionsSizes 0 = 10 displaySectionsSizes 3 = 10 displaySectionsSizes _ = 2 updateDisplaySections :: World -> Configuration -> IM.IntMap (SelectionSection ()) -> IM.IntMap (SelectionSection ()) updateDisplaySections w cfig = updateSectionsPositioning displaySectionsSizes 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 = fold $ 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" sectionsDesiredLines :: IM.IntMap (SelectionSection a) -> IM.IntMap Int sectionsDesiredLines = fmap $ alaf Sum foldMap _siHeight . _ssItems sectionsSizes :: Int -> -- total available lines (Int -> 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 IM.IntMap Int sectionsSizes x f is sss = doSectionSize extraavailable mintaken is sss mempty where mintaken = IM.mapWithKey (\k y -> min (f k) y) sss --mintaken = IM.mapWithKey (\k y -> f k) 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 minimum size Maybe (Int, Int) -> Int -> [(Int, IM.IntMap (SelectionItem a))] -> IM.IntMap (SelectionSection a) -> IM.IntMap (SelectionSection a) updateSectionsPositioning f mselpos allavailablelines lsss sss = IM.intersectionWith updateSection ls mss `h` ssizes `h` sss where mss = IM.mapWithKey m sss m k _ = do (k',i) <- mselpos guard $ k == k' return i ls = IM.fromList lsss h = IM.intersectionWith ($) g k x z = x lk = fromMaybe [] $ fmap ((:[]) . fst) mselpos ssizes = sectionsSizes allavailablelines displaySectionsSizes lk $ sectionsDesiredLines $ IM.intersectionWith (set ssItems) ls sss updateSectionsPositioning' :: (Int -> Int) -> -- for determining each sections minimum size Maybe (Int, Int) -> Int -> [(Int, IM.IntMap (SelectionItem a))] -> IM.IntMap (SelectionSection a) -> IM.IntMap (SelectionSection a) updateSectionsPositioning' f mselpos allavailablelines lsss sss = fromMaybe mempty $ do ((k, y) , xs) <- List.uncons lsss x <- sss ^? ix k let mscel = do (i, j) <- mselpos guard $ i == k return j let availablelines = allavailablelines - min (f k) (length $ _ssShownItems x) let previoussections = updateSectionsPositioning f mselpos availablelines xs sss -- let linestaken (k',ss') = max (length $ _ssShownItems ss') (f k') -- let linesleft = allavailablelines - sum (linestaken <$> IM.toList $ previoussections) let linestaken = length . _ssShownItems let linesleft = allavailablelines - sum (linestaken <$> previoussections) let ss = updateSection y mscel linesleft x return $ IM.insert k ss previoussections 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 } & 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)