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

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

import StrictHelp
import Dodge.Item.Display
import qualified Data.Strict.Tuple as STup
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.IntSet (IntSet)
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 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
    invitms = fold $ w ^? cWorld . lWorld . creatures . ix 0 .  crInv

--regexCombs :: IM.IntMap (SelectionItem ()) -> SelectionItem CombinableItem -> String -> Bool
regexCombs :: IM.IntMap Item -> SelectionItem CombinableItem -> String -> Bool
regexCombs inv ci = \case
    '<' : str -> f str
    str -> (regexList str . _siPictures) ci
  where
    f str = any (g str) (_ciInvIDs $ _siPayload ci)
    g str i = fromMaybe False $ do
        si <- inv ^? ix i
        return $ regexList str $ basicItemDisplay si
        --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)
        & uvWorld
        %~ checkInventorySelectionExists

checkInventorySelectionExists :: World -> World
checkInventorySelectionExists w
    | isJust $ w ^? hud . hudElement . diSections . ix i . ssItems . ix j = w
    | otherwise = scrollAugNextInSection w
  where
    (i, j, _) = fromMaybe (1, -1, mempty) $ w ^? hud . hudElement . diSelection . _Just

checkCombineSelectionExists :: SubInventory -> SubInventory
checkCombineSelectionExists si
    | Just sss <- si ^? ciSections
      , Just (i, j, _) <- si ^? ciSelection . _Just <|> Just (0, 0, mempty)
      , isNothing $ si ^? ciSections . ix i . ssItems . ix j =
        si & ciSelection ?~ (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 ->
    Configuration ->
    IM.IntMap (SelectionSection ()) ->
    IM.IntMap (SelectionSection ())
updateDisplaySections w cfig =
    updateSectionsPositioning
        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' = 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 (Int, Int, IntSet) ->
    Int ->
    [(Int, IM.IntMap (SelectionItem a))] ->
    IM.IntMap (SelectionSection a) ->
    IM.IntMap (SelectionSection 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
        (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 = mselpos ^.. _Just . _1
    ssizes = sectionsSizes allavailablelines 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 = shownitems
        , _ssShownLength = min aslength availablelines
        , _ssIndent = indent
        }
  where
    shownitems = 
            tweakfirst . tweaklast . map (^. _2) $
                take availablelines shownstrings
    oldoffsetbounded = max 0 . min oldoffset $ aslength - availablelines
    offset = fromMaybe oldoffsetbounded $ do
        csel <- mcsel
        maxcsel <- fst <$> IM.lookupMax sis
--        xselsize <- fmap length $ sis ^? ix csel . siPictures
        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 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,Sum aslength) = foldMap listSelectionColorPicture sis
    shownstrings = drop offset allstrings

listSelectionColorPicture :: SelectionItem a -> ([STup.Pair Color Picture], Sum Int)
listSelectionColorPicture si = (g <$> _siPictures si, Sum $ _siHeight si)
  where
    g !str = 
        _siColor si STup.:!: 
        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
            , _ssShownLength = 0
            , _ssIndent = 0
            }
    combsection =
        updateSection
            0
            (Just 0)
            cm
            availablelines
            0
    availablelines = getAvailableListLines secondColumnParams cfig