loop/src/Dodge/DisplayInventory.hs

--{-# LANGUAGE TupleSections #-}

--{-# OPTIONS_GHC -fno-full-laziness #-}

module Dodge.DisplayInventory (
    toggleCombineInv,
    updateInventorySectionItems,
    updateInventoryPositioning,
    updateCombinePositioning,
) where

import Control.Monad
import qualified Data.IntMap.Strict as IM
import qualified Data.IntMap.Merge.Strict as MIM
import Data.Maybe
import Dodge.Base.You
import Dodge.Combine
import Dodge.Data.Combine
import Dodge.Data.Config
import Dodge.Data.SelectionList
import Dodge.Data.Universe
import Dodge.Inventory.CheckSlots
import Dodge.Inventory.SelectionList
import Dodge.ListDisplayParams
import Dodge.SelectionList
import Dodge.Item.Grammar
import LensHelp
import ListHelp
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' = MIM.merge MIM.dropMissing MIM.dropMissing (MIM.zipWithMatched $ const addindent) indents $ IM.mapWithKey (invSelectionItem cr) inv
    addindent x y = y & siPictures %~ map (x ++)
    cr = you w
    inv = _crInv (you w)
    indents = indentInv inv
    --inv = indentInv $ _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"

invDimColor :: Color
invDimColor = greyN 0.7

-- 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 _siHeight . 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)
        --        -- a| offset > 0 = xtra "<<<" : map h xs
        | offset > 0 =
            translate 0 (-100) (color moreupcolor $ text (theindent ++ replicate 15 '^')) :
            map h xs
        | otherwise = map h (x : xs)
    tweakfirst [] = []
    moreupcolor = fromMaybe white $ allstrings ^? ix offset . _1
    shownitems
        | length shownstrings > availablelines =
            tweakfirst (take (availablelines - 1) shownstrings)
                -- ++ [xtra ">>>"]
                ++ [translate 0 100 . color moredowncolor . textVMirror $ theindent ++ replicate 15 '^']
        | otherwise = tweakfirst shownstrings
    moredowncolor = fromMaybe white $ allstrings ^? ix (offset + availablelines - 1) . _1
    allstrings :: [(Color, Picture)]
--    allstrings = IM.elems $ overlapSelectionItems $ IM.elems sis
    allstrings = listSelectionColorPicture sis
    shownstrings = drop offset allstrings
    h (_, str) = translate (fromIntegral (_ssIndent ss) * 100) 0 str
    theindent = replicate (_ssIndent ss) ' '
    --xtra str = color white . text $ theindent ++ str ++ " MORE " ++ _ssDescriptor ss

listSelectionColorPicture :: Foldable t => t (SelectionItem a) -> [(Color,Picture)]
listSelectionColorPicture  = foldMap f
  where
    f si = map g (_siPictures si)
      where 
        g str = (_siColor si,color (_siColor si) $ text str)

--overlapSelectionItems :: [SelectionItem a] -> IM.IntMap (Color, Picture)
--overlapSelectionItems = go 0
--  where
--    go _ [] = mempty
--    go i (si : xs) = doinsert $ go (i + _siHeight si) xs
--      where
--        thecol = _siColor si
--        doinsert m =
--            ifoldr
--                (\j str -> IM.insertWith ihelp (i + j) (thecol,color thecol (text str)))
--                m
--                (_siPictures si)
--        ihelp (_,x) (col,y) = ( col, x<>y)

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 (_siHeight si) (_siColor si)
            , _ssMinSize = 5
            , _ssOffset = 0
            , _ssShownItems = mempty
            , _ssIndent = 0
            , _ssDescriptor = "COMBINATIONS"
            }