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

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

import Control.Applicative
import Control.Lens
import Control.Monad
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.SelectionList
import Dodge.Data.Universe
import Dodge.Inventory
import Dodge.Inventory.SelectionList
import Dodge.Item.Display
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)
        (IM.fromDistinctAscList [(-1, sfclose),(0, sclose')])
  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 ^? cWorld . lWorld . creatures . ix 0 . crInv
    sclose'
        | null sclose =
            IM.singleton 0 $
                SelectionInfo ["No possible combinations"] 1 25 False white 0
        | otherwise = sclose

regexCombs :: IM.IntMap Item -> SelectionItem CombinableItem -> String -> Bool
regexCombs inv ci = \case
    '#' : str -> any (g str) (_ciInvIDs $ _siPayload ci)
    str -> (regexList str . _siPictures) ci
  where
    g str i = maybe False (regexList str . basicItemDisplay) (inv ^? ix i)

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)
        ( IM.fromDistinctAscList $
            zip
                [-1 .. 5]
                [ invhead
                , sinv
                , IM.singleton 0 
                    $ SelectionItem [displayFreeSlots (crNumFreeSlots cr)] 1 15 True invDimColor 2 ()
                , nearbyhead
                , sclose
                , interfaceshead
                , btitems
                ]
        )
  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
    closefiltcurs = mselpos ^? _Just . _1 == Just 2
    (sfclose, sclose) =
        filterSectionsPair closefiltcurs plainRegex closeitms "NEARBY ITEMS" $
            w ^? hud . hudElement . diCloseFilter . _Just
    nearbyhead 
        | null sfclose && not (null sclose) = makehead "NEARBY ITEMS"
        | otherwise = sfclose
    interfaceshead = if null btitems then mempty else makehead "NEARBY INTERFACES"
    btitems =
        IM.fromDistinctAscList . zip [0 ..] $
            mapMaybe (closeButtonToSelectionItem w) (w ^. hud . closeButtons)
    makehead str = IM.singleton 0 $ SelectionInfo [str] 1 15 False white 0
    invhead = if null sfinv then makehead "INVENTORY" else sfinv
    cr = you w
    closeitms =
        IM.fromDistinctAscList . zip [0 ..] $
            mapMaybe (closeItemToSelectionItem w) (w ^. hud . closeItems)
    invitems =
        IM.map
            (uncurry (invSelectionItem w))
            (invIndents $ _crInv cr)

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 ->
    IM.IntMap (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 = 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 $ take availablelines shownstrings
    oldoffsetbounded = max 0 . min oldoffset $ aslength - availablelines
    offset = fromMaybe oldoffsetbounded $ do
        csel <- mcsel
        maxcsel <- fst <$> IM.lookupMax sis
        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 white (text (replicate 15 (toEnum 30)))
        | otherwise = id
    tweaklast
        | aslength - offset > availablelines =
            ix (availablelines - 1)
                .~ color white (text . replicate 15 $ toEnum 31)
        | otherwise = id
    (allstrings, Sum aslength) = foldMap listSelectionColorPicture sis
    shownstrings = drop offset allstrings

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

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

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 = updateCombineSections w cfig mempty
            , _ciSelection = Just (0,0,mempty)
            , _ciFilter = Nothing
            }
        & hud . hudElement . diInvFilter .~ Nothing