{-# LANGUAGE LambdaCase #-}

module Dodge.Render.HUD (
    drawHUD,
    selNumPos, -- this shoud probably be pushed back here
) where

import Dodge.SelectionSections
import Control.Lens
import Control.Monad
import qualified Data.Map.Strict as M
import Data.Maybe
import qualified Data.Vector as V
import Dodge.Base
import Dodge.Clock
import Dodge.Creature.Info
import Dodge.Data.CardinalPoint
import Dodge.Data.Combine
import Dodge.Data.Config
import Dodge.Data.SelectionList
import Dodge.Data.World
import Dodge.Default.SelectionList
import Dodge.Equipment.Text
import Dodge.Inventory
import Dodge.Item.Display
import Dodge.Item.Grammar
import Dodge.Item.Info
import Dodge.ListDisplayParams
import Dodge.Render.Connectors
import Dodge.Render.HUD.Carte
import Dodge.Render.List
import Dodge.ScreenPos
import Dodge.SelectionSections
import Dodge.SelectionSections.Draw
import Geometry
import qualified IntMapHelp as IM
import Justify
--import ListHelp
--import Padding
import Picture
import SDL (MouseButton (..))

drawHUD :: Configuration -> World -> Picture
drawHUD cfig w = case w ^. hud . hudElement of
    DisplayCarte -> drawCarte cfig w
    DisplayInventory{_diSections = sections, _subInventory = subinv} ->
        drawHP cfig w
            <> drawInventory sections w cfig
            <> drawSubInventory subinv cfig w

drawHP :: Configuration -> World -> Picture
drawHP cfig =
    dShadCol white
        . translate (halfWidth cfig) (halfHeight cfig - 40)
        . scale 0.2 0.2
        . textRight
        . show
        . (^?! cWorld . lWorld . creatures . ix 0 . crHP)

drawInventory :: SelectionSections () -> World -> Configuration -> Picture
drawInventory sss w cfig =
    drawSelectionSections sss ldp cfig
        <> iextra
        <> translateScreenPos cfig (ldp ^. ldpPos)
            (drawDIMouseOver w)
        <> drawDISelections w cfig
  where
    ldp = invDisplayParams w
    iextra = fromMaybe mempty $ do
        inv <- w ^? cWorld . lWorld . creatures . ix 0 . crInv
        let x = case invAdj inv of
                Left str -> error $ "drawInventory: " ++ str
                Right y -> y
        return $ inventoryExtra sss cfig w x

drawDIMouseOver :: World -> Picture
drawDIMouseOver w = fromMaybe mempty $ do
    (_,i) <- w ^? hud . hudElement . subInventory . nsMouseOver . _Just
    sss <- w ^? hud . hudElement . diSections
    let idp = invDisplayParams w
    return . color (withAlpha 0.5 white) $ selSecDrawCursorAt (0,i) 10 idp sss

drawDISelections :: World -> Configuration -> Picture
drawDISelections w cfig = fromMaybe mempty $ do
    (i,j) <- w ^? hud . hudElement . subInventory . nsSelected . _Just
    sss <- w ^? hud . hudElement . diSections
    let idp = invDisplayParams w
    tp <- selNumPos cfig idp sss 0 i
    bp <- selNumPos cfig idp sss 0 j
    return . color red $ line [tp,bp]


drawSubInventory :: SubInventory -> Configuration -> World -> Picture
drawSubInventory subinv cfig w = case subinv of
    LockedInventory -> mempty -- topInvCursor col cursPos cfig w
    NoSubInventory{} -> drawRBOptions cfig w
    ExamineInventory -> drawExamineInventory cfig w
    DisplayTerminal tid -> displayTerminal tid cfig (w ^. cWorld . lWorld)
    CombineInventory{_ciSections = sss} -> drawCombineInventory cfig sss w

drawCombineInventory :: Configuration -> SelectionSections CombinableItem -> World -> Picture
drawCombineInventory cfig sss w =
    invHead cfig "COMBINE"
        <> drawSelectionSections sss secondColumnParams cfig
        <> combineInventoryExtra sss cfig w

drawExamineInventory :: Configuration -> World -> Picture
drawExamineInventory cfig w =
    invHead cfig "EXAMINE"
        <> drawSelectionList
            secondColumnParams
            cfig
            ( defaultSelectionList & slItems
                .~ map -- tweakItems itm
                --  ++
                    f
                    ( makeParagraph 55 $
                        yourAugmentedItem
                            itemInfo
                            (yourInfo (you w))
                            (closeObjectInfo (crNumFreeSlots (you w)))
                            w
                    )
            )
  where
    --    itm = yourSelectedItem w
    f str =
        SelectionItem
            { _siPictures = [str]
            , _siHeight = 1
            , _siIsSelectable = True
            , _siColor = white
            , _siOffX = 0
            , _siPayload = ()
            }

closeObjectInfo :: Int -> Either FloorItem Button -> String
closeObjectInfo n x = case x of
    Left FlIt{_flIt = itm} -> itemInfo itm ++ " It is on the floor" ++ floorItemPickupInfo n itm
    Right _ -> "Some sort of switch or button."

floorItemPickupInfo :: Int -> Item -> String
floorItemPickupInfo n itm
    | n >= _itInvSize itm = ", but you have space to pick it up."
    | otherwise = ", and you don't have space to pick it up."

-- note the use of ^?!
-- it is probably desirable for this to crash hard for now
yourAugmentedItem :: (Item -> a) -> a -> (Either FloorItem Button -> a) -> World -> a
yourAugmentedItem f x g w = case you w ^? crManipulation . manObject of
    Just (SelectedItem i _ _) -> f $ yourInv w ^?! ix i
    Just (SelCloseObject i) -> g $ w ^?! hud . closeObjects . ix i
    _ -> x

drawRBOptions :: Configuration -> World -> Picture
drawRBOptions cfig w = fromMaybe mempty $ do
    guard $ ButtonRight `M.member` _mouseButtons (_input w)
    invid <- you w ^? crManipulation . manObject . imSelectedItem
    eslist <- fmap equipSiteToPositions $ you w ^? crInv . ix invid . itUse . uequipEffect . eeSite
    i <- w ^? rbOptions . opSel
    let ae = getEquipmentAllocation w
    sss <- w ^? hud . hudElement . diSections
    (i', j) <- sss ^? sssExtra . sssSelPos . _Just
    curpos <- selSecYint i' j sss
    let ytext = drawListElement 0 1 0 curpos . text
        midstr = equipAllocString ae
        extrastr = case ae of
            SwapEquipment{_allocOldPos = oldp, _allocSwapID = sid} ->
                "SWAPS " ++ otheritem sid ++ " ONTO " ++ eqPosText oldp
            ReplaceEquipment{_allocRemoveID = rid} ->
                "REMOVES " ++ otheritem rid
            _ -> ""
    return $
        toTopLeft cfig $
            translate 290 (-1) (ytext midstr)
                <> translate 160 (-1) (listCursorChooseBorderScale 0 1 [North, South] curpos 0 white 21 1)
                <> translate
                    380
                    (-1)
                    ( drawListYoff (curpos - i) (map (text . eqPosText) eslist)
                        <> listCursorChooseBorderScale 0 1 [East] (curpos - i) 0 white 7 (length eslist)
                        <> listCursorChooseBorderScale 0 1 [West] (curpos + 1) 0 white 7 (length eslist - (i + 1))
                        <> listCursorChooseBorderScale 0 1 [West] (curpos - i) 0 white 7 i
                        <> maybetopborder i curpos
                        <> maybebottomborder i (length eslist) curpos
                    )
                <> translate 460 (-1) (ytext extrastr)
  where
    maybetopborder 0 curpos = listCursorChooseBorderScale 0 1 [North] curpos 0 white 7 1
    maybetopborder _ _ = mempty
    maybebottomborder a b curpos
        | a == b - 1 = listCursorChooseBorderScale 0 1 [South] curpos 0 white 7 1
        | otherwise = mempty
    otheritem j = fromMaybe "" $ do
        itm <- you w ^? crInv . ix j
        return $ itemBaseName itm

equipAllocString :: EquipmentAllocation -> String
equipAllocString = \case
    DoNotMoveEquipment -> ""
    PutOnEquipment{} -> "  PUT ON"
    MoveEquipment{} -> " MOVE TO"
    SwapEquipment{} -> " MOVE TO"
    ReplaceEquipment{} -> "  PUT ON"
    RemoveEquipment{} -> "TAKE OFF"

inventoryExtra ::
    SelectionSections () ->
    Configuration ->
    World ->
    IM.IntMap (Maybe (Int, Int), [Int], [Int]) ->
    Picture
inventoryExtra sss cfig w =
    translate (negate 5) 0
        . IM.foldMapWithKey (inventoryExtraH sss cfig w)
        . fmap (\(_, a, b) -> a <> b)

inventoryExtraH :: SelectionSections () -> Configuration -> World -> Int -> [Int] -> Picture
inventoryExtraH sss cfig w i is = fromMaybe mempty $ do
    p <- snum i
    let ps = mapMaybe snum is
    return $ color white $ lConnectMulti ps p
  where
    snum = selNumPos cfig (invDisplayParams w) sss 0

combineInventoryExtra :: SelectionSections CombinableItem -> Configuration -> World -> Picture
combineInventoryExtra sss cfig w = fromMaybe mempty $ do
    (i, j) <- sss ^? sssExtra . sssSelPos . _Just
    cpos <- selSecYint i j sss
    si <- sss ^? sssSections . ix i . ssItems . ix j
    let col = _siColor si
    mconcat
        [ do
            strs <- si ^? siPayload . ciInfo
            return
                . translate 160 0
                -- it would be better to get the width of the selection list from elsewhere
                . translateScreenPos cfig (secondColumnParams ^. ldpPos)
                $ drawListYoff cpos $ map (color red . text) strs
        , do
            lnks <- si ^? siPayload . ciInvIDs
            return (lnkMidPosInvSelsCol cfig w j col lnks)
                <> foldMap invcursor lnks
        ]
  where
    invcursor i = do
        sss' <- w ^? hud . hudElement . diSections
        let idp = invDisplayParams w & ldpCursorSides .~ [North, South, East, West]
        return $
            translateScreenPos cfig (idp ^. ldpPos) $
                selSecDrawCursor 17 idp (sss' & sssExtra . sssSelPos ?~ (0, i))

displayTerminal :: Int -> Configuration -> LWorld -> Picture
displayTerminal tid cfig w = fromMaybe mempty $ do
    tm <- w ^? terminals . ix tid
    return $
        invHead cfig (_tmTitle tm ++ ":T" ++ show tid)
            <> drawSelectionList secondColumnParams cfig (thesellist tm)
  where
    toselitm (str, col) = SelectionItem [str] 1 True col 0 ()
    thesellist tm = defaultSelectionList & slItems .~ thelist tm
    thelist tm =
        map toselitm . displayTermInput tm
            . reverse
            . take (_tmMaxLines tm)
            $ _tmDisplayedLines tm
    displayTermInput tm = case _tmInput tm of
        TerminalInput{_tiText = s, _tiFocus = hasfoc} ->
            (++ [(displayInputText tm s ++ displayBlinkCursor hasfoc, white)])
    partcommand tm = maybe "" (++ " ") $ tm ^? tmPartialCommand . _Just . tcString
    displayInputText tm s
        | _tmStatus tm == TerminalReady = partcommand tm ++ "> " ++ s
        | otherwise = ""
    displayBlinkCursor hasfoc
        | hasfoc = clockCycle 10 (V.fromList ["_", "."]) w
        | otherwise = []

lnkMidPosInvSelsCol :: Configuration -> World -> Int -> Color -> [Int] -> Picture
lnkMidPosInvSelsCol cfig w i col = fromMaybe mempty . foldMap f
  where
    f j = do
        sss <- w ^? hud . hudElement . diSections
        combinesss <- w ^? hud . hudElement . subInventory . ciSections
        lp <- selNumPos cfig (invDisplayParams w) sss 0 j
        rp <- selNumPos cfig secondColumnParams combinesss 0 i
        invcol <- selSecSelCol 0 j sss
        return $ zConnectCol (rp - V2 5 0) (lp + V2 175 0) col col col invcol

invHead :: Configuration -> String -> Picture
invHead cfig =
    translateScreenPos cfig (fromTopLeft (V2 (subInvX - 5) 80))
        . dShadCol white
        . scale 0.4 0.4
        . textJustifyLeft

--locPoss = map (cartePosToScreen cfig (w ^. hud) . ($ w) . doWorldPos . fst) . IM.elems . _seenLocations . _lWorld $ _cWorld w
--locTexts = map fst locs

--displayListEndCoords :: Configuration -> [String] -> [Point2]
--displayListEndCoords cfig ss = map (doWindowScale cfig) $ zipWith h ss $ map f [1 ..]
--  where
--    f :: Int -> Point2
--    f i = V2 (15 - halfWidth cfig) (2.5 + halfHeight cfig - (20 * fromIntegral i))
--    h :: String -> Point2 -> Point2
--    h s (V2 x y) = V2 (x + 9 * fromIntegral (length s)) y

--closeObjectTexts :: Configuration -> World -> Picture
--closeObjectTexts cfig w = pictures $
--    renderListAt pushout (negate 20 * fromIntegral invPos) cfig (map colAndText $ _closeObjects w)
--    : maybeToList maybeLine
--  where
--    colAndText (Left x)  = ( _itName $ _flIt x, _itInvColor $ _flIt x)
--    colAndText (Right x) = (_btText x,yellow)
--    youSel = _crInvSel $ you w
--    freeSlot = mayIt >>= \it -> checkInvSlotsYou (_flIt it) w
--    invPos = fromMaybe youSel freeSlot
--    mayObj = listToMaybe $ _closeObjects w
--    mayIt = mayObj >>= maybeLeft
--    maybeLeft (Left x) = Just x
--    maybeLeft _  = Nothing
--    pushout = 120
--    objPos obj = case obj of
--        Left flit -> _flItPos flit
--        Right bt  -> _btPos bt
--    mayScreenPos = fmap (worldPosToScreen w . objPos) mayObj
--    maybeLine = do
--          itScreenPos <- mayScreenPos
--          (theText,col) <- fmap colAndText mayObj
--          let textWidth = 9 * fromIntegral (length theText)
--          let p = V2 (textWidth + 15 + pushout - halfWidth cfig)
--                     ( halfHeight cfig - 20* (fromIntegral invPos +1) + 2.5)
--          return . winScale cfig . color col $ lConnect p itScreenPos

--textSelItems :: [String] -> [SelectionItem ()]
--textSelItems = map (picsToSelectable . (: []))

--picsToSelectable :: [String] -> SelectionItem ()
--picsToSelectable pics =
--    SelectionItem
--        { _siPictures = pics
--        , _siHeight = length pics
--        , _siIsSelectable = True
--        , _siColor = white
--        , _siOffX = 0
--        , _siPayload = ()
--        }

-- would be nice to add parameter to orient this with NSEW, cf cursor
selNumPos ::
    Configuration ->
    ListDisplayParams ->
    SelectionSections a ->
    Int ->
    Int ->
    Maybe Point2
selNumPos cfig ldp sss i j = do
    ipos <- selSecYint i j sss
    size <- selSecSelSize i j sss
    indent <- sss ^? sssSections . ix i . ssItems . ix j . siOffX
    return $
        screenPosAbs cfig (ldp ^. ldpPos)
            + V2
                (10 * s * fromIntegral indent)
                (negate (20 * s + ygap) * (fromIntegral ipos + fromIntegral size * 0.5))
  where
    s = _ldpScale ldp
    ygap = _ldpVerticalGap ldp




selSecSelCol :: Int -> Int -> SelectionSections a -> Maybe Color
selSecSelCol i j sss = sss ^? sssSections . ix i . ssItems . ix j . siColor