--{-# LANGUAGE TupleSections #-}

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

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

import Dodge.Data.DoubleTree
import Control.Lens
import Dodge.Inventory.SelectionList
import Control.Monad
import qualified Data.IntMap.Strict as IM
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.ListDisplayParams
import Dodge.SelectionList
import Dodge.Item.Grammar
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' = IM.mapWithKey (\k (y,x) -> invSelectionItem cr k (x ^. locLDT . ldtValue) y) 
        invlocs
    cr = you w
    invlocs = allInvLocs $ _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

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)
        | 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)
                ++ [translate 0 100 . color moredowncolor . textVMirror $ theindent ++ replicate 15 '^']
        | otherwise = tweakfirst shownstrings
    moredowncolor = fromMaybe white $ allstrings ^? ix (offset + availablelines - 1) . _1
    allstrings = listSelectionColorPicture sis
    shownstrings = drop offset allstrings
    h (_, str) = translate (fromIntegral (_ssIndent ss) * 100) 0 str
    theindent = replicate (_ssIndent ss) ' '

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 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"
            }