{-# LANGUAGE LambdaCase #-}

module Dodge.Render.HUD (
    drawHUD,
) where

import Dodge.Data.Terminal.Status
import Control.Applicative
import Control.Lens
import Control.Monad
import qualified Data.IntSet as IS
import qualified Data.Map.Strict as M
import Data.Maybe
--import qualified Data.Vector as V
import Dodge.Base
import Dodge.CharacterEnums
--import Dodge.Clock
import Dodge.Creature.Info
import Dodge.Creature.Test
import Dodge.Data.CardinalPoint
import Dodge.Data.Combine
import Dodge.Data.Config
import Dodge.Data.DoubleTree
import Dodge.Data.EquipType
import Dodge.Data.SelectionList
import Dodge.Data.World
import Dodge.DoubleTree
import Dodge.Equipment.Text
import Dodge.Inventory
import Dodge.Item.Display
import Dodge.Item.Grammar
import Dodge.Item.Info
import Dodge.Item.InvSize
import Dodge.Item.Location
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 Dodge.Terminal.Type
import Geometry
import qualified IntMapHelp as IM
import Justify
import NewInt
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} ->
        drawInventory sections w cfig
            <> drawSubInventory subinv cfig w

drawInventory :: IM.IntMap (SelectionSection ()) -> World -> Configuration -> Picture
drawInventory sss w cfig =
    drawSelectionSections sss invDP cfig
        <> drawSSCursor sss invDP curs cfig (f $ w ^? hud . hudElement . diSelection . _Just)
        <> drawRootCursor w sss (f $ w ^? hud . hudElement . diSelection . _Just) invDP cfig
        <> itemconnections
        <> drawMouseOver cfig w
  where
    f = fmap (\(x, y, _) -> (x, y))
    curs = invCursorParams w
    itemconnections = fromMaybe mempty $ do
        inv <- w ^? cWorld . lWorld . creatures . ix 0 . crInv
        case w ^? hud . hudElement . diInvFilter . _Just of
            Just (_ : _) -> Nothing
            _ -> return . drawItemConnections sss cfig $ invAdj inv

drawRootCursor ::
    World ->
    IM.IntMap (SelectionSection ()) ->
    Maybe (Int, Int) ->
    ListDisplayParams ->
    Configuration ->
    Picture
drawRootCursor w sss msel ldp cfig = fromMaybe mempty $ do
    cr <- w ^? cWorld . lWorld . creatures . ix 0
    guard $ crIsAiming cr
    (i, j) <- msel
    guard $ i == 0
    inv <- w ^? cWorld . lWorld . creatures . ix 0 . crInv
    (x, y) <- getRootItemBounds j inv
    return $
        drawSSMultiCursor
            sss
            (Just (0, x))
            (Just (y - x))
            ldp
            (BoundaryCursor [minBound ..])
            cfig

getRootItemBounds :: Int -> IM.IntMap Item -> Maybe (Int, Int)
getRootItemBounds i inv = do
    let ia = invIndents inv -- why indents? why OItem?
    itm <- ia ^? ix i . _2
    let root = locToTop itm
    x <- locDTRightmost root ^? locDT . dtValue . _1 . itLocation . ilInvID
    y <- locDTLeftmost root ^? locDT . dtValue . _1 . itLocation . ilInvID
    return (x, y)

drawMouseOver :: Configuration -> World -> Picture
drawMouseOver cfig w =
    concat
        ( invsel <|> combinvsel
            <|> drawDragSelecting cfig w
        )
        <> concat (drawDragSelected cfig w)
  where
    invsel = do
        (j, i) <-
            w ^? input . mouseContext . mcoInvSelect
                <|> w ^? input . mouseContext . mcoInvFilt
        sss <- w ^? hud . hudElement . diSections
        return . translateScreenPos cfig (invDP ^. ldpPos)
            . color (withAlpha 0.1 white)
            --            . color white
            $ selSecDrawCursorAt invDP curs sss (j, i)
    --    curs = BoundaryCursor [West]
    curs = BackdropCursor
    combinvsel = do
        (j, i) <-
            (w ^? input . mouseContext . mcoCombSelect)
                <|> (w ^? input . mouseContext . mcoCombCombine)
        sss <- w ^? hud . hudElement . subInventory . ciSections
        let idp = secondColumnParams
        return . translateScreenPos cfig (idp ^. ldpPos)
            . color (withAlpha 0.2 white)
            $ selSecDrawCursorAt idp curs sss (j, i)

drawDragSelected :: Configuration -> World -> Maybe Picture
drawDragSelected cfig w = do
    ys <- w ^? hud . hudElement . diSelection . _Just . _3
    guard $
        not (IS.null ys)
            && ( case w ^? hud . hudElement . subInventory of
                    Just NoSubInventory -> True
                    _ -> False
               )
    (i, _, _) <- w ^? hud . hudElement . diSelection . _Just
    sss <- w ^? hud . hudElement . diSections
    let f x = (selSecDrawCursorAt invDP BackdropCursor sss (i, x) <>)
    return . translateScreenPos cfig (invDP ^. ldpPos)
        . color (withAlpha 0.2 white)
        . IS.foldr f mempty
        $ ys

drawDragSelecting :: Configuration -> World -> Maybe Picture
drawDragSelecting cfig w = do
    OverInvDragSelect (i, j) mselend <- w ^? input . mouseContext
    b <- mselend
    sss <- w ^? hud . hudElement . diSections
    let f x = selSecDrawCursorAt invDP BackdropCursor sss (i, x)
    return . translateScreenPos cfig (invDP ^. ldpPos)
        . color (withAlpha 0.2 white)
        . foldMap f
        $ [min j b .. max j b]

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 -> drawTerminalDisplay tid cfig (w ^. cWorld . lWorld)
    CombineInventory{_ciSections = sss} -> drawCombineInventory cfig sss w
    MapperInventory _ _ itid -> drawMapperInventory itid w

drawMapperInventory :: NewInt ItmInt -> World -> Picture
drawMapperInventory itid w = fold $ do
    itm <- w ^? pointerToItemID itid
    ls <- itm ^? itUse . useMapperLines
    let _ = w ^. wCam . camRot
    return . color red $ foldMap (\(x, y) -> line [f x, f y]) ls
  where
    f = worldPosToScreen (w ^. wCam)

drawCombineInventory ::
    Configuration ->
    IM.IntMap (SelectionSection CombinableItem) ->
    World ->
    Picture
drawCombineInventory cfig sss w =
    invHead cfig "COMBINE"
        <> drawSelectionSections sss secondColumnParams cfig
        <> drawSSCursor sss secondColumnParams curs cfig msel
        <> combineInventoryExtra sss msel cfig w
  where
    curs = BoundaryCursor [North, South, West]
    msel =
        fmap (\(x, y, _) -> (x, y)) $
            w ^? hud . hudElement . subInventory . ciSelection . _Just

drawExamineInventory :: Configuration -> World -> Picture
drawExamineInventory cfig w =
    invHead cfig "EXAMINE"
        <> drawSelectionList
            secondColumnParams
            cfig
            ( map
                f
                ( makeParagraph 55 $
                    yourAugmentedItem
                        itemInfo
                        (yourInfo (you w))
                        (closeObjectInfo (crNumFreeSlots (you w)))
                        w
                )
            )
  where
    f str =
        SelectionItem
            { _siPictures = [str]
            , _siWidth = 55
            , _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 >= itInvHeight 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 (SelCloseItem i) -> fromMaybe x $ do
        j <- w ^? hud . closeItems . ix i . unNInt
        flit <- w ^? cWorld . lWorld . floorItems . unNIntMap . ix j
        return . g $ Left flit
    --        g . Left $ w ^?! hud . closeItems . ix i
    Just (SelCloseButton i) -> fromMaybe x $ do
        j <- w ^? hud . closeButtons . ix i
        flit <- w ^? cWorld . lWorld . buttons . ix j
        return . g $ Right flit
    _ -> x

drawRBOptions :: Configuration -> World -> Picture
drawRBOptions cfig w = fold $ do
    guard $ ButtonRight `M.member` _mouseButtons (_input w)
    invid <- you w ^? crManipulation . manObject . imSelectedItem
    eslist <-
        fmap eqSiteToPositions $
            you w ^? crInv . ix invid >>= equipType -- . itUse . uequipEffect . eeType
    i <- w ^? rbOptions . opSel
    let ae = getEquipmentAllocation invid w
    sss <- w ^? hud . hudElement . diSections
    (i', j, _) <- w ^? hud . hudElement . diSelection . _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
                        (BoundaryCursor [North, South])
                        curpos
                        0
                        white
                        21
                        1
                    )
                <> translate
                    380
                    (-1)
                    ( drawListYoff (curpos - i) (map (text . eqPosText) eslist)
                        <> listCursorChooseBorderScale 0 1 (bc East) (curpos - i) 0 white 7 (length eslist)
                        <> listCursorChooseBorderScale 0 1 (bc West) (curpos + 1) 0 white 7 (length eslist - (i + 1))
                        <> listCursorChooseBorderScale 0 1 (bc West) (curpos - i) 0 white 7 i
                        <> maybetopborder i curpos
                        <> maybebottomborder i (length eslist) curpos
                    )
                <> translate 460 (-1) (ytext extrastr)
  where
    bc x = BoundaryCursor [x]
    maybetopborder 0 curpos = listCursorChooseBorderScale 0 1 (bc North) curpos 0 white 7 1
    maybetopborder _ _ = mempty
    maybebottomborder a b curpos
        | a == b - 1 = listCursorChooseBorderScale 0 1 (bc South) curpos 0 white 7 1
        | otherwise = mempty
    otheritem j = fromMaybe "" $ do
        itype <- you w ^? crInv . ix j . itType
        return $ itemBaseName itype

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

drawItemConnections ::
    IM.IntMap (SelectionSection ()) ->
    Configuration ->
    IM.IntMap (Maybe (Int, Int), [Int], [Int]) ->
    Picture
drawItemConnections sss cfig =
    translate (negate 5) 0
        . IM.foldMapWithKey (drawItemChildrenConnect sss cfig)
        . fmap (\(_, a, b) -> a <> b)

drawItemChildrenConnect ::
    IM.IntMap (SelectionSection ()) ->
    Configuration ->
    Int ->
    [Int] ->
    Picture
drawItemChildrenConnect sss cfig i is = fromMaybe mempty $ do
    p <- snum i
    let ps = mapMaybe snum is
    return $ color white $ lConnectMulti ps p
  where
    snum = selNumPos cfig invDP sss 0

combineInventoryExtra ::
    IM.IntMap (SelectionSection CombinableItem) ->
    Maybe (Int, Int) ->
    Configuration ->
    World ->
    Picture
combineInventoryExtra sss msel cfig w = fromMaybe mempty $ do
    (i, j) <- msel
    si <- sss ^? ix i . ssItems . ix j
    let col = _siColor si
    lnks <- si ^? siPayload . ciInvIDs
    return (lnkMidPosInvSelsCol cfig w j col lnks)
        <> foldMap invcursor lnks
  where
    invcursor i = do
        sss' <- w ^? hud . hudElement . diSections
        return $
            translateScreenPos cfig (invDP ^. ldpPos) $
                selSecDrawCursor
                    invDP
                    (BoundaryCursor [North, South, East, West])
                    sss'
                    (Just (0, i))

drawTerminalDisplay :: Int -> Configuration -> LWorld -> Picture
drawTerminalDisplay tid cfig w = fromMaybe mempty $ do
    tm <- w ^? terminals . ix tid
    let tsize = getMaxLinesTM + 1
    return $
        invHead cfig ("T-" ++ show tid)
            <> drawSelectionList secondColumnParams cfig (thesellist tm)
            <> color
                (withAlpha 0.5 green) -- consider integrating termScreenColor somehow
                (drawSelectionListBackground secondColumnParams cfig tsize)
            <> color (dark $ _tmExternalColor tm) (drawTitleBackground cfig)
  where
    toselitm (str, col) = SelectionItem [str] 1 55 True col 0 ()
    -- not sure if the width (55) is correct here
    thesellist tm = thelist tm
    thelist tm =
        map toselitm . displayTermInput tm
            . reverse
            . take getMaxLinesTM
            $ _tmDisplayedLines tm
    displayTermInput tm = case _tmStatus tm of
        TerminalOff -> id
        TerminalBusy -> (++ [([cFilledRect], white)])
        TerminalTextInput s _ ->
            (++ [(getPromptTM ++ s ++ [cFilledRect], white)])
        TerminalPressTo s ->
            (++ [("PRESS TO "++s, white)])
--    partcommand tm = maybe "" (++ " ") $ tm ^? tmPartialCommand . _Just . tcString
--    displayInputText tm s
--        | TerminalTextInput <- _tmStatus tm = getPromptTM ++ s 
----        | _tmStatus tm == TerminalReady = partcommand tm ++ getPromptTM ++ s
--        | otherwise = ""

--        | hasfoc = clockCycle 10 (V.fromList [[cFilledRect] , "."]) w

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 invDP sss 0 j
        rp <- selNumPos cfig secondColumnParams combinesss 0 i
        invcol <- selSecSelCol 0 j sss
        return $ zConnectColMidX (rp - V2 5 0) (lp + V2 155 0) (rp ^. _1 - 20) col col col invcol

invHead :: Configuration -> String -> Picture
invHead cfig =
    translateScreenPos cfig (fromTopLeft (V2 subInvX 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 . (: []))

-- would be nice to add parameter to orient this with NSEW, cf cursor
selNumPos ::
    Configuration ->
    ListDisplayParams ->
    IM.IntMap (SelectionSection a) ->
    Int ->
    Int ->
    Maybe Point2
selNumPos = selNumPosCardinal West8

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

-- need to be able to determine a selection item's width for this
selNumPosCardinal ::
    CardinalEightPoint ->
    Configuration ->
    ListDisplayParams ->
    IM.IntMap (SelectionSection a) ->
    Int ->
    Int ->
    Maybe Point2
selNumPosCardinal card cfig ldp sss i j = do
    ipos <- selSecYint i j sss
    --    size <- selSecSelSize i j sss
    ysize <- fromIntegral <$> sss ^? ix i . ssItems . ix j . siHeight
    xsize <- fromIntegral <$> sss ^? ix i . ssItems . ix j . siWidth
    itmindent <- fromIntegral <$> sss ^? ix i . ssItems . ix j . siOffX
    sindent <- fromIntegral <$> sss ^? ix i . ssIndent
    let indent = itmindent + sindent
    let offset =
            cardEightVec card
                * V2
                    (xsize * 0.5 * 10 * s)
                    (ysize * 0.5 * 20 * s)
    return $
        screenPosAbs cfig (ldp ^. ldpPos)
            + offset
            + V2
                (10 * s * (indent + xsize * 0.5))
                (negate (20 * s + ygap) * (fromIntegral ipos + ysize * 0.5))
  where
    s = _ldpScale ldp
    ygap = _ldpVerticalGap ldp

selSecSelCol :: Int -> Int -> IM.IntMap (SelectionSection a) -> Maybe Color
selSecSelCol i j sss = sss ^? ix i . ssItems . ix j . siColor