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

import Dodge.Data.CardinalPoint
import Dodge.Data.SelectionList
import Control.Lens
import qualified Data.Map.Strict as M
import Data.Maybe
import qualified Data.Text as T
import qualified Data.Vector as V
import Dodge.Base
import Dodge.Clock
import Dodge.Combine
import Dodge.Data.Universe
import Dodge.Inventory
import Dodge.Inventory.ItemSpace
import Dodge.Item.Display
import Dodge.Render.Connectors
import Dodge.Render.List
import Dodge.Tweak.Show
import Dodge.WorldPos
import Geometry
import qualified IntMapHelp as IM
import ListHelp
import Padding
import Picture
import SDL (MouseButton (..))
import qualified Data.Set as Set

hudDrawings :: Universe -> Picture
hudDrawings uv = case w ^. cWorld . lWorld . hud . hudElement of
    DisplayCarte -> drawCarte cfig w
    DisplayInventory subinv ->
        drawInGameHUD subinv uv
            <> subInventoryDisplay subinv cfig w
  where
    w = _uvWorld uv
    cfig = _uvConfig uv

drawInGameHUD :: SubInventory -> Universe -> Picture
drawInGameHUD subinv uv =
    pictures
        [ winScale cfig . dShadCol white $ displayHP 0 cfig w
        , listPicturesAt (halfWidth cfig) 0 cfig $ map text (_uvTestString uv uv)
        , inventoryDisplay subinv cfig w
        ]
  where
    w = _uvWorld uv
    cfig = _uvConfig uv

defaultSelectionList :: SelectionList
defaultSelectionList = SelectionList
    { _slVerticalGap = 10
    , _slScale = 1
    , _slPosX = 0
    , _slPosY = 0
    , _slOffset = 0
    , _slItems = []
    , _slSelPos = Nothing
    , _slCursorType = NoCursor
    , _slWidth = FixedSelectionWidth 15
    }

subInvSelectionList :: SelectionList
subInvSelectionList = SelectionList
    { _slVerticalGap = 10
    , _slScale = 1
    , _slPosX = subInvX
    , _slPosY = 60
    , _slOffset = 0
    , _slItems = []
    , _slSelPos = Nothing
    , _slCursorType = NoCursor
    , _slWidth = FixedSelectionWidth 15
    }

inventorySelectionList :: World -> [SelectionItem]
inventorySelectionList w = map (invSelectionItem cr) (IM.toList inv)
    ++ [SelectionItem displayFreeSlots 1 False (length thetext) white 0]
            ++ map (closeObjectToSelectionItem nfreeslots) (w ^. cWorld . lWorld . closeObjects)
  where
    cr = you w
    inv = _crInv cr
    nfreeslots = crNumFreeSlots cr
    thetext = case nfreeslots of
        0 -> "  INVENTORY FULL"
        1 -> "  +1 FREE SLOT"
        x -> "  +" ++ show x ++ " FREE SLOTS"
    displayFreeSlots = [color invDimColor $ text thetext]

inventoryCursorPos :: SubInventory -> World -> Maybe Int
inventoryCursorPos subinv w = case subinv of
    CombineInventory {} -> Nothing
    _ -> Just $ yourInvSel w

inventoryDisplay :: SubInventory -> Configuration -> World -> Picture
inventoryDisplay subinv cfig w = drawSelectionList cfig $
    defaultSelectionList & slItems .~ inventorySelectionList w
        & slWidth .~ FixedSelectionWidth topInvW
        & slCursorType .~ BorderCursor (Set.fromList selcursortype)
        & slSelPos .~ inventoryCursorPos subinv w
        & slWidth .~ FixedSelectionWidth (determineInvSelCursorWidth w)
  where
    selcursortype
        | ButtonRight `M.member` _mouseButtons (_input w) = [North,South,East,West]
        | otherwise = [North,South,West]

subInventoryDisplay :: SubInventory -> Configuration -> World -> Picture
subInventoryDisplay subinv cfig w = case subinv of
    LockedInventory -> mempty -- topInvCursor col cursPos cfig w
    NoSubInventory ->
        pictures
            [ closeobjectcursor
            , equipcursors
            , equipcursor -- the order is important, this should go on top of the other equipcursors
            , rboptions
            ]
    TweakInventory mtweaki ->
        titledSub "TWEAK" (subInvSelectionList & slItems .~ ammoTweakSelectionItems it)
            [ selcursor' listCursorNESW
            , fromMaybe mempty $ do
                tweaki <- mtweaki
                -- consider moving this functionality out into a tweaks module
                tparam <- it ^? _Just . itTweaks . tweakParams . ix tweaki
                return $
                    lnkMidInvSel cfig w curpos tweaki
                        <> listCursorNSW subInvX 60 cfig tweaki white (length $ showTweak tparam) 1
            ]
    DisplayTerminal tid -> displayTerminal tid cfig (w ^. cWorld . lWorld)
    CombineInventory mi ->
        titledSub "COMBINE" (combineListSelection w)
            [ fromMaybe mempty $ do
                i <- mi
                cpos <- combinePoss w !? i
                col <- (combineItemListYou w !? i) <&> _itInvColor . snd
                return $
                    pictures
                        [ fromMaybe mempty $ do
                            strs <- fmap (fst . snd) (combineListInfo w !? i)
                            return $ listPicturesAtOff (subInvX + 150) 60 cfig cpos $ map (color red . text) strs
                        , fromMaybe mempty $ do
                            csize <- combineSizes w !? i
                            return $ listCursorNSW subInvX 60 cfig cpos col 15 csize
                        , fromMaybe mempty $ do
                            lnks <- map fst (combineItemListYou w) !? i
                            return $
                                lnkMidPosInvSelsCol cfig w cpos col lnks
                                    <> foldMap (topCursorTypeWidth listCursorNESW (topInvW + 2) cfig w) lnks
                                    <> combineCounts cfig w lnks
                        ]
            ]
    InspectInventory ->
        titledSub "INSPECT" (subInvSelectionList & slItems .~ textSelItems (itmInfo it))
            [ selcursor' listCursorNESW
            ]
  where
    titledSub subtitle subitems extrapics = pictures $ [invHead cfig subtitle
        ,drawSelectionList cfig subitems] <>
        extrapics
    closeobjectcursor = case selectedCloseObject w of
        Nothing -> mempty
        Just (i, co) ->
            listCursorNS
                clObjFloatIn
                0
                cfig
                (selNumPos i w)
                (closeObjectCol co)
                topInvW
                (invSelSize i w)
    itcol = fromMaybe (greyN 0.5) (it ^? _Just . itInvColor)
    cr = you w
    it = yourItem w
    selcursor' ct = fromMaybe mempty $ ct 0 0 cfig curpos itcol (determineInvSelCursorWidth w) cury <$ it
    curpos = invSelPos w
    cury = fromMaybe 1 $ augmentedInvSizes w IM.!? crSel (you w)
    equipcursor = case _crLeftInvSel cr of
        Just invid -> f cyan invid (_crInvEquipped cr IM.! invid)
        _ -> mempty
    equipcursors = IM.foldMapWithKey (f yellow) (_crInvEquipped cr)
    f col invid epos = listTextPictureAt 144 0 cfig (selNumPos invid w) . color col $ text $ eqPosText epos
    rboptions =
        if ButtonRight `M.member` _mouseButtons (_input w)
            then drawRBOptions cfig w (_rbOptions w)
            else mempty

itmInfo :: Maybe Item -> [String]
itmInfo mit = fromMaybe [] $ do
    itm <- mit
    return (map show . M.assocs . _iyModules $ _itType itm)

displayTerminal :: Int -> Configuration -> LWorld -> Picture
displayTerminal tid cfig w = fromMaybe mempty $ do
    tm <- w ^? terminals . ix tid
    return $
        pictures
            [ invHead cfig (_tmTitle tm ++ ":T" ++ show tid)
            , renderListAt subInvX 60 cfig
                . displayTermInput tm
                . reverse
                . take (_tmMaxLines tm)
                $ _tmDisplayedLines tm
            ]
  where
    displayTermInput tm = case _tmInput tm of
        TerminalInput s hasfoc _ -> (++ [(displayInputText tm s ++ displayBlinkCursor hasfoc, white)])
    displayInputText tm s
        | _tmStatus tm == TerminalReady = '>' : T.unpack s
        | otherwise = ""
    displayBlinkCursor hasfoc
        | hasfoc = clockCycle 10 (V.fromList ["_", ""]) w
        | otherwise = []

drawRBOptions :: Configuration -> World -> RightButtonOptions -> Picture
drawRBOptions cfig w EquipOptions{_opEquip = es, _opSel = i, _opAllocateEquipment = ae} =
    listPicturesAtOff 342 0 cfig (curpos - i) (map (text . eqPosText) es)
        <> case ae of
            DoNotMoveEquipment -> mempty
            PutOnEquipment{} ->
                midtext "PUT ONTO"
            MoveEquipment{} ->
                midtext "MOVE  TO" <> extratext []
            SwapEquipment{_allocOldPos = oldp, _allocSwapID = sid} ->
                midtext "MOVE  TO" <> extratext ("SWAPS " ++ otheritem sid ++ " ONTO " ++ eqPosText oldp)
            ReplaceEquipment{_allocRemoveID = rid} ->
                midtext "PUT ONTO" <> extratext ("REMOVES " ++ otheritem rid)
            RemoveEquipment{} ->
                midtext "TAKE OFF"
  where
    midtext str = listTextPictureAt 252 0 cfig curpos (text str)
    extratext str = listTextPictureAt 432 0 cfig curpos (text (str ++ deactivatetext))
    deactivatetext = case w ^? rbOptions . opActivateEquipment . deactivateEquipment of
        Just k -> " DEACTIVATES " ++ show (_iyBase $ _itType (_crInv (you w) IM.! k))
        Nothing -> ""
    curpos = invSelPos w
    otheritem j = show $ _iyBase $ _itType (_crInv (you w) IM.! j)
drawRBOptions _ _ _ = mempty

eqPosText :: EquipPosition -> String
eqPosText ep = case ep of
    OnHead -> "HEAD"
    OnChest -> "CHEST"
    OnBack -> "BACK"
    OnLeftWrist -> "L.WRIST"
    OnRightWrist -> "R.WRIST"
    OnLegs -> "LEGS"
    OnSpecial -> "EQUIPPED"

topInvW :: Int
topInvW = 15

subInvX :: Float
subInvX = 9 * fromIntegral topInvW + 50

lnkMidInvSel :: Configuration -> World -> Int -> Int -> Picture
lnkMidInvSel cfig w lefti midi =
    winScale cfig
        . color white
        . zConnect rp
        $ selNumMidHeight cfig w lefti
  where
    --    lp ipos = V2 (150 - hw) ( hh - (20 * fromIntegral ipos + 17.5))
    rp = V2 (190 - hw) (hh - (20 * fromIntegral midi + 77.5))
    hh = halfHeight cfig
    hw = halfWidth cfig

--lnkMidPosInvSels :: Configuration -> World -> Int -> [Int] -> Picture
--lnkMidPosInvSels cfig w i = winScale cfig
--    . color white
--    . concatMap (zConnect rp . selNumMidHeight cfig w)
--  where
----    lp ipos = V2 (150 - hw) ( hh - (20 * fromIntegral ipos + 17.5))
--    rp = V2 (190 - hw) ( hh - (20 * fromIntegral i + 77.5))
--    hh = halfHeight cfig
--    hw = halfWidth  cfig

combineCounts :: Configuration -> World -> [Int] -> Picture
combineCounts cfig w = winScale cfig . foldMap f . group
  where
    f (i : is) = case yourInv w ^? ix i . itUse . useAmount of
        Just _ -> color (selNumCol i w) $ uncurryV translate (selNumTextPos cfig w i) . scale 0.1 0.1 . text $ ('-' : show (length is + 1))
        _ -> mempty
    f _ = mempty

lnkMidPosInvSelsCol :: Configuration -> World -> Int -> Color -> [Int] -> Picture
lnkMidPosInvSelsCol cfig w i col =
    winScale cfig
        . foldMap (\j -> zConnectCol rp (V2 18 0 + selNumMidHeight cfig w j) col white white (selNumCol j w))
  where
    --    lp ipos = V2 (150 - hw) ( hh - (20 * fromIntegral ipos + 17.5))
    rp = V2 (190 - hw) (hh - (20 * fromIntegral i + 77.5))
    hh = halfHeight cfig
    hw = halfWidth cfig

topCursorTypeWidth ::
    (Float -> Float -> Configuration -> Int -> Color -> Int -> Int -> Picture) ->
    Int ->
    Configuration ->
    World ->
    Int ->
    Picture
topCursorTypeWidth ctype width cfig w i =
    ctype 0 0 cfig (selNumPos i w) (selNumCol i w) width (selNumSlots i w)

determineInvSelCursorWidth :: World -> Int
determineInvSelCursorWidth w = case _rbOptions w of
    NoRightButtonOptions -> topInvW
    EquipOptions{} ->
        if ButtonRight `M.member` _mouseButtons (_input w)
            then 47
            else topInvW

combineListSelection :: World -> SelectionList
combineListSelection w = subInvSelectionList & slItems .~ combineListSelectionItems w

combineListSelectionItems :: World -> [SelectionItem]
combineListSelectionItems w = case combineListSelectionItems' w of
    [] -> [SelectionItem [text thetext] 1 False (length thetext) white 0]
    xs -> xs
  where
    thetext = "NO POSSIBLE COMBINATIONS"
    

combineListSelectionItems' :: World -> [SelectionItem]
combineListSelectionItems' w = map (picsToSelectable 15 . itemText . snd) $ combineItemListYou w

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 s =
    winScale cfig
        . translate (- halfWidth cfig + subInvX + 20) (halfHeight cfig - 40)
        . dShadCol white
        . scale 0.4 0.4
        $ text s

invDimColor :: Color
invDimColor = greyN 0.7

closeObjectToSelectionItem :: Int -> Either FloorItem Button -> SelectionItem
closeObjectToSelectionItem n e = SelectionItem
    { _siPictures = pics
    , _siHeight = length pics
    , _siIsSelectable = True
    , _siWidth = 15
    , _siColor = col
    , _siOffX = 2
    }
  where
    (pics,col) = closeObjectToTextPictures' n e

closeObjectToTextPictures' :: Int -> Either FloorItem Button -> ([Picture],Color)
closeObjectToTextPictures' nfreeslots e = case e of
    Left flit -> let it = _flIt flit 
        in (map (applycolor it . textindent) $ itemDisplay it, thecol it)
    Right bt -> ([color yellow $ textindent $ _btText bt], yellow)
  where
    textindent = text . (replicate clObjIntIn ' ' ++)
    applycolor it
        | nfreeslots >= itSlotsTaken it = color $ _itInvColor it
        | otherwise = color invDimColor
    thecol it
        | nfreeslots >= itSlotsTaken it = _itInvColor it
        | otherwise = invDimColor

clObjIntIn :: Int
clObjIntIn = 2

clObjFloatIn :: Float
clObjFloatIn = fromIntegral clObjIntIn * 9

drawCarte :: Configuration -> World -> Picture
drawCarte cfig w =
    pictures $
        renderListAt 0 0 cfig locs :
        zipWith bConnect (displayListEndCoords cfig locTexts) locPoss
            ++ mapOverlay cfig w
            ++ [mainListCursor white iPos cfig]
  where
    iPos = w ^. cWorld . lWorld . selLocation
    locs = map (\(_, s) -> (s, white)) . IM.elems . _seenLocations . _lWorld $ _cWorld w
    locPoss = map (cartePosToScreen cfig (w ^. cWorld . lWorld . 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

mapOverlay :: Configuration -> World -> [Picture]
mapOverlay cfig w =
    (color (withAlpha 0.5 black) . polygon $ reverse $ rectNSWE 1 (-1) 1 (-1)) :
    (mapMaybe (mapWall cfig (w ^. cWorld . lWorld . hud)) . IM.elems $ w ^. cWorld . lWorld . walls)

mapWall :: Configuration -> HUD -> Wall -> Maybe Picture
mapWall cfig thehud wl =
    if _wlSeen wl
        then Just . color c . polygon $ map (cartePosToScreen cfig thehud) [x, x +.+ n2, y +.+ n2, y]
        else Nothing
  where
    t = normalizeV (y -.- x)
    n2 = 20 *.* vNormal t
    (x, y) = _wlLine wl
    c = _wlColor wl

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

mainListCursor :: Color -> Int -> Configuration -> Picture
mainListCursor c = openCursorAt 120 c 5 0

picsToSelectable :: Int -> [Picture] -> SelectionItem
picsToSelectable wdth pics = SelectionItem
    { _siPictures = pics
    , _siHeight = length pics
    , _siIsSelectable = True
    , _siWidth = wdth
    , _siColor = white
    , _siOffX = 0
    }

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

invSelectionItem :: Creature -> (Int,Item) -> SelectionItem
invSelectionItem cr (i,it) = SelectionItem
    { _siPictures = pics
    , _siHeight = length pics
    , _siIsSelectable = True
    , _siWidth = 15
    , _siColor = col
    , _siOffX = 0
    }
  where
    col = _itInvColor it
    pics = take (itSlotsTaken it) . (++ replicate 10 (color col $ text "*")) $ case _itCurseStatus it of
        UndroppableIdentified -> map (color yellow . text) (itemDisplay it)
        _ | crSel cr == i -> map (color col . text) (selectedItemDisplay cr it)
        _ -> map (color col . text) (itemDisplay it)

itemText :: Item -> [Picture]
{-# INLINE itemText #-}
itemText it = f $ case _itCurseStatus it of
    UndroppableIdentified -> map (color yellow . text) (itemDisplay it)
    --        <> color (withAlpha 0.9 thecolor) (polygon (rectNSEW 110 (-65) 885 (-90)))
    _ -> map (color thecolor . text) (itemDisplay it)
  where
    thecolor = _itInvColor it
    f = take (itSlotsTaken it) . (++ replicate 10 (color (_itInvColor it) $ text "*"))

openCursorAt ::
    -- | Width
    Float ->
    Color ->
    -- | x offset
    Float ->
    -- | y offset
    Float ->
    -- | y offset (discrete)
    Int ->
    Configuration ->
    Picture
openCursorAt wth col xoff yoff yint w =
    winScale w
        . translate (xoff - halfWidth w) (halfHeight w - (20 * fromIntegral yint + yoff) - 20)
        $ lineCol
            [ (V2 wth 12.5, withAlpha 0 col)
            , (V2 0 12.5, col)
            , (V2 0 (-7.5), col)
            , (V2 wth (-7.5), withAlpha 0 col)
            ]

displayHP :: Int -> Configuration -> World -> Picture
displayHP cid cfig w =
    translate (halfWidth cfig -80) (halfHeight cfig -20)
        . scale 0.2 0.2
        . text
        . leftPad 5 ' '
        . show
        $ w ^?! cWorld . lWorld . creatures . ix cid . crHP