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

import Dodge.SelectionSections.Draw
import Control.Lens
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.Inventory
import Dodge.Item.Info
import Dodge.ListDisplayParams
import Dodge.Render.Connectors
import Dodge.Render.List
import Dodge.Tweak.Show
import Dodge.WorldPos
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 w = winScale cfig . dShadCol white $ displayHP 0 cfig w


drawInventory :: SelectionSections () -> World -> Configuration -> Picture
drawInventory sss w = drawSelectionSections sss (invDisplayParams w)

drawSubInventory :: SubInventory -> Configuration -> World -> Picture
drawSubInventory subinv cfig w = case subinv of
    LockedInventory -> mempty -- topInvCursor col cursPos cfig w
    NoSubInventory -> drawNoSubInventory 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
            , --, _siWidth = length str
              _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

drawNoSubInventory :: Configuration -> World -> Picture
drawNoSubInventory cfig w =
    pictures
        [ equipcursors
        , equipcursor -- the order is important, this should go on top of the other equipcursors
        , rboptions
        ]
  where
    equipcursor = fromMaybe mempty $ do
        invid <- cr ^. crLeftInvSel . lisMPos
        sss <- w ^? hud . hudElement . diSections
        pos <- selSecSelPos 0 invid sss
        return $
            listTextPictureAt 144 0 cfig pos . color cyan . text . eqPosText $
                _crInvEquipped cr IM.! invid
    f col invid epos = fromMaybe mempty $ do
        sss <- w ^? hud . hudElement . diSections
        pos <- selSecSelPos 0 invid sss
        return $ listTextPictureAt 144 0 cfig pos . color col $ text $ eqPosText epos
    equipcursors = IM.foldMapWithKey (f yellow) (_crInvEquipped cr)
    cr = you w
    rboptions
        | ButtonRight `M.member` _mouseButtons (_input w) = drawRBOptions cfig w (_rbOptions w)
        | otherwise = mempty

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 $ listCursorNSW subInvX 60 cfig tweaki 0 white (length $ showTweak tparam) 15

--        , drawSelectionList thirdColumnParams cfig (thirdColumnPara (itmInfo mitm))

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 $
        pictures
            [ fromMaybe mempty $ do
                strs <- si ^? siPayload . ciInfo
                return $ listPicturesAtOff (subInvX + 150) 60 cfig 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 $ selSecDrawCursor 17 [North, South, East] cfig (invDisplayParams w) sss' 0 i

--    fromMaybe mempty $ do
--    i <- mi
--    let cpos = getIthPos i (sm ^. smShownItems)
--    col <- sm ^? smShownItems . ix i . siColor
--    return $
--        pictures
--            [ fromMaybe mempty $ do
--                strs <- sm ^? smShownItems . ix i . siPayload . ciInfo
--                return $ listPicturesAtOff (subInvX + 150) 60 cfig cpos $ map (color red . text) strs
--            , fromMaybe mempty $ do
--                lnks <- sm ^? smShownItems . ix i . siPayload . ciInvIDs
--                return $
--                    lnkMidPosInvSelsCol cfig w cpos col lnks
--                        -- <> foldMap (topCursorTypeWidth listCursorNESW (topInvW + 2) cfig w) lnks
--                        <> foldMap invcursor lnks
--                        <> combineCounts cfig w lnks
--            ]
--  where
--    invcursor i = fromMaybe mempty $ do
--        sss <- w ^? hud . hudElement . diSections
--        return $ selSecDrawCursor 17 [North,South,East] cfig (invDisplayParams w) sss 0 i

--thirdColumnPara :: [String] -> SelectionList ()
--thirdColumnPara strs = SelectionList (map f strs) Nothing (length strs)
--  where
--    f str =
--        SelectionItem
--            { _siPictures = [text str]
--            , _siHeight = 1
--            , _siIsSelectable = True
--            , _siWidth = length str
--            , _siColor = white
--            , _siOffX = 0
--            , _siPayload = ()
--            }

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)
            , drawSelectionList secondColumnParams cfig (thesellist tm)
            ]
  where
    --toselitm (str, col) = SelectionItem [str] 1 True (length str) col 0 ()
    toselitm (str, col) = SelectionItem [str] 1 True col 0 ()
    thesellist tm =
        defaultSelectionList
            { _slItems = thelist tm
            --        , _slLength = length (thelist tm)
            }
    thelist tm =
        map toselitm . displayTermInput tm
            . reverse
            . take (_tmMaxLines tm)
            $ _tmDisplayedLines tm
    displayTermInput tm = case _tmInput tm of
        TerminalInput s hasfoc _ -> (++ [(displayInputText tm s ++ displayBlinkCursor hasfoc, white)])
    displayInputText tm s
        | _tmStatus tm == TerminalReady = '>' : 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} =
    fromMaybe mempty $ do
        sss <- w ^? hud . hudElement . diSections
        (i', j) <- sss ^? sssExtra . sssSelPos . _Just
        curpos <- selSecSelPos i' j sss
        let midtext str = listTextPictureAt 252 0 cfig curpos (text str)
        let extratext str = listTextPictureAt 432 0 cfig curpos (text (str ++ deactivatetext))
        return $
            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
    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)
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"

combineCounts :: Configuration -> World -> [Int] -> Picture
combineCounts cfig w = winScale cfig . 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 =
    winScale cfig
        . 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 =
    winScale 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 $
        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 ^. 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)) :
    [foldMap (drawMapWall cfig (w ^. hud)) $ IM.restrictKeys (lw ^. walls) (w ^. cWorld . seenWalls)]
  where
    --(mapMaybe (mapWall cfig (w ^. hud)) . IM.elems $ w ^. cWorld . lWorld . walls)

    lw = w ^. cWorld . lWorld

drawMapWall :: Configuration -> HUD -> Wall -> Picture
drawMapWall cfig thehud wl = color c . polygon $ map (cartePosToScreen cfig 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
        , --, _siWidth = wdth
          _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 =
    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 =
    translate (halfWidth cfig -80) (halfHeight cfig -20)
        . scale 0.2 0.2
        . text
        . leftPad 5 ' '
        . show
        . (^?! cWorld . lWorld . creatures . ix cid . crHP)