{-# LANGUAGE TupleSections #-}
module Dodge.Render.HUD
    where
import Dodge.Data
import Dodge.Base
import Dodge.Base.Window
import Dodge.Inventory
import Picture
import Geometry

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

winScale :: World -> Picture -> Picture
winScale w = scale (2 / getWindowX w) (2 / getWindowY w)

hudDrawings :: World -> Picture
hudDrawings w = pictures $
    [ winScale w . dShadCol white $ displayHP 0 w
    , winScale w . translate (-390) 20 . scale 0.05 0.05 . dShadCol white $ text (_testString w)
    ] 
    ++ selectionText
  where
    selectionText = 
        if _carteDisplay w
        then drawLocations w
        else drawInventory w

drawInventory :: World -> [Picture]
drawInventory w = case _inventoryMode w of
    TopInventory -> [ closeObjectTexts w]
        ++ topInvCursor col iPos w
        ++ displayInv 0 w
    TweakInventory   -> 
        mCurs it w
        ++ [cursorAt 120 col 5 0 iPos w
            ,cursorsZ w iPos it
            ]
        ++ displayInv 0 w 
        ++ displayMidList w (ammoTweakStrings it) "TWEAK"
    CombineInventory -> displayInv 0 w ++ invHead w "COMBINE"
    InspectInventory -> displayInv 0 w ++ 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 -> winScale w $ zDraw sp (V2 (155- hw) ( hh - 77.5))
    Just jpos -> winScale w $ zDraw sp (V2 (155 - hw) ( hh - (20 * fromIntegral jpos + 77.5)))
  where
    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
        ,openCursorAt 20 col 105 0 iPos w]
    | otherwise = [ openCursorAt 120 col 5 0 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 -> 
            [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

zDraw :: Point2 -> Point2 -> Picture
zDraw (V2 x y) (V2 a b) = line $ map toV2
    [(x,y)
    ,(0.5 * (x+a), y)
    ,(0.5 * (x+a), b)
    ,(a, b)
    ]

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

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

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

displayListTopLeft :: [(String,Color)] -> World -> [Picture]
displayListTopLeft = renderListAt (V2 0 0) 

renderListAt :: Point2 -> [(String,Color)] -> World -> [Picture]
renderListAt (V2 tx ty) scols w =
    map (winScale w) $ zipWith 
        (translate (tx + 15-halfWidth w))
        ( map (\x -> ty + halfHeight w - (20 * (fromIntegral x+1)))    ([0..]::[Int]) )
        ( map (\(s,col) -> scale 0.1 0.1 . dShadCol col $ text s) scols )

displayInv :: Int -> World -> [Picture]
displayInv n w = displayListTopLeft scols w
  where 
    scols = map itemStringCol . IM.elems . _crInv $ _creatures w IM.! n

itemStringCol :: Item -> (String,Color)
itemStringCol NoItem    = ("----", greyN 0.5)
itemStringCol itm       = (_itInvDisplay itm itm, _itInvColor itm)

drawLocations :: World -> [Picture]
drawLocations wrld = displayListTopLeft locs wrld
    ++ zipWith bFunc (displayListEndCoords wrld locTexts) locPoss
    ++ mapOverlay wrld
    ++ [drawListCursor white iPos wrld]
  where
    iPos = _selLocation wrld
    locs = map (\(_,s) -> (s,white)) . IM.elems . _seenLocations $ wrld
    locPoss = map (cartePosToScreen wrld . ($ wrld) . fst) . IM.elems . _seenLocations $ wrld
    locTexts = map fst locs
    bFunc (V2 x y) (V2 z w) = pictures 
        [ bline 0.2 0.050 0.010
        , bline 0.5 0.045 0.005
        , bline 0.5 0.035 0.002
        ] --cheapo antialiasing
      where
        bline alph lwidth rwidth
            = bezierQuad (withAlpha 0.0 white) (withAlpha alph white) lwidth rwidth (V2 x y) (V2 0 y) (V2 z w)

displayListCoords :: World -> [Point2]
displayListCoords w = map (g . f) [(1::Int)..]
  where 
    f i = V2 ( 15 - halfWidth w ) ( halfHeight w - (20 * fromIntegral i))
    g (V2 x y) = V2 (2*x / getWindowX w) ( 2*y / getWindowY w)

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

--bezierQuad :: Color -> Color -> Float -> Float -> Point2 -> Point2 -> Point2 -> Picture

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 $ zipWith renderList [(0::Int)..] (map colAndText $ _closeActiveObjects w)
    ++ maybeToList maybeLine
  where 
    colAndText (Left x)  = (_itInvColor $ _flIt x, _itName $ _flIt x)
    colAndText (Right x) = (white, _btText x)
    renderList i (c,t) = winScale w
        . tran
        . translate (xtran i) (negate (20 * fromIntegral i))
        . scale 0.1 0.1 
        . color c 
        $ text t
    tran = translate (pushout - halfWidth w) (halfHeight w - 20* (fromIntegral invPos +1))
    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 = 140
    xtran :: Int -> Float
    xtran 0 = case mayIt of Nothing -> 25
                            _       -> -25
    xtran _ = 0
    objPos obj = case obj of Left flit -> _flItPos flit
                             Right bt  -> _btPos bt
    mayScreenPos = mayObj >>= (\theObj -> Just (worldPosToScreen w $ objPos theObj))
    sc (V2 x  y) = V2 (x*2/getWindowX w) ( y*2/getWindowY w)
    maybeLine = do 
          itScreenPos <- mayScreenPos
          theText <- fmap (snd . colAndText) mayObj
          let textWidth = 9 * fromIntegral (length theText)
          let col = maybe white (_itInvColor . _flIt) mayIt
          let p = V2 (textWidth + xtran 0 + pushout - halfWidth w)
                    ( halfHeight w - 20* (fromIntegral invPos +1) + 2.5)
          let p' = V2 ( pushout - halfWidth w + 130)
                   ( halfHeight w - 20* (fromIntegral invPos +1) + 2.5)
          return $ thickLineCol  
                      [(itScreenPos, withAlpha 0 col)
                      ,(sc p'      , col)
                      ,(sc p       , col)
                      ]
                      (1 / halfWidth w)
{- | Colour picture and add black drop shadow. -}
dShadCol :: Color -> Picture -> Picture
dShadCol c p = pictures
    [ color black $ uncurry translate (1.2,-1.2) p
    , color c p
    ]

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

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 $ reverse $ take 5 $ (++ repeat ' ') $ reverse $ show
                    $ _crHP $ _creatures w IM.! n