{-# LANGUAGE ExistentialQuantification #-}

{-|
Module      : Display
Description : Translates the Universe into a Picture
Copyright   : (c) Christopher Howard, 2016
License     : GPL-3
Maintainer  : ch.howard@zoho.com
-}
module Display (displayUniverse, AWS(..)) where

import Prelude ((/), (-), (+), (*), (<), map, (!!), (.), (++), fromIntegral, not, (&&), all, id, (==), max, Maybe(..), ($), show, (>=), Bool(..), undefined, (<=), abs, return)
import Data.Maybe ( isNothing, fromMaybe )
import Data.WrapAround ( wrapmap, vectorRelation )
import Graphics.Gloss.Interface.IO.Game ( Picture(Blank, Color, Line, Pictures, Polygon, Rotate, Scale, Text, Translate), yellow, white, red, green, cyan )
import GHC.Float ( double2Float )

import Animation
import Universe
import Lance
import Moving ( Locatable )
import qualified Moving as M ( Locatable(center) )
import Star
import Combat
import AfterEffect
import Unit
import Item
import ResourceTracker
import Math
import Resources
import Common
import AWS

data Displayable = forall a. (Locatable a, Animation a) => Displayable a

displayUniverse u
  = return $ Pictures $
        [ let (x, y) = k displayable in
          let pic = image displayable undefined in
          Translate (double2Float x) (double2Float y) pic
        | (Displayable displayable) <- map Displayable stars
            ++ map Displayable (asteroids r)
            ++ [ Displayable a
               | Projectile a <- lanceProjectiles r ++ unitProjectiles r
               ]
            ++ [ case effect of AfterEffect a -> Displayable a
               | effect <- afterFX r ]
            ++ [ Displayable a | SimpleUnit a <- simpleUnits r ]
            ++ [ Displayable a | SmartUnit a <- smartUnits r ]
            ++ [ Displayable a | a <- items r ]
        , let (x, y) = k displayable in
          abs x <= 700 && abs y <= 600
        ]
        ++ case lance r of
             Nothing -> []
             Just l -> if all id (inventory l)
                         then [ let (x, y) = vectorRelation w
                                               (M.center a)
                                                 (focus r) in
                                Translate
                                  (double2Float x)
                                  (double2Float y)
                                  s
                              | a <- items r
                              , case a of
                                  (Item Health _ _) -> False
                                  otherwise -> True
                              ]
                         else []
        ++ [ fromMaybe Blank (do lance' <- lance r
                                 Just (image lance' undefined))
           , f 0.5 (Translate (-65) (ap 365) deflectorText)
           , f 0.5 (Translate 65.0 (ap 370) $
                      case lance r of
                        Just x -> deflectorBar (deflectorCharge x)
                        Nothing -> deflectorBar 0.8)
           , f 0.5 (Translate 140 (ap 365) (levelText (level u)))
           , f 0.5 (Translate (-140) (ap 365) (livesText (lives u)))
           , f 1.5 (Translate (ap 420) (ap 300)
                     (sensorPanel r (150, 150)))
           , case lance r of
               Nothing -> Blank
               Just l -> if not (godMode l)
                           then Blank
                           else Translate (-20) (ap 335) godText
           , f 1 (Translate (am (-500)) (ap 365)
                   (Color white
                     (Scale 0.14 0.14 (Text "structural integrity"))))
           , f 1 (case lance r of
                   Nothing -> Blank
                   Just l -> Translate (am (-330)) (ap 365)
                              (Scale 0.14 0.14
                                (integrityAssessment (integrity l))))
           , g (Translate (am (-400)) (ap 340)
                 (inventoryDisplay (lance r) (resourceTracker u)))
           , g (Translate (-200) 150 (levelMessage (levelMessageTimer u) (level u)))
           -- , h 2.5 (i 20 (Translate (ap (220)) (am (-300)) helpColumn3))
           , h 2 (i 20 (Translate (am (-450)) (am (-230)) helpColumn2))
           , h 2 (i 20 (Translate (am (-470)) (am (-320)) helpColumn1))
           ]
  where f x = g . h x
        g x = if isNothing (lance (arena u)) then Blank else x
        h x y = if panelActivationTimer u < x then Blank else y
        i x y = if startGameTimer u < x then y else Blank
        r = arena u
        w = Universe.wrapMap r
        s = fromMaybe Blank (getImage (resourceTracker u) "item-sigma.bmp")
        k x = vectorRelation w (M.center x) (focus r)
        ap = case aws u of W1024 -> id; W1280 -> (+ 116)
        am = case aws u of W1024 -> id; W1280 -> (\x -> x - 116)
        
livesText n = Color white
                (Scale 0.14 0.14
                  (Text (show n ++ " lives")))

levelText n = (Color white
                  (Scale 0.14 0.14
                    (Text ("level " ++ show (n + 1)))))

integrityAssessment n = if n >= 3.0
                          then Color green (Text "optimal")
                          else if n >= 2.0
                                 then Color yellow (Text "light damage")
                                 else Color red (Text "heavy damage")

godText = Color yellow (Scale 0.14 0.14 (Text "god mode"))

deflectorText = (Color white (Scale 0.14 0.14 (Text "deflector")))

levelMessage a b = case a of
                     Nothing -> Blank
                     Just mt -> if mt `remF` 0.5 < 0.25
                                  then Blank
                                  else Text ("level " ++ show (b + 1))


helpColumn1 =
  Color cyan $
    Rotate 270.0 $
      Scale 0.13 0.13 $
        Text "CONTROLS"

helpColumn2 =
  Color white $
    Pictures $
      lineFormatting
        [ "A, 0 to fire"
        , "L-ARROW, 4 for port"
        , "R-ARROW, 6 for starboard"
        , "U-ARROW, 8 to accelerate"
        , "TAB, 5 to switch weapons"
        , "SPACEBAR, ENTER for deflector"
        ]

-- helpColumn3 =
--   Color white $
--     Pictures $
--       lineFormatting
--         [ "Enjoy the game? To donate"
--         , "visit <frigidcode.com/donate>."
--         ]

lineFormatting ys = lineFormatting' 20 0 ys

lineFormatting' _ _ [] = []
lineFormatting' x z (y:ys) =
  Translate
    0.0
    ((-x) * z)
    (Scale 0.14 0.14
      (Text y)) : lineFormatting' x (z + 1) ys

box w h = [ (-q, r), (q, r), (q, -r), (-q, -r), (-q, r) ]
  where (q, r) = appPair (* 0.5) (w, h)

swBar l =
  let w = 150.0 in
  let h = 17.0 in
  let outline = Line (box w h) in
  let trem = max (swTimeLimit - swClock l) 0.0 in
  let portion = double2Float (trem / swTimeLimit) in
  let barColor = if portion < 0.2 then red
                                  else white in
  let bar = Polygon [ ((-w) * 0.5, h * 0.5)
                    , ((-w) * 0.5 + portion * w, h * 0.5)
                    , ((-w) * 0.5 + portion * w, (-h) * 0.5)
                    , ((-w) * 0.5, (-h) * 0.5)
                    ] in
  Pictures [Color barColor bar
           , Color white outline
           ]

inventoryDisplay m rt =
  case m of
    Nothing -> Blank
    Just l ->
      if swClock l < swTimeLimit && all id (inventory l)
        then let p = fromMaybe Blank
                              (getImage rt "item-sigma.bmp") in
                 Pictures [ Translate (-80) 0 p
                          , Translate 10 0 (swBar l)
                          ]
        else let i = inventory l in
             let c = currentWeapon l in
              Pictures [ f 0 (-2) "item-fourway.bmp" i
                       , f 1 (-1) "item-cannon.bmp" i
                       , f 2 0 "item-spread.bmp" i
                       , f 3 1 "item-rapidfire.bmp" i
                       , f 4 2 "item-nuke.bmp" i
                       , if c == 0
                           then Blank
                           else Translate
                                  ((fromIntegral c - 3) * q) 0
                                    (Line [ (12, 13), (12, -12)
                                          , (-13, -12), (-13, 13), (12, 13) ])
                       ]
  where f x y z u = if not (u !! x)
                      then Blank
                      else let p = fromMaybe Blank
                                     (getImage rt z) in
                           Translate (y * q) 0 p
        q = 40


sensorPanel arena (w, h) = Pictures [ d, e, i, j ]
  where a = wrapmap w h
        (q, r) = appPair ((* 0.5) . double2Float) (w, h)
        d = Color white (Pictures
              ([ (Line [ (q - 4, r), (q, r), (q, r - 4.0) ])
              , (Line [ (q, 4 - r), (q, -r), (q - 4.0, -r) ])
              , (Line [ (-q, 4 - r), (-q, -r), (-q + 4, -r) ])
              , (Line [ (-q, r - 4.0), (-q, r), (4 - q, r) ])
              ]))

        e = Color white (Line [ (2, 0), (0, 2), (-2, 0), (0, -2), (2, 0) ])
        i = Pictures
              [ f white [ (2, 0), (0, 2), (-2, 0), (0, -2) ] c
              | c <- map M.center (simpleUnits arena)
                     ++ map M.center (smartUnits arena)
              ]
        j = Pictures
              [ f cyan [ (2, 0), (0, 2), (-2, 0), (0, -2) ] c
              | c <- map M.center (items arena)
              ]
        g m = double2Float (-m)
        f m n o = let (x, y) = vectorRelation a (focus arena) o in
                  Translate (g x) (g y) (Color m (Polygon n))

deflectorBar c =

  Pictures [Color (if c < 1.0 then red else white)
             (Polygon [ (-q, r), (-q + p * w, r), (-q + p * w, -r), (-q, -r) ])
           , Color white (Line [ (-q, r), (q, r), (q, -r), (-q, -r), (-q, r) ])
           ]

  where w = 100
        h = 20
        q = w / 2
        r = h / 2
        p = (double2Float c - 0.8) / (2 - 0.8)