--{-# LANGUAGE TupleSections #-}
module Dodge.Render.HUD (
    drawHUD,
) where

import Dodge.Item.Display
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.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 Dodge.Tweak.Show
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 = drawSelectionSections sss . invDisplayParams

drawSubInventory :: SubInventory -> Configuration -> World -> Picture
drawSubInventory subinv cfig w = case subinv of
    LockedInventory -> mempty -- topInvCursor col cursPos cfig w
    NoSubInventory -> drawRBOptions cfig w
    ExamineInventory mtweaki -> drawExamineInventory cfig mtweaki 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 -> Maybe Int -> World -> Picture
drawExamineInventory cfig mtweaki w =
    invHead cfig "EXAMINE"
        <> examineInventoryExtra mtweaki itm cfig
        <> drawSelectionList
            secondColumnParams
            cfig
            ( defaultSelectionList & slItems .~ ammoTweakSelectionItems itm
                ++ map
                    f
                    ( makeParagraph 60 $
                        yourAugmentedItem
                            itemInfo
                            (yourInfo (you w))
                            (closeObjectInfo (crNumFreeSlots (you w)))
                            w
                    )
            )
  where
    itm = yourItem 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 >= ceiling (_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 (InInventory (SelItem i _)) -> f $ yourInv w ^?! ix i
    Just (InNearby (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)
    es <- w ^? rbOptions . opEquip
    i <- w ^? rbOptions . opSel
    ae <- w ^? rbOptions . opAllocateEquipment
    sss <- w ^? hud . hudElement . diSections
    (i', j) <- sss ^? sssExtra . sssSelPos . _Just
    curpos <- selSecSelPos i' j sss
    let ytext = drawListElement 0 1 curpos . text
        midstr = case ae of
            DoNotMoveEquipment -> ""
            PutOnEquipment{} -> "  PUT ON"
            MoveEquipment{} -> " MOVE TO"
            SwapEquipment{} -> " MOVE TO"
            ReplaceEquipment{} -> "  PUT ON"
            RemoveEquipment{} -> "TAKE OFF"
        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) es))
            <> translate 380 (-1) (listCursorChooseBorderScale 0 1 [East] (curpos - i) 0 white 7 (length es))
            <> translate 380 (-1) (listCursorChooseBorderScale 0 1 [West] (curpos + 1) 0 white 7 (length es - (i+1)))
            <> translate 380 (-1) (listCursorChooseBorderScale 0 1 [West] (curpos - i) 0 white 7 i)
            <> translate 380 (-1) (maybetopborder i curpos)
            <> translate 380 (-1) (maybebottomborder i (length es) 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

examineInventoryExtra :: Maybe Int -> Maybe Item -> Configuration -> Picture
examineInventoryExtra mtweaki mitm cfig = fromMaybe mempty $ do
    tweaki <- mtweaki
    -- consider moving this functionality out into a tweaks module
    tparam <- mitm ^? _Just . itTweaks . tweakParams . ix tweaki
    return $
        toTopLeft cfig $
            translate subInvX (-60) $
                listCursorNSW tweaki 0 white (length $ showTweak tparam) 15

combineInventoryExtra :: SelectionSections CombinableItem -> Configuration -> World -> Picture
combineInventoryExtra sss cfig w = fromMaybe mempty $ do
    (i, j) <- sss ^? sssExtra . sssSelPos . _Just
    si <- sss ^? sssSections . ix i . ssItems . ix j
    cpos <- selSecSelPos i j sss
    let col = _siColor si
    return $
        mconcat
            [ fromMaybe mempty $ do
                strs <- si ^? siPayload . ciInfo
                return $ toTopLeft cfig (translate (subInvX + 150) 60 $ drawListYoff cpos $ map (color red . text) strs)
            , fromMaybe mempty $ do
                lnks <- si ^? siPayload . ciInvIDs
                return $
                    lnkMidPosInvSelsCol cfig w cpos col lnks
                        <> foldMap invcursor lnks
                        <> combineCounts cfig w lnks
            ]
  where
    invcursor i = fromMaybe mempty $ do
        sss' <- w ^? hud . hudElement . diSections
        let idp = invDisplayParams w
        return $
            translateScreenPos cfig (idp ^. ldpPos) $
                selSecDrawCursor 17 [North, South, East] idp sss' 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 = []

combineCounts :: Configuration -> World -> [Int] -> Picture
combineCounts cfig w = foldMap f . group
  where
    f (i : is) = fromMaybe mempty $ do
        _ <- yourInv w ^? ix i . itUse . useAmount
        sss <- w ^? hud . hudElement . diSections
        p <- selNumTextEndPos cfig (invDisplayParams w) sss 0 i
        col <- selSecSelCol 0 i sss
        return $ color col $ uncurryV translate p . scale 0.1 0.1 . text $ ('-' : show (length is + 1))
    f _ = mempty

lnkMidPosInvSelsCol :: Configuration -> World -> Int -> Color -> [Int] -> Picture
lnkMidPosInvSelsCol cfig w i col = foldMap f
  where
    f j = fromMaybe mempty $ do
        sss <- w ^? hud . hudElement . diSections
        h <- selNumEndMidHeight cfig (invDisplayParams w) sss 0 j
        invcol <- selSecSelCol 0 j sss
        return $ zConnectCol rp (V2 18 0 + h) col white white invcol
    rp = V2 (190 - hw) (hh - (20 * fromIntegral i + 77.5))
    hh = halfHeight cfig
    hw = halfWidth cfig

ammoTweakSelectionItems :: Maybe Item -> [SelectionItem ()]
ammoTweakSelectionItems = textSelItems . ammoTweakStrings

ammoTweakStrings :: Maybe Item -> [String]
ammoTweakStrings it = case it ^? _Just . itTweaks . tweakParams of
    Just l -> map tweakString $ IM.elems l
    _ -> ["NOT TWEAKABLE"]

tweakString :: TweakParam -> String
tweakString tp = rightPad 12 ' ' (show $ _tweakType tp) ++ " " ++ showTweak tp

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

--selectedCloseObjectLink :: Configuration -> World -> Picture
--selectedCloseObjectLink cfig w = mempty

-- | Pictures of popup text for items close to your position.

--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 = ()
        }

-- there are still more ListDisplayParams to integrate here
selNumTextEndPos :: Configuration -> ListDisplayParams -> SelectionSections a -> Int -> Int -> Maybe Point2
selNumTextEndPos cfig ldp sss i j = do
    ipos <- selSecSelPos i j sss
    return $ V2 (150 - hw) (hh - ((s * 10 + ygap) * (fromIntegral ipos + 1)))
  where
    s = _ldpScale ldp
    ygap = _ldpVerticalGap ldp
    hh = halfHeight cfig
    hw = halfWidth cfig

selNumEndMidHeight ::
    Configuration ->
    ListDisplayParams ->
    SelectionSections a ->
    Int ->
    Int ->
    Maybe Point2
selNumEndMidHeight cfig ldp sss i j = do
    ipos <- selSecSelPos i j sss
    size <- selSecSelSize i j sss
    --let bump = negate $ (10 * s + ygap) * fromIntegral size
    return $ V2 (150 - hw) (hh - ((10 * s + ygap) * (fromIntegral ipos + fromIntegral size * 0.5)))
  where
    s = _ldpScale ldp
    ygap = _ldpVerticalGap ldp
    hh = halfHeight cfig
    hw = halfWidth cfig

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