{-# LANGUAGE LambdaCase #-}

module Dodge.Render.HUD (drawHUD) where

import Control.Applicative
import Control.Lens
import Control.Monad
import qualified Data.IntSet as IS
import Data.List (elemIndex)
import qualified Data.Map.Strict as M
import Data.Maybe
import qualified Data.Vector as V
-- import qualified Data.Vector as V
import Dodge.Base
import Dodge.CharacterEnums
import Dodge.Clock
-- 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.Terminal.Status
import Dodge.Data.World
import Dodge.DoubleTree
import Dodge.Equipment.Text
import Dodge.Inventory
import Dodge.Inventory.CheckSlots
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.List
import Dodge.ScreenPos
import Dodge.SelectionSections
import Dodge.SelectionSections.Draw
import Dodge.Terminal
import Dodge.Terminal.Type
import Geometry
import qualified IntMapHelp as IM
import Justify
import Linear
import NewInt
import Picture
import SDL (MouseButton (..))

drawHUD :: Config -> World -> Picture
drawHUD cfig w =
    drawInventory sections w cfig subinv
        <> drawSubInventory subinv cfig w
  where
    sections = w ^. hud . diSections
    subinv = w ^. hud . subInventory

drawInventory :: IMSS () -> World -> Config -> SubInventory -> Picture
drawInventory sss w cfig = \case
    DisplayTerminal{} ->
        drawSelectionSections sss invDP cfig
            <> itemconnections
            <> drawMouseOver cfig w
    _ ->
        drawSelectionSections sss invDP cfig
            <> foldMap (drawSSCursor sss invDP curs cfig) (w ^. hud . diSelection)
            <> drawRootCursor w sss (w ^. hud . diSelection) invDP cfig
            <> itemconnections
            <> drawMouseOver cfig w
  where
    curs = invCursorParams w
    itemconnections = fromMaybe mempty $ do
        inv' <- w ^? cWorld . lWorld . creatures . ix 0 . crInv
        let inv = fmap (\k -> w ^?! cWorld . lWorld . items . ix k) inv'
        case w ^? hud . diInvFilter . _Just of
            Just (_ : _) -> Nothing
            _ -> return . drawItemConnections sss cfig $ invAdj inv

drawRootCursor ::
    World -> IMSS () -> Maybe Selection -> LDParams -> Config -> Picture
drawRootCursor w sss msel ldp cfig = fromMaybe mempty $ do
    cr <- w ^? cWorld . lWorld . creatures . ix 0
    guard $ crIsAiming cr
    i <- msel ^? _Just . slSec
    j <- msel ^? _Just . slInt
    guard $ i == 0
    inv' <- w ^? cWorld . lWorld . creatures . ix 0 . crInv
    let inv = fmap (\k -> w ^?! cWorld . lWorld . items . ix k) inv'
    (x, y) <- getRootItemBounds j $ _unNIntMap inv
    let curs =
            if null (w ^? rbState . opSel)
                then BoundCurs [minBound ..]
                else BoundCurs [North, South, West]
    return $
        drawSSMultiCursor
            sss
            (0, x)
            (y - x)
            ldp
            curs
            cfig

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

drawMouseOver :: Config -> 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 . diSections
        return
            . translateScreenPos cfig (invDP ^. ldpPos)
            . color (0.3 *^ white)
            --            . color white
            $ selSecDrawCursor invDP curs sss (Sel j i mempty)
    --    curs = BoundaryCursor [West]
    curs = BackdropCurs
    combinvsel = do
        (j, i) <-
            (w ^? input . mouseContext . mcoCombSelect)
                <|> (w ^? input . mouseContext . mcoCombCombine)
        sss <- w ^? hud . subInventory . ciSections
        let idp = secondColumnLDP
        return
            . translateScreenPos cfig (idp ^. ldpPos)
            . color (0.3 * white)
            $ selSecDrawCursor idp curs sss (Sel j i mempty)

drawDragSelected :: Config -> World -> Maybe Picture
drawDragSelected cfig w = do
    ys <- w ^? hud . diSelection . _Just . slSet
    guard $
        not (IS.null ys)
            && ( case w ^? hud . subInventory of
                    Just NoSubInventory -> True
                    _ -> False
               )
    Sel i _ _ <- w ^? hud . diSelection . _Just
    sss <- w ^? hud . diSections
    let f x = (selSecDrawCursor invDP BackdropCurs sss (Sel i x mempty) <>)
    return
        . translateScreenPos cfig (invDP ^. ldpPos)
        . color (0.2 *^ white)
        . IS.foldr f mempty
        $ ys

drawDragSelecting :: Config -> World -> Maybe Picture
drawDragSelecting cfig w = do
    OverInvDragSelect (Just (i, j)) (Just b) <- w ^? input . mouseContext
    sss <- w ^? hud . diSections
    let f x = selSecDrawCursor invDP BackdropCurs sss (Sel i x mempty)
    return
        . translateScreenPos cfig (invDP ^. ldpPos)
        . color (0.2 *^ white)
        . foldMap f
        $ [min j b .. max j b]

drawSubInventory :: SubInventory -> Config -> World -> Picture
drawSubInventory subinv cfig w = case subinv of
    NoSubInventory{} -> drawRBOptions cfig w
    ExamineInventory -> drawExamineInventory cfig w
    DisplayTerminal tid -> drawTerminalDisplay w cfig tid
    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 :: Config -> IMSS CombItem -> World -> Picture
drawCombineInventory cfig sss w =
    drawSelectionSections sss secondColumnLDP cfig
        <> foldMap (drawSSCursor sss secondColumnLDP curs cfig) msel
        <> combineInventoryExtra sss msel cfig w
  where
    curs = BoundCurs [North, South, West]
    msel = w ^? hud . subInventory . ciSelection . _Just

drawExamineInventory :: Config -> World -> Picture
drawExamineInventory cfig w =
    invHead cfig "EXAMINE"
        <> drawSelectionList
            secondColumnLDP
            cfig
            ( map
                f
                ( makeParagraph 55 $
                    yourAugmentedItem
                        itemInfo
                        (yourInfo (you w))
                        (closeObjectInfo (crNumFreeSlots (w ^. cWorld . lWorld . items) (you w)))
                        w
                )
            )
  where
    f str =
        SelItem
            { _siPictures = [str]
            , _siWidth = 55
            , _siHeight = 1
            , _siIsSelectable = True
            , _siColor = white
            , _siOffX = 0
            , _siPayload = Nothing
            , _siDisplayMod = NoSIDisplayMod
            }

closeObjectInfo :: Int -> Either Item Button -> String
closeObjectInfo n x = case x of
    Left 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 Item 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 . items . ix j
        return . g $ Left flit
    Just (SelCloseButton i) -> fromMaybe x $ do
        j <- w ^? hud . closeButtons . ix i
        but <- w ^? cWorld . lWorld . buttons . ix j
        return . g $ Right but
    _ -> x

drawRBOptions :: Config -> World -> Picture
drawRBOptions cfig w = fold $ do
    guard $ ButtonRight `M.member` _mouseButtons (_input w)
    invid <- you w ^? crManipulation . manObject . imSelectedItem
    itid <- you w ^? crInv . ix invid
    eslist <-
        fmap eqTypeToSites $
            w ^? cWorld . lWorld . items . ix itid >>= equipType
    i <- w ^? rbState . opSel
    let ae = equipmentDesignation invid w
    sss <- w ^? hud . diSections
    Sel i' j _ <- w ^? hud . diSelection . _Just
    curpos <- selSecYint i' j sss
    itext <- sss ^? ix i' . ssItems . ix j . siPictures . ix 0
    ind <- sss ^? ix i' . ssItems . ix j . siOffX
    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
        . translateScreenPos cfig (invDP ^. ldpPos)
        . translate (10 * fromIntegral (ind + length itext)) 0
        $ translate (290 - xt) 0 (ytext midstr)
            <> translate
                (120 - xt)
                0
                ( listCursor
                    0
                    1
                    (BoundCurs [North, South])
                    curpos
                    0
                    white
                    25
                    1
                )
            <> translate
                (380 - xt)
                0
                ( drawListYoff (curpos - i) (map (text . eqPosText) eslist)
                    <> listCursor 0 1 (bc East) (curpos - i) 0 white 7 (length eslist)
                    <> listCursor 0 1 (bc West) (curpos + 1) 0 white 7 (length eslist - (i + 1))
                    <> listCursor 0 1 (bc West) (curpos - i) 0 white 7 i
                    <> maybetopborder i curpos
                    <> maybebottomborder i (length eslist) curpos
                )
            <> translate (460 - xt) 0 (ytext extrastr)
  where
    xt = 260
    bc x = BoundCurs [x]
    maybetopborder 0 curpos = listCursor 0 1 (bc North) curpos 0 white 7 1
    maybetopborder _ _ = mempty
    maybebottomborder a b curpos
        | a == b - 1 = listCursor 0 1 (bc South) curpos 0 white 7 1
        | otherwise = mempty
    otheritem (NInt j) = fromMaybe "" $ do
        itype <- w ^? cWorld . lWorld . items . 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 ::
    IMSS () -> Config -> 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 :: IMSS () -> Config -> 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 :: IMSS CombItem -> Maybe Selection -> Config -> World -> Picture
combineInventoryExtra sss msel cfig w = fold $ do
    i <- msel ^? _Just . slSec
    j <- msel ^? _Just . slInt
    si <- sss ^? ix i . ssItems . ix j
    let col = _siColor si
    lnks <- si ^? siPayload . _Just . ciInvIDs
    return (lnkMidPosInvSelsCol cfig w j col lnks) <> Just (foldMap invcursor lnks)
  where
    invcursor i =
        translateScreenPos cfig (invDP ^. ldpPos) $
            selSecDrawCursor
                invDP
                (BoundCurs [North, South, East, West])
                (w ^. hud . diSections)
                (Sel 0 i mempty)

drawTerminalDisplay :: World -> Config -> Int -> Picture
drawTerminalDisplay w cfig tid = fold $ do
    tm <- w ^? cWorld . lWorld . terminals . ix tid
    let toselitm (str, col) = SelItem [str] 1 55 True col 0 Nothing NoSIDisplayMod
        f =
            -- toselitm ("TERMINAL " ++ show tid, white)
            toselitm ("", white)
                : ( map (toselitm . (_1 %~ ("  " <>)))
                        . displayTermInput
                        . reverse
                        $ _tmDisplayedLines tm
                  )
        displayTermInput = case _tmStatus tm of
            TerminalOff -> id
            TerminalDeactivated -> id
            TerminalLineRead -> (++ [(spincurs, termTextColor)])
            TerminalTextInput s -> (++ [(getPromptTM ++ s ++ [cFilledRect], white)])
            TerminalPressTo s -> (++ [(s, white)])
    return . (each . vxPos . _z -~ 0.05) $
        drawTerminalCursorLink w cfig tm
            <> (
        drawSelectionList (w ^. tmLDP) cfig f
            <> (hackInvertText black white ("TERMINAL-" ++ show tid) 
                & each . vxPos *~ 0.1
                & each . vxPos . _xy +~ rp)  
                & each . vxPos . _z -~ 0.05)
  where
    rp = screenPosAbs cfig (w ^. tmLDP . ldpPos)
    --        <> invHead cfig ("TERMINAL-" ++ show tid)
    --        <> color
    --            (withAlpha 0.5 green) -- consider integrating termScreenColor somehow
    --            (drawSelectionListBackground secondColumnLDP cfig tsize)
    --        <> color (dark $ _tmExternalColor tm) (drawTitleBackground cfig)

    --    tsize = getMaxLinesTM + 1
    -- not sure if the width (55) is correct here
    spincurs = clockCycle 4 (V.fromList ["/", "-", "\\", "|"]) lw
    lw = w ^. cWorld . lWorld

drawTerminalCursorLink :: World -> Config -> Terminal -> Picture
drawTerminalCursorLink w cfig tm = fold $ do
    j <- elemIndex (tm ^. tmButtonID) $ w ^. hud . closeButtons
    lp <- selNumPos cfig invDP (w ^. hud . diSections) 5 j
    let rp = screenPosAbs cfig (w ^. tmLDP . ldpPos)
    lcol <- selSecSelCol 5 j (w ^. hud . diSections)
    return $
        translateScreenPos
            cfig
            (invDP ^. ldpPos)
            ( selSecDrawCursor
                invDP
                (BoundCurs [North, South, East, West])
                (w ^. hud . diSections)
                (Sel 5 j mempty)
            )
            <> 
            lConnectCol (lp + V2 155 0) rp lcol white white

lnkMidPosInvSelsCol :: Config -> World -> Int -> Color -> [Int] -> Picture
lnkMidPosInvSelsCol cfig w i col = fromMaybe mempty . foldMap f
  where
    f j = do
        let sss = w ^. hud . diSections
        combinesss <- w ^? hud . subInventory . ciSections
        lp <- selNumPos cfig invDP sss 0 j
        rp <- selNumPos cfig secondColumnLDP 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 :: Config -> 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 :: Config -> [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 :: Config -> 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 :: Config -> LDParams -> IMSS 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 ::
    Cardinal8 -> Config -> LDParams -> IMSS a -> Int -> Int -> Maybe Point2
selNumPosCardinal card cfig ldp sss i j = do
    ipos <- selSecYint 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 = s *^ (card8Vec card * V2 (xsize * 5) (ysize * 10))
    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 -> IMSS a -> Maybe Color
selSecSelCol i j = (^? ix i . ssItems . ix j . siColor)