-- {-# OPTIONS_GHC -fno-full-laziness #-} --{-# LANGUAGE TupleSections #-} module Dodge.DisplayInventory ( toggleCombineInv, updateInventoryPositioning, updateCombinePositioning, ) where import Data.IntMap.Merge.Strict import Control.Applicative import Control.Lens import Control.Monad import Data.Bifunctor 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.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 qualified ListHelp as List import Picture.Base toggleCombineInv :: Universe -> Universe toggleCombineInv uv = uv & case uv ^? uvWorld . hud . hudElement . subInventory of Just CombineInventory{} -> uvWorld . hud . hudElement . subInventory .~ NoSubInventory _ -> 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 5) (const 0) (w ^? hud . hudElement . subInventory . ciSelection . _Just) (getAvailableListLines secondColumnParams cfig) [(0, sclose), (-1, sfclose)] where filtcurs = w ^? hud . hudElement . subInventory . ciSelection . _Just . _1 == Just (-1) (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) . 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 . 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 :: Int -> Int displaySectionsSizes 0 = 10 displaySectionsSizes 3 = 10 displaySectionsSizes _ = 3 displayIndents :: Int -> Int displayIndents (-3) = 2 displayIndents 0 = 2 displayIndents 3 = 2 displayIndents 5 = 2 displayIndents _ = 0 updateDisplaySections :: World -> Configuration -> IM.IntMap (SelectionSection ()) -> IM.IntMap (SelectionSection ()) updateDisplaySections w cfig = updateSectionsPositioning displaySectionsSizes displayIndents mselpos (getAvailableListLines (invDisplayParams w) cfig) [statushead,statusdisplay,invhead,invx,youx, nearbyhead, closex ,interfaceshead,interfaces] where mselpos = w ^? hud . hudElement . diSelection . _Just invfiltcurs = mselpos ^? _Just . _1 == Just (-1) (sfinv, sinv) = filterSectionsPair invfiltcurs plainRegex invitems "INVENTORY" $ w ^? hud . hudElement . diInvFilter . _Just (filtinv, invx) = ((-1, sfinv), (0, sinv)) closefiltcurs = mselpos ^? _Just . _1 == Just 2 (sfclose, sclose) = filterSectionsPair closefiltcurs plainRegex closeitms "NEARBY ITEMS" $ w ^? hud . hudElement . diCloseFilter . _Just (filtclose, closex) = ((2, sfclose), (3, sclose)) nearbyhead = if null sfclose then if null sclose then (2,mempty) else makehead "NEARBY ITEMS" 2 else filtclose youx = (1, youitems) interfaceshead = if null btitems then (4,mempty) else makehead "NEARBY INTERFACES" 4 interfaces = (5,btitems) btitems = IM.fromDistinctAscList . zip [0 ..] $ mapMaybe (closeButtonToSelectionItem w) (w ^. hud . closeButtons) makehead str i = (i,IM.singleton 0 $ SelectionInfo [str] 1 False white 0) statushead = (-4,IM.singleton 0 $ SelectionInfo ["STATUS"] 1 False white 0) statusdisplay = (-3,IM.singleton 0 $ SelectionInfo ["HEALTH: "++show (_crHP cr)] 1 False white 0) invhead = if null sfinv then makehead "INVENTORY" (-2) else filtinv youitems = IM.singleton 0 $ SelectionItem [thetext] 1 True invDimColor 2 () thetext = displayFreeSlots (crNumFreeSlots cr) closeitms = IM.fromDistinctAscList . zip [0 ..] $ mapMaybe (closeItemToSelectionItem w) (w ^. hud . closeItems) invitems = IM.mapWithKey (\k (indent, x) -> invSelectionItem indent cr k (x ^. locLDT . ldtValue)) (fmap (first removeindentiffiltering) . allInvLocs $ _crInv cr) removeindentiffiltering = if maybe False (not . null) (w ^? hud . hudElement . diInvFilter . _Just) then const 0 else id cr = you w 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 filtdescription mfilt = (filtsis, itms') where filtcurs = if infocus then cFilledRect else cWireRect filtsis = fold $ do str <- mfilt return $ IM.singleton 0 $ SelectionInfo [filtdescription ++ " FILTER/" ++ str ++ [filtcurs], 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 (IM.IntMap (SelectionItem a)) -> IM.IntMap Int sectionsDesiredLines = fmap $ alaf Sum foldMap _siHeight 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 (min . f) 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 (Int -> Int) -> -- for determining each sections indent Maybe (Int, Int) -> Int -> [(Int, IM.IntMap (SelectionItem a))] -> IM.IntMap (SelectionSection a) -> IM.IntMap (SelectionSection a) updateSectionsPositioning f 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 (k', i) <- mselpos guard $ k == k' return i ls = IM.fromList lsss -- defaults non-existing offsets to 0 g = merge (mapMissing (const ($ 0))) dropMissing (zipWithMatched (const ($))) lk = maybe [] ((: []) . fst) mselpos ssizes = sectionsSizes allavailablelines f lk $ sectionsDesiredLines ls updateSection :: Int -> Maybe Int -> IM.IntMap (SelectionItem a) -> Int -> Int -> SelectionSection a updateSection indent mcsel sis availablelines oldoffset = SelectionSection { _ssItems = sis , _ssOffset = offset , _ssShownItems = tweakfirst shownitems , _ssIndent = indent } where 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 (replicate 15 (toEnum 30))) : xs | otherwise = x : xs tweakfirst [] = [] moreupcolor = fromMaybe white $ allstrings ^? ix offset . _1 shownitems | length shownstrings > availablelines = map snd (take (availablelines - 1) shownstrings) ++ [color moredowncolor . text $ replicate 15 (toEnum 31)] | otherwise = map snd shownstrings moredowncolor = fromMaybe white $ allstrings ^? ix (offset + availablelines - 1) . _1 allstrings = listSelectionColorPicture sis shownstrings = drop offset allstrings 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 = IM.fromDistinctAscList [(-1, filtsection), (0, combsection)] , _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' selpos | null cm' = Nothing | otherwise = Just (0, 0) filtsection = SelectionSection { _ssItems = mempty , _ssOffset = 0 , _ssShownItems = mempty , _ssIndent = 0 } combsection = updateSection 0 (Just 0) cm availablelines 0 availablelines = getAvailableListLines secondColumnParams cfig regexList :: String -> [String] -> Bool regexList x = any (List.isInfixOf x)