{-# LANGUAGE ExistentialQuantification #-}

module Display (displayUniverse) where

import Animation
import Universe
import Lance
import Data.Maybe
import Moving
import Star
import Data.WrapAround
import Graphics.Gloss.Interface.IO.Game
import GHC.Float
import Combat
import AfterEffect ( AfterEffect ( AfterEffect ) )
import Unit
import Item
import ResourceTracker
import Trigonometry

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

displayUniverse u
  = let arena' = arena u in
    let wmap = Universe.wrapMap arena' in
    let pship = do lance' <- lance arena'
                   Just (image lance' undefined) in
    let pship' = fromMaybe Blank pship in
    let viewCenterWp = case lance arena' of
                         Just x -> Moving.center x
                         Nothing -> lastFocus arena' in
    let displayables =
          do (Displayable displayable)
                <- map Displayable (stars arena')
                   ++ map Displayable (asteroids arena')
                   ++ [ Displayable a
                      | Projectile a <- lanceProjectiles arena'
                                         ++ unitProjectiles arena'
                      ]
                   ++ [ case effect of
                          AfterEffect a -> Displayable a
                      | effect <- afterFX arena' ]
                   ++ [ Displayable a | SimpleUnit a <- simpleUnits arena' ]
                   ++ [ Displayable a | SmartUnit a <- smartUnits arena' ]
                   ++ [ Displayable a | a <- items arena' ]
             let wp = Moving.center displayable in
               let (x, y) = vectorRelation wmap wp viewCenterWp in
               let pic = image displayable undefined in
               [ Translate (double2Float x) (double2Float y) pic ] in
    let lanceLives x = if isNothing (lance arena')
                         then Blank else x in
    let deflectorBar' = Translate 65.0 370.0
                          (case lance arena' of
                             Just x -> deflectorBar (deflectorCharge x)
                             Nothing -> deflectorBar 0.8
                          ) in
    let deflectorText' = Translate (-65.0) 365.0 deflectorText in
    let levelText = Translate 140.0 365.0
                      (Color white
                        (Scale 0.14 0.14
                          (Text ("level " ++ show (level u + 1))))) in
    let livesText = Translate (-140.0) 365.0
                      (Color white
                        (Scale 0.14 0.14
                          (Text (show (lives u) ++ " lives")))) in
    let godText = case lance arena' of
                    Nothing -> Blank
                    Just l -> if not (godMode l)
                                then Blank
                                else Translate (-20.0) 335.0
                                       (Color yellow
                                         (Scale 0.14 0.14
                                           (Text "god mode"))) in
    let integrityText = Translate (-500.0) 365.0
                          (Color white
                            (Scale 0.14 0.14
                              (Text "structural integrity"))) in
    let integrityAssessment =
          case lance arena' of
            Nothing -> Blank
            Just l -> if integrity l >= 3.0
                      then Color green (Text "optimal")
                      else if integrity l >= 2.0
                           then Color yellow (Text "light damage")
                           else Color red (Text "heavy damage") in
    let integrityTextL2 = Translate (-330.0) 365.0
                            (Scale 0.14 0.14
                              integrityAssessment) in
    let sP = Translate 450.0 330.0
               (sensorPanel arena' (100.0, 100.0)) in
    let levelMessage = case levelMessageTimer u of
                         Nothing -> Blank
                         Just mt -> if mt `doubleRem` 0.5 < 0.25
                                      then Blank
                                      else Translate (-200.0) 150.0
                                             (Text
                                               ("level "
                                                 ++ show (level u + 1))) in
    return $ Pictures $ displayables
                        ++ [ pship'
                           , lanceLives $ deflectorText'
                           , lanceLives $ deflectorBar'
                           , lanceLives $ levelText
                           , lanceLives $ livesText
                           , lanceLives $ sP
                           , godText
                           , lanceLives $ integrityText
                           , lanceLives $ integrityTextL2
                           , lanceLives $ Translate (-400.0) 340.0
                                            (inventoryDisplay
                                               (lance arena')
                                                  (resourceTracker u))
                           , lanceLives $ levelMessage
                           ]

inventoryDisplay :: Maybe Lance -> ResourceTracker -> Picture
inventoryDisplay mLance rt =
  let spacing = 40.0 in
  case mLance of
    Nothing -> Blank
    Just l -> let i = inventory l in
              let pFourWay =
                    if not (i !! 0)
                       then Blank
                       else let p = fromMaybe Blank
                                      (getImage rt "item-fourway.bmp") in
                            Translate ((-2.0) * spacing) 0.0 p in
              let pCannon =
                    if not (i !! 1)
                       then Blank
                       else let p = fromMaybe Blank
                                      (getImage rt "item-cannon.bmp") in
                            Translate ((-1.0) * spacing) 0.0 p in
              let pSpread =
                    if not (i !! 2)
                       then Blank
                       else let p = fromMaybe Blank
                                      (getImage rt "item-spread.bmp") in
                            p in
              let pRapidFire =
                    if not (i !! 3)
                       then Blank
                       else let p = fromMaybe Blank
                                      (getImage rt "item-rapidfire.bmp") in
                            Translate spacing 0.0 p in
              let pNuke =
                    if not (i !! 4)
                       then Blank
                       else let p = fromMaybe Blank
                                      (getImage rt "item-nuke.bmp") in
                            Translate (2.0 * spacing) 0.0 p in
              let c = currentWeapon l in
              let pSelected =
                    if c == 0
                      then Blank
                      else Translate
                             ((fromIntegral c - 3.0) * spacing) 0.0
                             (Line [ (12.0, 13.0)
                                   , (12.0, -12.0)
                                   , (-13.0, -12.0)
                                   , (-13.0, 13.0)
                                   , (12.0, 13.0)
                                   ]) in
              Pictures [ pFourWay
                       , pCannon, pSpread, pRapidFire, pNuke, pSelected]

sensorPanel :: Arena -> (Double, Double) -> Picture
sensorPanel arena (w, h) =
  let wmap = wrapmap w h in
  let (w', h') = (double2Float w, double2Float h) in
  let (w'', h'') = (w' * 0.5, h' * 0.5) in
  -- let outline = Color white (Line [ (w' * 0.5, h' * 0.5)
  --                                 , (w' * 0.5, (-h') * 0.5)
  --                                 , ((-w') * 0.5,(-h') * 0.5)
  --                                 , ((-w') * 0.5, h' * 0.5)
  --                                 , (w' * 0.5, h' * 0.5)
  --                                 ]) in
  let outline = Color white
                  (Pictures
                    [ (Line [ (w'' - 4.0, h'')
                            , (w'', h'')
                            , (w'', h'' - 4.0)
                            ])
                    , (Line [ (w'', (-h'') + 4.0)
                            , (w'', (-h''))
                            , (w'' - 4.0, (-h''))
                            ])
                    , (Line [ ((-w''), (-h'') + 4.0)
                            , ((-w''), (-h''))
                            , ((-w'') + 4.0, (-h''))
                            ])
                    , (Line [ ((-w''), h'' - 4.0)
                            , ((-w''), h'')
                            , ((-w'') + 4.0, h'')
                            ])
                    ]) in

  let focalPoint = Color white (Line [ (2.0, 0.0)
                                     , (0.0, 2.0)
                                     , (-2.0, 0.0)
                                     , (0.0, -2.0)
                                     , (2.0, 0.0)
                                     ]) in
  let unitDots =
        [ let cp = case lance arena of
                     Nothing -> lastFocus arena
                     Just l -> Moving.center l in
          let (x, y) = vectorRelation wmap cp c in
          Translate
            (double2Float (-x))
            (double2Float (-y))
            (Color white (Polygon [ (2.0, 0.0)
                                  , (0.0, 2.0)
                                  , (-2.0, 0.0)
                                  , (0.0, -2.0)
                                  ]))
        | c <- map Moving.center (simpleUnits arena)
               ++ map Moving.center (smartUnits arena)
        ] in
  let itemDots =
        [ let cp = case lance arena of
                     Nothing -> lastFocus arena
                     Just l -> Moving.center l in
          let (x, y) = vectorRelation wmap cp c in
          Translate
            (double2Float (-x))
            (double2Float (-y))
            (Color cyan (Polygon [ (2.0, 0.0)
                                  , (0.0, 2.0)
                                  , (-2.0, 0.0)
                                  , (0.0, -2.0)
                                  ]))
        | c <- map Moving.center (items arena)
        ] in
  Pictures $ [ outline
             , focalPoint
             ] ++ unitDots ++ itemDots

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

deflectorBar charge =
  let width = 100.0 in
  let height = 20.0 in
  let outline = Line [ ((-width) / 2.0, height / 2.0)
                     , (width / 2.0, height / 2.0)
                     , (width / 2.0, (-height) / 2.0)
                     , ((-width) / 2.0, (-height) / 2.0)
                     , ((-width) / 2.0, height / 2.0)
                     ] in
  let portion = (double2Float charge - 0.8) / (2.0 - 0.8) in
  let barColor = if charge < 1.0 then red
                                 else white in
  let bar = Polygon [ ((-width) / 2.0, height / 2.0)
                    , ((-width) / 2.0 + portion * width, height / 2.0)
                    , ((-width) / 2.0 + portion * width, (-height) / 2.0)
                    , ((-width) / 2.0, (-height) / 2.0)
                    ] in
  Pictures [Color barColor bar
           , Color white outline
           ]