packages feed

edge-0.8.18: Lance.hs

module Lance ( Lance ( rotationalThrusters
                     , linearThrusters
                     , deflector
                     , fireTrigger
                     , deflectorCharge
                     , center
                     , angle
                     , velocity
                     , godMode
                     , integrity
                     , inventory
                     , currentWeapon
                     , swClock
                     )
             , new
             , RotationDirection (..)
             , shielded
             , processItem
             , changeCurrentWeapon
             , swTimeLimit
             ) where

import Data.WrapAround ( WP, WM )
import Animation ( Animation(..)
                 , Audible(..)
                 , handSndSrc
                 , termSndSrc
                 , reorient )
import Graphics.Gloss.Data.Picture (Picture(..))
import Graphics.Gloss.Data.Color (white)
import GHC.Float (double2Float)
import Math (isZero, dec, inc, neither, remF)
import ResourceTracker (RT, protectedGetImage, getImage)
import Data.Maybe (fromMaybe)
import Updating (Transient(..), InternallyUpdating(..))
import qualified Moving as M ( Locatable(..)
                             , Moving(..)
                             , Colliding(..)
                             , newLocation'
                             , newVelocity )
import Combat (Damageable(..), Launcher(..), Damaging(..), Projectile(..))
import qualified Projectile.BulletMkI as P.BulletMkI (new)
import qualified Projectile.Cannon as P.Cannon (new)
import qualified Projectile.Nuke as P.Nuke (new)
import qualified Projectile.SWSide as P.SWSide (new)
import qualified Projectile.SWForward as P.SWForward (new)
import AfterEffect (AfterEffect(..))
import qualified AfterEffect.SimpleExplosion as SimpleExplosion (new)
import Sound.ALUT (Source(..))
import Item (Item(..), ItemType(..))
import Common (Angle, Velocity, Time, replaceAt, allTrue)

radialVelocity = pi -- radians per second

accelerationRate = 200 -- points per second

maxVelocity = 500 -- points per second

kamikazeDamage = 8.0

deflectorChargeLossFactor = 0.8

swTimeLimit = 10.0

data RotationDirection = Stable | CW | CCW
  deriving (Eq)

type LanceInventory = [Bool]

data Lance = Lance { angle :: Angle
                   , center :: WP
                   , wmap :: WM
                   , rotationalThrusters :: RotationDirection
                   , velocity :: Velocity
                   , linearThrusters :: Bool
                   , queueShotSound :: Bool
                   , godMode :: Bool
                   , deflector :: Bool
                   , fireTrigger :: Bool
                   , rt :: RT
                   , launchTube :: [Projectile]
                   , currentWeapon :: Int
                   , inventory :: LanceInventory
                   , swClock :: Time
                   , sinceLastShot :: Time
                   , integrity :: Double
                   , deflectorCharge :: Double
                   , shotSoundSource :: Maybe Source
                   , clock :: Time
                   }

new r w c =
  Lance { center = c
        , angle = 0.0
        , rotationalThrusters = Stable
        , velocity = (0, 0)
        , linearThrusters = False
        , wmap = w
        , rt = r
        , deflector = False
        , deflectorCharge = 2.0
        , launchTube = []
        , sinceLastShot = 0.0
        , fireTrigger = False
        , currentWeapon = 0
        , inventory = [False, False, False, False, False]
        , queueShotSound = False
        , shotSoundSource = Nothing
        , godMode = False
        , integrity = 3.0
        , swClock = 0.0
        , clock = 0
        }

changeCurrentWeapon s =
  if neither (isZero c) (a !! dec c) then changeCurrentWeapon d else d
  where a = inventory s
        b = currentWeapon s
        c = if inc b > 5
               then if a !! 0 then 1 else 0
               else inc b
        d = s { currentWeapon = c }

processItem s (Item a _ _) =
  if a == Health then b else b { swClock = 0 }
  where b = case a of
             Health -> s { integrity = 3.0 }
             FourWay -> f 0
             Cannon -> f 1
             Spread -> f 2
             RapidFire -> f 3
             Nuke -> f 4
        f v = s { inventory = replaceAt v True (inventory s)
                , currentWeapon = inc v
                }

instance Audible Lance where

  processAudio s l = handSndSrc s
                       queueShotSound
                       shotSoundSource
                       (\a -> a { queueShotSound = False })
                       rt
                       "simple-energy-shot.wav"
                       (\a b -> a { shotSoundSource = Just b })
                       l (wmap s) center

  terminateAudio s = termSndSrc s shotSoundSource

shielded s = deflectorCharge s >= 1.0 && deflector s

updateAngle :: Time -> Lance -> Lance
updateAngle t s =
  case rotationalThrusters s of CW -> f (-); CCW -> f (+); Stable -> s
  where f a = s { angle = a (angle s) (radialVelocity * t) }

instance Animation Lance where
  image s _ = Pictures [ reorient (angle s) a, b ]
    where a = if linearThrusters s
                then protectedGetImage (rt s) "lance-thrusting.bmp"
                else protectedGetImage (rt s) "lance.bmp"
          b = if deflector s && deflectorCharge s >= 1.0
                then if remF (clock s) 0.1 <= 0.05
                       then f "deflector-1.bmp"
                       else f "deflector-2.bmp"
                else Blank
          f x = fromMaybe Blank (getImage (rt s) x)

instance M.Locatable Lance where
  center = Lance.center

instance M.Moving Lance where
  velocity = velocity

instance M.Colliding Lance where
  collisionRadius _ = 20.0

instance InternallyUpdating Lance where

  preUpdate s t = ( updateFiringInformation t
                   . updateVelocity t
                   . updateAngle t ) s

  postUpdate s t =
    updateDeflectorCharge t
      s { center = M.newLocation' s (wmap s) t
        , clock = clock s + t
        }

updateFiringInformation t s =
  b { swClock = (swClock b) + t }
  where a = sinceLastShot s + t
        b = if allTrue (inventory s) && swClock s < swTimeLimit
                then handleSuperWeapon s a
                else case currentWeapon s of
                       1 -> handleFourWayWeapon s a
                       2 -> handleCannonWeapon s a
                       3 -> handleSpreadWeapon s a
                       4 -> handleRapidFireWeapon s a
                       5 -> handleNukeWeapon s a
                       otherwise -> handleDefaultWeapon s a

handleSuperWeapon s a = firing s a 0.2 (b ++ c ++ [d])
  where f u v = Projectile ( u (wmap s) (angle s + v) (center s) (velocity s) )
        g = f P.BulletMkI.new
        h = f P.SWSide.new
        b = map g [ pi / 2, 3 * pi / 4, pi, 5 * pi / 4, 3 * pi / 2 ]
        c = map h [ pi / 10, pi / 5, (-pi) / 10,  (-pi) / 5 ]
        d = f P.SWForward.new 0

projectile u w v = Projectile ( u (wmap w) (angle w + v) (center w) (velocity w) )
bmki = projectile P.BulletMkI.new
  
handleDefaultWeapon s a = firing s a 0.4 [bmki s 0]

handleFourWayWeapon s a = firing s a 0.4 (map f [ 0, pi / 2, pi, 3 * pi / 2 ])
  where f = bmki s

cann = projectile P.Cannon.new

handleCannonWeapon s a = firing s a 0.7 [cann s 0]

handleSpreadWeapon s a = firing s a 0.4 (map f [ 0, b, b * 2, (-b), (-b) * 2])
  where f = bmki s
        b = pi / 10

handleRapidFireWeapon s a = firing s a 0.2 [bmki s 0]

firing :: Lance
       -> Time -- ^ since last shot
       -> Time -- ^ intended firing delay
       -> [Projectile] -- ^ the new projectiles
       -> Lance
firing a b c d =
  if b >= c && fireTrigger a
    then a { sinceLastShot = 0.0
           , launchTube = d ++ (launchTube a)
           , queueShotSound = True
           }
    else a { sinceLastShot = b }

handleNukeWeapon s a = firing s a 3.0 [b]
  where b = Projectile ( P.Nuke.new
                           (wmap s)
                           (rt s)
                           (angle s)
                           (center s)
                           (velocity s) )

updateDeflectorCharge t s =
  s { deflectorCharge = if deflector s
                          then max 0.8 (c - t * deflectorChargeLossFactor)
                          else min 2.0 (c + t * 0.05)
    }
  where c = deflectorCharge s


updateVelocity t s
  | linearThrusters s =
      s { velocity =
            M.newVelocity (velocity s) accelerationRate (angle s) maxVelocity t
        }
  | otherwise = s

instance Launcher Lance where

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

instance Damaging Lance where

  damageEnergy s = if not (deflector s) || deflectorCharge s < 1.0
      then kamikazeDamage
      else 0

instance Damageable Lance where

  inflictDamage s d =
    let e = if godMode s then 0 else d in
    if e > 0 && (not (deflector s) || deflectorCharge s < 1.0)
       then s { integrity = integrity s - d }
       else s

instance Transient Lance where

  expired' s = if integrity s <= 0.0 then Just [e] else Nothing
    where e = AfterEffect (SimpleExplosion.new (rt s)
                                               (wmap s)
                                               (Lance.center s)
                                               (Lance.velocity s))