{-|
Module      : Unit.Smart.Master
Description : A Ninja with a cloaking ability
Copyright   : (c) Christopher Howard, 2016
License     : GPL-3
Maintainer  : ch.howard@zoho.com
-}

module Unit.Smart.Master ( Master(..)
                        , new
                        ) where

import Prelude ((>), Maybe(..), max, (-), (.), (+), (>=), (/), abs, (*), (==), Bool(..), return, (<), otherwise, (<=), pi, Double, not, ($))
import Data.WrapAround ( WP, WM, vectorRelation )
import Graphics.Gloss.Data.Picture ( Picture(Color, Rotate, Scale, Text, Blank) )
import Graphics.Gloss.Data.Color ( white )
import GHC.Float ( double2Float )
import Data.Maybe ( isNothing, fromMaybe, fromJust )
import Sound.ALUT ( Vertex3(Vertex3), HasSetter(($=)), SourceRelative(Listener), Source, ObjectName(genObjectNames), stop, sourceRelative, sourcePosition, rolloffFactor, referenceDistance, play, buffer )

import Animation
import Math
import ResourceTracker
import Updating
import qualified Moving as M ( Colliding(..), Moving(..), Locatable(..), newVelocity, newLocation )
import Combat
import qualified Projectile.Blade as P.Blade ( speed, new )
import AfterEffect
import qualified AfterEffect.SimpleExplosion as SimpleExplosion ( new )
import Universe ( Arena(lance) )
import qualified Universe as U ( Arena(wrapMap) )
import Common

radialVelocity = pi/2 -- radians per second

maxVelocityMag = 400.0

kamikazeDamage = 8.0

maxIntegrity = 3

accelerationRate = 250.0

adjAngle = pi / 8

shotDelay = 4.0

data Master = Master { angle :: Angle -- radians
                     , velocity :: Velocity
                     , center :: WP
                     , idealTargetLocation :: Maybe WP
                     , wrapMap :: WM
                     , launchTube :: [Projectile]
                     , sinceLastShot :: Time
                     , integrity :: Double
                     , vision :: Maybe Arena
                     , resourceTracker :: ResourceTracker
                     , cloakClock :: Time
                     , cloakPeriod :: Time

                     -- Sound
                     , queueShotSound :: Bool
                     , shotSoundSource :: Maybe Source
                     }

instance Audible Master where

  processAudio self lcenter =
    do self' <- if isNothing (shotSoundSource self)
                  then initializeShotSoundSource self
                  else return self
       if not (queueShotSound self)
               then return self'
               else do let (x, y) = vectorRelation
                                      (wrapMap self)
                                      (lcenter)
                                      (center self)
                       let s = fromJust $ shotSoundSource self
                       sourcePosition s $= (Vertex3 (double2Float x)
                                                    (double2Float (-y))
                                                    0)
                       play [s]
                       return self' { queueShotSound = False }

  terminateAudio self =
    if isNothing (shotSoundSource self)
      then return self
      else do stop [fromJust (shotSoundSource self)]
              return self

initializeShotSoundSource self =
  do [source] <- genObjectNames 1
     buffer source $= getSound (resourceTracker self) "energy-shot-02.wav"
     -- ...
     sourceRelative source $= Listener
     referenceDistance source $= audioReferenceDistance
     rolloffFactor source $= audioRolloffFactor
     return self { shotSoundSource = Just source }

new :: ResourceTracker
        -> WM
        -> WP
        -> Angle
        -> Time
        -> Master
new rt wmap center' angle' cloakPeriod' =
  Master { center = center'
        , angle = angle'
        , idealTargetLocation = Nothing
        , velocity = (0.0, 0.0)
        , wrapMap = wmap
        , launchTube = []
        , sinceLastShot = 0.0
        , integrity = maxIntegrity
        , vision = Nothing
        , resourceTracker = rt
        , queueShotSound = False
        , shotSoundSource = Nothing
        , cloakClock = 0.0
        , cloakPeriod = cloakPeriod'
        }

instance Observant Master where

  updateVision self arena = self { vision = Just arena }

updateCloakingData t self
  = self { cloakClock = let a = cloakClock self + t in
                        if a >= cloakPeriod self then 0.0 else a
         }

updateAngle t self
 = case vision self of
     Nothing -> self
     Just a -> case lance a of
                Nothing -> self
                Just l -> let sDir = angle self in
                          let sDir' = if sDir == 0.0 / 0.0
                                        then 0.1
                                        else sDir in
                          let tDir = vectorDirection
                                       (vectorRelation
                                         (wrapMap self)
                                         (center self)
                                         (M.center l)) in
                          let adj
                                | tDir - sDir' > adjAngle = radialVelocity * t
                                | tDir - sDir' < (-1) * adjAngle = (-radialVelocity) * t
                                | otherwise = 0.0 in
                          self { angle = angle self + adj }

updateVelocity :: Time -> Master -> Master
updateVelocity t self =
  let thrustingVelocity = M.newVelocity
                              (velocity self)
                              accelerationRate
                              (angle self)
                              maxVelocityMag
                              t in
  let velocity' = case vision self of
                    Nothing -> velocity self
                    Just a ->
                      case lance a of
                        Nothing -> velocity self
                        Just l -> let sDir = angle self in
                                  let sDir' = if sDir == 0.0 / 0.0
                                                then 0.1
                                                else sDir in
                                  let tDir = vectorDirection
                                               (vectorRelation
                                                 (wrapMap self)
                                                 (center self)
                                                 (M.center l)) in
                                  if abs (tDir - sDir') <= adjAngle
                                    then thrustingVelocity
                                    else velocity self in
  self { velocity = velocity' }

instance Animation Master where
  image self _ = Rotate (double2Float
                          (radToDeg
                            (angle self)) * (-1) - 90)
                              currentPic
    where defaultPic = fromMaybe
                 (Scale 0.20 0.20
                    (Color white
                    (Text "Error! Missing image!")))
                  (getImage rt "master.bmp")
          cloakingPic = fromMaybe Blank (getImage rt "master-cloaking.bmp")
          rt = resourceTracker self
          t = cloakClock self
          p = cloakPeriod self
          currentPic = if t < 0.3
                         then cloakingPic
                         else if t < p * 0.5 - 0.3
                                then defaultPic
                                else if t < p * 0.5
                                        then cloakingPic
                                        else Blank

instance M.Locatable Master where
  center = center

instance M.Moving Master where
  velocity = velocity

instance M.Colliding Master where
  collisionRadius _ = 40.0

instance InternallyUpdating Master where

  preUpdate self t = (updateFiringInformation t
                        . updateIdealTargetLocation t
                        . updateVelocity t
                        . updateAngle t
                        . updateCloakingData t) self

  postUpdate self t =
    let center' = fromMaybe (center self) (idealTargetLocation self) in
    self { center = center'
         , idealTargetLocation = Nothing
         }

updateFiringInformation t self =
  let cloaked = cloakClock self >= cloakPeriod self * 0.5 in
  let sinceLastShot' = sinceLastShot self + t in
    if sinceLastShot' >= shotDelay
      then self { sinceLastShot = 0.0
                , launchTube = if cloaked
                                 then launchTube self
                                 else projectile : launchTube self
                , queueShotSound = if cloaked then False else True
                }
      else self { sinceLastShot = sinceLastShot' }
  where projectile = Projectile
                       (P.Blade.new
                         (wrapMap self)
                         (resourceTracker self)
                         pAngle
                         (center self)
                         (velocity self))
        pSpeed = P.Blade.speed
        pAngle = case vision self of
                   Nothing -> angle self
                   Just arena ->
                     case lance arena of
                       Nothing -> angle self
                       Just l -> targetingA
                                   pSpeed
                                   (vectorRelation
                                     (U.wrapMap arena)
                                     (center self)
                                     (M.center l))
                                   (subV
                                     (M.velocity l)
                                     (M.velocity self))

updateIdealTargetLocation :: Time -> Master -> Master
updateIdealTargetLocation t self =
  self { idealTargetLocation = Just (M.newLocation (wrapMap self)
                                                        (center self)
                                                        (velocity self)
                                                        t)
        }

instance Launcher Master where

  deployProjectiles self = (launchTube self, self { launchTube = [] })

instance Transient Master where

  expired' self = if integrity self > 0.0
                    then Nothing
                    else Just [aeffect]
    where aeffect = AfterEffect (SimpleExplosion.new (resourceTracker self)
                                                     (wrapMap self)
                                                     (center self)
                                                     (velocity self))

instance Damageable Master where

  inflictDamage self d = 
    let cloaked = cloakClock self >= cloakPeriod self * 0.5 in
    if cloaked 
      then self
      else self { integrity = max 0.0 (integrity self - d) }

instance Damaging Master where

  damageEnergy self = 
    let cloaked = cloakClock self >= cloakPeriod self * 0.5 in
    if cloaked then 0.0 else kamikazeDamage