{-# LANGUAGE TupleSections #-}
module Dodge.Render.HUD
    ( hudDrawings
    )
    where
import Dodge.Data
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 :: World -> Picture
hudDrawings w = pictures
    [ winScale w . dShadCol white $ displayHP 0 w
    , renderListAt (halfWidth w) 0 w $ map (,white) (_testString w w)
    , selectionText
    ]
  where
    selectionText = 
        if _carteDisplay w
        then drawLocations w
        else drawInventory w


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

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

cursorsZ :: World -> Int -> Item -> Picture
cursorsZ w ipos it = case it ^? wpAmmo . amParamSel 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 w . color white
    hh = halfHeight w
    hw = halfWidth w
    sp = V2 (125 - hw) ( hh - (20 * fromIntegral ipos + 17.5))

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

ammoTweakStrings :: Item -> [String]
ammoTweakStrings it = case it ^? wpAmmo . amPjParams of
    Just l -> map pjTweakString l
    _ -> ["NOT TWEAKABLE"]

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

pjTweakString :: PjParam -> String
pjTweakString pj = _pjDisplayParam pj $ _pjIntParam pj

displayMidList :: World -> [String] -> String -> Picture
displayMidList w strs s =
    invHead w s
    `appendPic` renderListAt 150 (-60) w (map (,white) strs)

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

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

displayInv :: Int -> World -> Picture
displayInv n w = renderItemMapAt 0 0 w items
  where 
    items = _crInv $ _creatures w IM.! n

drawLocations :: World -> Picture
drawLocations w = pictures $ 
    renderListAt 0 0 w locs
    : zipWith bConnect (displayListEndCoords w locTexts) locPoss
    ++ mapOverlay w
    ++ [mainListCursor white iPos w]
  where
    iPos = _selLocation w
    locs = map (\(_,s) -> (s,white)) . IM.elems . _seenLocations $ w
    locPoss = map (cartePosToScreen w . ($ w) . fst) . IM.elems . _seenLocations $ w
    locTexts = map fst locs

displayListEndCoords :: World -> [String] -> [Point2]
displayListEndCoords w ss = map g $ zipWith h ss $ map f [1..]
  where 
    f :: Int -> Point2
    f i = V2 ( 15 - halfWidth w ) ( 2.5 + halfHeight w - (20 * fromIntegral i))
    g (V2 x y) = V2 (2*x / getWindowX w) ( 2*y / getWindowY w)
    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 $ rectNSEW 1 (-1) (-1) 1) : 
            (mapMaybe (mapWall w) . IM.elems $ _walls w)

mapWall :: World -> Wall -> Maybe Picture
mapWall w wl =
    if _wlSeen wl
    then Just . color c . polygon $ map (cartePosToScreen 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 :: World -> Picture
closeObjectTexts w = pictures $ 
    renderListAt pushout (negate 20 * fromIntegral invPos)
        w (map colAndText $ _closeActiveObjects 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 $ _closeActiveObjects 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 w)
                     ( halfHeight w - 20* (fromIntegral invPos +1) + 2.5)
          return . winScale w . color col $ lConnect p itScreenPos

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

listItemAt
    :: Float    -- ^ x offset
    -> Float    -- ^ y offset
    -> World 
    -> 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 = color (_itInvColor it) $ text (_itInvDisplay it it)

openCursorAt 
    :: Float    -- ^ Width
    -> Color
    -> Float    -- ^ x offset
    -> Float    -- ^ y offset
    -> Int      -- ^ y offset (discrete)
    -> World 
    -> 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)
    -> World 
    -> Picture
cursorAt wth col xoff yoff yint w = winScale w
    . translate (xoff-halfWidth w) (halfHeight w - (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 -> World -> Picture
displayHP n w = translate (halfWidth w-80) (halfHeight w-20) 
    . scale 0.2 0.2 
    . text
    . leftPad 5 ' ' 
    . show
    . _crHP 
    $ _creatures w IM.! n
