--{-# LANGUAGE TupleSections #-}
module Dodge.Render.HUD
    ( hudDrawings
    ) where
import Dodge.Data
import Dodge.Item.Display
import Dodge.Combine
import Dodge.Clock
import Dodge.Base
--import Dodge.InputFocus
--import Dodge.Combine.Combinations
import Dodge.Inventory
import Dodge.Inventory.ItemSpace
import Dodge.Render.Connectors
import Dodge.Render.List
import Picture
import Geometry
import Padding
import ListHelp

import qualified Data.Vector as V
--import Data.Foldable
import Data.Maybe
import qualified Data.IntMap.Strict as IM
import qualified Data.Map.Strict as M
--import qualified Data.Set as S
--import qualified Data.IntSet as IS
import Control.Lens
import SDL (MouseButton (..))
import qualified Data.Text as T
--import Data.List
--import Data.Bifunctor

hudDrawings :: Configuration -> World -> Picture
hudDrawings cfig w = case _hudElement $ _hud w of
    DisplayCarte -> drawCarte cfig w
    DisplayInventory subinv -> drawInGameHUD cfig w
        <> subInventoryDisplay subinv cfig w

drawInGameHUD :: Configuration -> World -> Picture
drawInGameHUD cfig w = pictures
    [ winScale cfig . dShadCol white $ displayHP 0 cfig w
    , listPicturesAt (halfWidth cfig) 0 cfig $ map text (_testString w cfig w)
    , inventoryDisplay cfig w
    ]

inventoryDisplay :: Configuration -> World -> Picture
inventoryDisplay cfig w = listPicturesAt 0 0 cfig invlist
  where
    cr = you w
    inv = _crInv cr
    invlist = concatMap (itemText' cr) (IM.toList inv)
        ++ displayFreeSlots
        ++ concatMap (closeObjectToTextPictures nfreeslots) (_closeObjects w)
--        ++ map floorItemsColor (concatMap (closeObjectToTextPictures nfreeslots) (_closeObjects w))
--    floorItemsColor = case _hudElement (_hud w) of
--        DisplayInventory NoSubInventory -> id
--        _ -> color invDimColor
    nfreeslots = crNumFreeSlots cr
    displayFreeSlots = case nfreeslots of
        0 -> [color invDimColor . text $ "  INVENTORY FULL"]
        1 -> [color invDimColor . text $ "  +1 FREE SLOT"]
        x -> [color invDimColor . text $ "  +" ++ show x ++ " FREE SLOTS"]

subInventoryDisplay :: SubInventory -> Configuration -> World -> Picture
subInventoryDisplay subinv cfig w = case subinv of
    LockedInventory -> mempty -- topInvCursor col cursPos cfig w
    NoSubInventory -> pictures
        [ selcursor
        , closeobjectcursor
        , equipcursors
        , equipcursor -- the order is important, this should go on top of the other equipcursors
        , rboptions
        ]
    TweakInventory -> pictures
        --[ mCurs it cfig w
        [ selcursor' listCursorNESW
--        , cursorsZ cfig curpos it
        , fromMaybe mempty $ do
            tweaki <-  it ^? _Just . itTweaks . tweakSel
                -- consider moving this functionality out into a tweaks module
            showtweak <- it ^? _Just . itTweaks . tweakParams . ix tweaki . showTweak
            tweakname <- it ^? _Just . itTweaks . tweakParams . ix tweaki . nameTweak
            tweakstring <- showtweak <$> (it ^? _Just . itTweaks . tweakParams . ix tweaki . curTweak)
            return $ lnkMidInvSel cfig w curpos tweaki
                <> listCursorNSW subInvX 60 cfig tweaki white (length $ tweakstring ++ tweakname) 1
        , invHead cfig "TWEAK"
        , listPicturesAt subInvX 60 cfig $ map text (ammoTweakStrings it)
        ]
    DisplayTerminal tid -> displayTerminal tid cfig w
    CombineInventory mi -> pictures
        [ invHead cfig "COMBINE"
        , listPicturesAt subInvX 60 cfig $ combineListStringPictures 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 -> mconcat
        [ selcursor' listCursorNESW
        , invHead cfig "INSPECT"
        , listPicturesAt subInvX 60 cfig $ map text (itmInfo it)
        ]
  where 
    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
    selcursor = selcursor' selcursortype
    selcursortype
        | ButtonRight `M.member` _mouseButtons w = listCursorNESW
        | otherwise = listCursorNSW
    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 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 -> World -> 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 . itConsumption of
        Just ItemItselfConsumable{} -> 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 w 
        then 47
        else topInvW

--listSelHeight :: Configuration -> World -> Int -> Float
--listSelHeight

combineListStringPictures :: World -> [Picture]
combineListStringPictures w = case concatMap (itemText . snd) . combineItemListYou $ w of
    [] -> [text "NO POSSIBLE COMBINATIONS"]
    xs -> xs

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 ' ' (_nameTweak tp) ++ " " ++ _showTweak tp (_curTweak 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
closeObjectToTextPictures :: Int -> Either FloorItem Button -> [Picture]
closeObjectToTextPictures nfreeslots e = case e of
    Left flit -> let it = _flIt flit in map (applycolor it . textindent) $ itemDisplay it
    Right bt  -> [color yellow $ textindent $ _btText bt]
  where
    textindent = text . (replicate clObjIntIn ' '++)
    applycolor it
        | nfreeslots >= itSlotsTaken it = color $ _itInvColor it
        | otherwise = color 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 = _selLocation w
    locs = map (\(_,s) -> (s,white)) . IM.elems . _seenLocations $ w
    locPoss = map (cartePosToScreen cfig w . ($ w) . fst) . IM.elems . _seenLocations $ 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) . IM.elems $ _walls w)

mapWall :: Configuration -> World -> Wall -> Maybe Picture
mapWall cfig w wl =
    if _wlSeen wl
    then Just . color c . polygon $ map (cartePosToScreen cfig w) [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

itemText' :: Creature -> (Int,Item) -> [Picture]
{-# INLINE itemText' #-}
itemText' cr (i,it) = f $ case _itCurseStatus it of
    UndroppableIdentified -> map (color yellow . text) (itemDisplay it)
    _ | crSel cr == i -> map (color thecolor . text) (selectedItemDisplay cr it)
    _ -> map (color thecolor . text) (itemDisplay it)
  where
    thecolor = _itInvColor it
    f = take (itSlotsTaken it) . (++ replicate 10 (color (_itInvColor it) $ text "*"))



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 
    :: Float    -- ^ Width
    -> Color
    -> Float    -- ^ x offset
    -> Float    -- ^ y offset
    -> Int      -- ^ y offset (discrete)
    -> 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
    . _crHP 
    $ _creatures w IM.! cid
