{-# LANGUAGE LambdaCase #-}

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

import Dodge.Creature.Test
import Dodge.DoubleTree
import Dodge.Data.DoubleTree
import Dodge.Data.ComposedItem
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 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 :: IM.IntMap (SelectionSection ()) -> World -> Configuration -> Picture
drawInventory sss w cfig =
    drawSelectionSections sss ldp cfig
        <> drawSSCursor sss (w ^? hud . hudElement . diSelection . _Just) ldp curs cfig
        <> drawRootCursor w sss (w ^? hud . hudElement . diSelection . _Just) ldp cfig
--        <> drawSSMultiCursor sss (w ^? hud . hudElement . diSelection . _Just) 
--                (w ^? hud . hudElement . diSelectionExtra)
--                ldp curs cfig
        <> iextra
        <> translateScreenPos
            cfig
            (ldp ^. ldpPos)
            (drawDIMouseOver w <> drawDISelections w)
  where
    ldp = invDisplayParams w
    curs = invCursorParams w
    iextra = fromMaybe mempty $ do
        inv <- w ^? cWorld . lWorld . creatures . ix 0 . crInv
        return . inventoryExtra sss cfig w $ 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 .. maxBound])  cfig 

getRootItemBounds :: Int -> IM.IntMap Item -> Maybe (Int,Int)
getRootItemBounds i inv = do
    let ia = allInvLocs inv
    itm <- ia ^? ix i . _2
    let root = locToTop itm
    x <- locRightmost root ^? locLDT . ldtValue . cItem . itLocation . ilInvID
    y <- locLeftmost root ^? locLDT . ldtValue . cItem . itLocation . ilInvID
    return (x,y)
  

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.2 white) $ selSecDrawCursorAt 15 idp curs sss (0, i)
  where
    curs = BackdropCursor

getMouseInvSel :: World -> Maybe ((Int, Int), (Int, Int))
getMouseInvSel w = case w ^? hud . hudElement . subInventory . nsSelected of
    Just (MouseInvSelect s (Just e)) -> Just (s, e)
    _ -> case w ^? hud . hudElement . diSelectionExtra of
        Just x | x > 0 -> do
            (i,j) <- w ^? hud . hudElement . diSelection . _Just
            return ((i,j),(i,j+x))
        _ -> Nothing

drawDISelections :: World -> Picture
drawDISelections w = fromMaybe mempty $ do
    ((_, j), (_, b)) <- getMouseInvSel w
    sss <- w ^? hud . hudElement . diSections
    let idp = invDisplayParams w
    let f x = selSecDrawCursorAt 15 idp BackdropCursor sss (0,x)
    return . 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 -> displayTerminal tid cfig (w ^. cWorld . lWorld)
    CombineInventory{_ciSections = sss} -> drawCombineInventory cfig sss w

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

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) <- 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
        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 ::
    IM.IntMap (SelectionSection ()) ->
    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 ::
    IM.IntMap (SelectionSection ()) ->
    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 ::
    IM.IntMap (SelectionSection CombinableItem) ->
    Maybe (Int, Int) ->
    Configuration ->
    World ->
    Picture
combineInventoryExtra sss msel cfig w = fromMaybe mempty $ do
    (i, j) <- msel
    cpos <- selSecYint i j sss
    si <- sss ^? 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
        return $
            translateScreenPos cfig (idp ^. ldpPos) $
                selSecDrawCursor
                    17
                    idp
                    (BoundaryCursor [North, South, East, West])
                    sss'
                    (Just (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 ->
    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
    indent <- sss ^? ix i . ssItems . ix j . siOffX
    let offset = cardEightVec card * V2 0 (fromIntegral size * 0.5 * 20 * s)
    return $
        screenPosAbs cfig (ldp ^. ldpPos)
            + offset
            + 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 -> IM.IntMap (SelectionSection a) -> Maybe Color
selSecSelCol i j sss = sss ^? ix i . ssItems . ix j . siColor