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

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

import Data.IntSet (IntSet)
import Control.Applicative
import Control.Lens
import Control.Monad
import Data.Bifunctor
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.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

updateCombinePositioning :: Universe -> Universe
updateCombinePositioning u =
    u
        & uvWorld . hud . hudElement . subInventory . ciSections
            %~ updateCombineSections (_uvWorld u) (_uvConfig u)
        & uvWorld . hud . hudElement . subInventory %~ 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

checkInventorySelectionExists :: Universe -> Universe
checkInventorySelectionExists u =
    case u ^? uvWorld . hud . hudElement . diSections . ix i . ssItems . ix j of
        Nothing -> u & uvWorld %~ scrollAugNextInSection
        _ -> u
  where
    (i, j, _) =
        fromMaybe (1, -1, mempty) $
            u ^? uvWorld . hud . hudElement . diSelection . _Just

checkCombineSelectionExists :: SubInventory -> SubInventory
checkCombineSelectionExists u = fromMaybe u $ do
    sss <- u ^? ciSections
    (i, j, _) <- u ^? ciSelection . _Just <|> Just (0, 0, mempty)
    Just $ case u ^? ciSections . ix i . ssItems . ix j of
        Nothing ->
            u & ciSelection ?~ (0, -1, mempty)
                & ciSelection
                %~ scrollSelectionSections (-1) sss
        _ -> u

displaySectionsSizes :: Int -> Int
displaySectionsSizes 0 = 10
displaySectionsSizes 3 = 10
displaySectionsSizes _ = 3

displayIndents :: Int -> Int
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 invDP cfig)
        [ 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 15 False white 0)
    invhead = if null sfinv then makehead "INVENTORY" (-1) else filtinv
    youitems = IM.singleton 0 $ SelectionItem [thetext] 1 15 True invDimColor 2 ()
    thetext = displayFreeSlots (crNumFreeSlots cr)
    closeitms =
        IM.fromDistinctAscList . zip [0 ..] $
            mapMaybe (closeItemToSelectionItem w) (w ^. hud . closeItems)
    invitems =
        IM.map
            ( \(indent, x) ->
                invSelectionItem
                    indent
                    w
                    (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
                    (length (filtdescription ++ " FILTER/" ++ str ++ [filtcurs]))
                    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, IntSet) ->
    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
    lk = mselpos ^.. _Just . _1
    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 . tweaklast . map snd $
                take availablelines shownstrings
        , _ssIndent = indent
        }
  where
    oldoffsetbounded = max 0 . min oldoffset $ length allstrings - availablelines
    offset = fromMaybe oldoffsetbounded $ 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
            _ -> oldoffsetbounded
    tweakfirst
        | offset > 0 = ix 0 .~ color moreupcolor (text (replicate 15 (toEnum 30)))
        | otherwise = id
    moreupcolor = fromMaybe white $ allstrings ^? ix offset . _1
    tweaklast
        | length shownstrings > availablelines =
            ix (availablelines - 1)
                .~ color moredowncolor (text . replicate 15 $ toEnum 31)
        | otherwise = id
    moredowncolor = fromMaybe white $ allstrings ^? ix (offset + availablelines - 1) . _1
    allstrings = foldMap listSelectionColorPicture sis
    shownstrings = drop offset allstrings

listSelectionColorPicture :: SelectionItem a -> [(Color, Picture)]
listSelectionColorPicture si = g <$> _siPictures si
  where
    g str = (_siColor si, translate lindent 0 . color (_siColor si) $ text str)
    lindent = 100 * fromIntegral (_siOffX si)

regexList :: String -> [String] -> Bool
regexList x = any (List.isInfixOf x)

toggleCombineInv :: Universe -> Universe
toggleCombineInv uv =
    uv & case uv ^? uvWorld . hud . hudElement . subInventory of
        Just CombineInventory{} -> uvWorld . hud . hudElement . subInventory .~ NoSubInventory
        _ -> uvWorld %~ enterCombineInv (uv ^. uvConfig)

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 25 False white 0
        | otherwise = cm'
    selpos
        | null cm' = Nothing
        | otherwise = Just (0, 0, mempty)
    filtsection =
        SelectionSection
            { _ssItems = mempty
            , _ssOffset = 0
            , _ssShownItems = mempty
            , _ssIndent = 0
            }
    combsection =
        updateSection
            0
            (Just 0)
            cm
            availablelines
            0
    availablelines = getAvailableListLines secondColumnParams cfig