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

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.List
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 . displayHP 0 cfig

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 midtext str = toTopLeft cfig $ translate 252 0 $ drawListElement 10 1 curpos (text str)
    let extratext str = toTopLeft cfig $ translate 432 0 $ drawListElement 10 1 curpos (text (str ++ deactivatetext))
    return $
        toTopLeft cfig (translate 342 0 $ drawListYoff (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
    deactivatetext = case w ^? rbOptions . opActivateEquipment . deactivateEquipment of
        Just k -> " DEACTIVATES " ++ show (_iyBase $ _itType (_crInv (you w) IM.! k))
        Nothing -> ""
    otheritem j = show $ _iyBase $ _itType (_crInv (you w) IM.! j)

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
        return $ toTopLeft cfig $ selSecDrawCursor 17 [North, South, East] (invDisplayParams w) 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 =
    translate (- halfWidth cfig + subInvX + 20) (halfHeight cfig - 40)
        . dShadCol white
        . scale 0.4 0.4
        . text

drawCarte :: Configuration -> World -> Picture
drawCarte cfig w =
    pictures $
        toTopLeft cfig (renderListAt 0 0 locs) :
        mapOverlay 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 ^. 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 :: World -> [Picture]
mapOverlay w =
    (color (withAlpha 0.5 black) . polygon $ reverse $ rectNSWE 1 (-1) 1 (-1)) :
    [foldMap (drawMapWall (w ^. hud)) $ IM.restrictKeys (lw ^. walls) (w ^. cWorld . seenWalls)]
  where
    lw = w ^. cWorld . lWorld
    --(mapMaybe (mapWall cfig (w ^. hud)) . IM.elems $ w ^. cWorld . lWorld . walls)

drawMapWall :: HUD -> Wall -> Picture
drawMapWall thehud wl = color c . polygon $ map (cartePosToScreen thehud) [x, x +.+ n2, y +.+ n2, y]
  where
    t = normalizeV (y -.- x)
    n2 = 20 *.* vNormal t
    (x, y) = _wlLine wl
    c = _wlColor wl

--mapWall :: Configuration -> HUD -> Wall -> Maybe Picture
--mapWall cfig thehud wl
--    | _wlSeen wl = Just . color c . polygon $ map (cartePosToScreen cfig thehud) [x, x +.+ n2, y +.+ n2, y]
--    | otherwise  = 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

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

picsToSelectable :: [String] -> SelectionItem ()
picsToSelectable pics =
    SelectionItem
        { _siPictures = pics
        , _siHeight = length pics
        , _siIsSelectable = True
        , _siColor = white
        , _siOffX = 0
        , _siPayload = ()
        }

openCursorAt ::
    -- | Width
    Float ->
    Color ->
    -- | x offset
    Float ->
    -- | y offset
    Float ->
    -- | y offset (discrete)
    Int ->
    Configuration ->
    Picture
openCursorAt wth col xoff yoff yint 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 =
    translate (halfWidth cfig -80) (halfHeight cfig -20)
        . scale 0.2 0.2
        . text
        . leftPad 5 ' '
        . show
        . (^?! cWorld . lWorld . creatures . ix cid . crHP)

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