{-# LANGUAGE TupleSections #-}
module Dodge.Render.HUD
    ( hudDrawings
    )
    where
import Dodge.Data
import Dodge.WinScale
import Dodge.Base
import Dodge.Base.Window
import Dodge.Inventory
import Dodge.Render.Connectors
import Dodge.Render.List
import Picture
import Geometry
import Padding

import Data.Maybe
import qualified Data.IntMap.Strict as IM
import qualified Data.Set as S
import Control.Lens
import SDL (MouseButton (..))
--import Data.Bifunctor

hudDrawings :: Configuration -> World -> Picture
hudDrawings cfig w = pictures
    [ winScale cfig . dShadCol white $ displayHP 0 cfig w
    , renderListAt (halfWidth cfig) 0 cfig $ map (,white) (_testString w w)
    , selectionText
    ]
  where
    selectionText = if _carteDisplay w
        then drawLocations cfig w
        else drawInventory cfig w


drawInventory :: Configuration -> World -> Picture
drawInventory cfig w = subInventoryDisplay cfig w `appendPic` displayInv 0 cfig w

subInventoryDisplay :: Configuration -> World -> Picture
subInventoryDisplay cfig w = case _inventoryMode w of
    LockedInventory -> topInvCursor col iPos cfig w
    TopInventory -> pictures
        [ closeObjectTexts cfig w
        , topInvCursor col iPos cfig w
        ]
    TweakInventory -> pictures
        [ mCurs it cfig w
        , cursorAt 120 col 5 0 iPos cfig
        , cursorsZ cfig iPos it
        , displayMidList cfig (ammoTweakStrings it) "TWEAK"
        ]
    CombineInventory -> invHead cfig "COMBINE"
    InspectInventory -> invHead cfig "INSPECT"
  where 
    itCol = fromMaybe (greyN 0.5) . (^? itInvColor)
    iPos = _crInvSel $ _creatures w IM.! _yourID w
    it = yourItem w
    col = itCol it

cursorsZ :: Configuration -> Int -> Item -> Picture
cursorsZ cfig ipos it = case it ^? itParams . tweakSel of
    Nothing   -> f $ zConnect sp (V2 (155- hw) ( hh - 77.5))
    Just jpos -> f $ zConnect sp (V2 (155 - hw) ( hh - (20 * fromIntegral jpos + 77.5)))
  where
    f = winScale cfig . color white
    hh = halfHeight cfig
    hw = halfWidth  cfig
    sp = V2 (125 - hw) ( hh - (20 * fromIntegral ipos + 17.5))

topInvCursor :: Color -> Int -> Configuration -> World -> Picture
topInvCursor col iPos cfig w 
    | ButtonRight `S.member` _mouseButtons w = 
        cursorAt 100 col 5 0 iPos cfig
        `appendPic` openCursorAt 20 col 105 0 iPos cfig
    | otherwise = mainListCursor col iPos cfig

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

mCurs :: Item -> Configuration -> World -> Picture
mCurs it cfig w = case it ^? itParams . tweakSel of
    Nothing -> []
    Just i 
        | ButtonRight `S.member` _mouseButtons w -> 
            pictures 
            [cursorAt x white y 60 i cfig
            ,openCursorAt 20 white (x+y) 60 i cfig
            ]
        | otherwise -> openCursorAt 140 white 155 60 i cfig
  where
    x = 117.5
    y = 155

pjTweakString :: TweakParam -> String
pjTweakString pj = _showTweak pj $ _curTweak pj

displayMidList :: Configuration -> [String] -> String -> Picture
displayMidList cfig strs s = invHead cfig s
    `appendPic` renderListAt 150 (-60) cfig (strs <&> (,white))

invHead :: Configuration -> String -> Picture
invHead cfig s = winScale cfig 
    . translate (-130) (halfHeight cfig - 40) 
    . dShadCol white
    . scale 0.4 0.4
    $ text s

renderItemMapAt :: Float -> Float -> Configuration -> IM.IntMap Item -> Picture
{-# INLINE renderItemMapAt #-}
renderItemMapAt tx ty cfig = concatMapPic (uncurry $ listItemAt tx ty cfig) . IM.toList

displayInv :: Int -> Configuration -> World -> Picture
displayInv n cfig w = renderItemMapAt 0 0 cfig (_crInv cr)
    <> equipcursor
  where
    equipcursor = case _crLeftInvSel cr of
        Nothing -> mempty
        Just invid -> openCursorAt 20 yellow 105 0 invid cfig
    cr = _creatures w IM.! n

drawLocations :: Configuration -> World -> Picture
drawLocations 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 $ rectNSEW 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
{- | 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

listItemAt
    :: Float    -- ^ x offset
    -> Float    -- ^ y offset
    -> Configuration 
    -> Int      -- ^ y offset (discrete)
    -> Item   -- ^ The item
    -> Picture
{-# INLINE listItemAt #-}
listItemAt xoff yoff w yint
    = winScale w 
    . translate (xoff + 15 - hw) (yoff + hh - (20 * (fromIntegral yint+1)))
    . scale 0.1 0.1
    . itemText
  where
    hw = halfWidth w
    hh = halfHeight w

itemText :: Item -> Picture
{-# INLINE itemText #-}
--itemText NoItem = dShadCol (greyN 0.5) $ text "----"
--itemText it = dShadCol (_itInvColor it) $ text (_itInvDisplay it it)
itemText NoItem = text "----"
itemText it = case _itCurseStatus it of
    UndroppableIdentified -> color black (text (_itInvDisplay it it)) 
        <> color (withAlpha 0.9 thecolor) (polygon (rectNSEW 110 (-65) 885 (-90)))
    _ -> color thecolor $ text (_itInvDisplay it it)
  where
    thecolor = _itInvColor it
    

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)
        ]
cursorAt 
    :: Float    -- ^ Width
    -> Color
    -> Float    -- ^ x offset
    -> Float    -- ^ y offset
    -> Int      -- ^ y offset (discrete)
    -> Configuration 
    -> Picture
cursorAt wth col xoff yoff yint cfig = winScale cfig
    . translate (xoff-halfWidth cfig) (halfHeight cfig - (20* fromIntegral yint + yoff) - 20)
    . color col
    $ line 
        [V2  wth 12.5
        ,V2  0   12.5
        ,V2  0   (-7.5)   
        ,V2  wth (-7.5) 
        ,V2  wth 12.5 
        ]

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