loop/src/Dodge/DisplayInventory.hs

{-# LANGUAGE TupleSections #-}
module Dodge.DisplayInventory 
    ( updateDisplayInventory
    , defaultDisplaySections
    ) where

import Regex
import Data.Maybe
import Picture.Base
import Dodge.Render.HUD
import Dodge.SelectionList
import LensHelp
import Dodge.Inventory.CheckSlots
import Dodge.Inventory.Color
import Dodge.Base.You
import Dodge.Inventory.SelectionList
import qualified Data.IntMap.Strict as IM
import Dodge.Data.Config
import Dodge.Default.World
import Dodge.Data.SelectionList
import Dodge.Data.World

updateDisplayInventory :: World -> Configuration -> SelectionSections () -> SelectionSections ()
updateDisplayInventory w cfig sss = case cr ^? crManipulation . manObject of
    Just (InInventory SortInventory) -> sss
    Just (InInventory (SelItem i _)) -> sss
        { _sssSections = updateSections availablelines (0,i) [invx ,youx, closex]
        , _sssSelPos = Just 0
        }
    Just SelNothing -> sss
        { _sssSections = updateSections availablelines (1,0) [invx ,youx, closex]
        , _sssSelPos = Just 1
        }
    Just (SelCloseObject i) -> sss
        { _sssSections =  updateSections availablelines (2,i) [closex, invx ,youx]
        , _sssSelPos = Just 2
        }
    _ -> error "error when getting cr inv sel"
  where
    filtinv = (-1,(filtinvsec,filtinvitems))
    filtinvsec = undefined
    filtinvitems = undefined
    invx = (0,(invsec, invitems))
    youx = (1,(yousec, youitems))
    closex = (2,(cosec, coitems))
    youitems = IM.singleton 0 $ SelectionItem [thetext] 1 True invDimColor 2 ()
    thetext = displayFreeSlots nfreeslots
    availablelines = getAvailableListLines (invDisplayParams w) cfig
    cosec = fromMaybe defaultCOSection $ sss ^? sssSections . ix 2
    invsec = fromMaybe defaultInvSection $ sss ^? sssSections . ix 0
    coitems = IM.fromDistinctAscList . zip [0..] 
        $ map (closeObjectToSelectionItem nfreeslots) (w ^. hud . closeObjects)
    invitems = IM.mapWithKey (invSelectionItem' cr) inv
    cr = you w
    inv = _crInv (you w)
    nfreeslots = crNumFreeSlots cr

displayFreeSlots :: Int -> String
displayFreeSlots x = case x of
    0 -> "  INVENTORY FULL"
    1 -> "  +1 FREE SLOT"
    _ -> "  +" ++ show x ++ " FREE SLOTS"

updateSections :: Int -> (Int, Int) -> [(Int,(SelectionSection a,IM.IntMap (SelectionItem a)))]
    -> IM.IntMap (SelectionSection a)
updateSections _ _ [] = mempty
updateSections allavailablelines (i,j) ((k,(x,y)):xs) = IM.insert k ss
    $ updateSections (allavailablelines - length (_ssShownItems ss)) (i,j) xs
  where
    ss  | i == k = updateSection (Just j) y availablelines x
        | otherwise = updateSection Nothing y availablelines x
    availablelines = allavailablelines - sum (map (_ssMinSize . fst . snd) xs)

defaultSS :: SelectionSection ()
defaultSS = SelectionSection 
    { _ssItems = mempty 
    , _ssCursor = Nothing 
    , _ssRegex = EmptyRegex
    , _ssMinSize = 5 
    , _ssOffset = 0 
    , _ssShownItems = [] 
    , _ssIndent = 0 
    , _ssDescriptor = ""
    }


defaultCOSection :: SelectionSection ()
defaultCOSection = defaultSS 
    & ssIndent .~ 2 
    & ssDescriptor .~ "CLOSE OBJECTS"

defaultInvSection :: SelectionSection ()
defaultInvSection = defaultSS
    & ssDescriptor .~ "INVENTORY ITEMS"

updateSection 
    :: Maybe Int
    -> IM.IntMap (SelectionItem a) 
    -> Int 
    -> SelectionSection a
    -> SelectionSection a
updateSection mspos sis' availablelines ss = ss
    { _ssItems = sis
    , _ssCursor = scurs
    , _ssOffset = offset
    , _ssMinSize = 5
    , _ssShownItems = shownitems
    }
  where
    sis = case _ssRegex ss of
        Regex str -> IM.insert (-1) (f str) $ IM.filter (regexList str . _siPictures) sis'
        _ -> sis'
    f str = SelectionRegex
        { _siPictures = ["FILTER: " ++ str]
        , _siHeight = 1
        , _siIsSelectable = True
        , _siColor = white
        , _siOffX = 0
        }
    oldoffset = ss ^. ssOffset
    scurs = do
        csel <- mspos
        si <- sis ^? ix csel
        let cpos = sum (fmap (length . _siPictures) . fst . IM.split csel $ sis)
            csize = length $ _siPictures si
            ccolor = _siColor si
        return $ SectionCursor csel (cpos - offset) csize ccolor
    mcpos = do
        csel <- mspos
        return . sum $ fmap (length . _siPictures) . fst . IM.split csel $ sis
    xselsize = fromMaybe 1 selsize
    offset = maybe 0 offset' mcpos
    offset' jselpos
        | jselpos == 0 || not mustrestrict = 0
        | jselpos - 1 < oldoffset = jselpos - 1
        | islastitm = jselpos - availablelines + xselsize
        | jselpos + 1 + xselsize - availablelines > oldoffset = jselpos - availablelines + 1 + xselsize
        | length allstrings - oldoffset < availablelines = length allstrings - availablelines
        | otherwise = oldoffset
    tweakfirst (x:xs)
        | offset > 0 = hup : map h xs
        | otherwise = map h (x:xs)
    tweakfirst [] =  []
    shownitems
        | length shownstrings > availablelines
            = tweakfirst (take (availablelines - 1) shownstrings) 
                ++ [hdown]
        | otherwise = tweakfirst shownstrings
    allstrings :: [(Color,String)]
    allstrings = foldMap g sis
    mustrestrict = length allstrings > availablelines
    shownstrings = drop offset allstrings
    h (col,str) = color col . text $ str
    theindent = replicate (_ssIndent ss) ' '
    hdown = color white . text $ theindent ++ ">>> MORE " ++ _ssDescriptor ss
    hup = color white . text $ theindent ++ "<<< MORE " ++ _ssDescriptor ss
    g si = map (_siColor si ,) $ _siPictures si
    islastitm = fromMaybe False $ do
        i <- mspos
        k <- fst <$> IM.lookupMax sis
        return $ k == i
    selsize = do
        i <- mspos
        si <- sis ^? ix i
        return . length $ _siPictures si

yousec :: SelectionSection ()
yousec = defaultSS
    & ssCursor ?~ SectionCursor 0 0 1 invDimColor
    & ssRegex .~ UnavailableRegex
    & ssIndent .~ 2
    & ssMinSize .~ 1
    & ssDescriptor .~ "YOUR STATUS"