edge-0.8: Combat.hs

{-# LANGUAGE ExistentialQuantification #-}

module Combat where

import Updating
import Animation
import Moving
import Data.WrapAround

data Projectile = forall a. ( Animation a
                       , Colliding a
                       , Transient a
                       , Damaging a
                       , Damageable a
                       ) => Projectile a

instance Colliding Projectile where

  collisionRadius (Projectile a) = collisionRadius a

instance Moving Projectile where

  velocity (Projectile a) = velocity a

instance Locatable Projectile where
  center (Projectile a) = center a

instance Damaging Projectile where
  damageEnergy (Projectile a) = damageEnergy a

instance Damageable Projectile where
  inflictDamage (Projectile a) et = Projectile (inflictDamage a et)

instance Transient Projectile where
  expired' (Projectile a) = expired' a

instance InternallyUpdating Projectile where
  preUpdate (Projectile a) et = Projectile (preUpdate a et)
  postUpdate (Projectile a) et = Projectile (postUpdate a et)

class Damaging a where

  damageEnergy :: a -> Double

class Damageable a where

  inflictDamage :: a -> Double -> a

inflictDamage' :: (Damaging a, Damageable b) => a -> b -> b
inflictDamage' a b = inflictDamage b (damageEnergy a)

class Launcher a where

  deployProjectiles :: a -> ([Projectile], a)

handleCollisionDamage :: ( Damaging a
                         , Damageable a
                         , Colliding a
                         , Damaging b
                         , Damageable b
                         , Colliding b
                         ) => WrapMap -> Double -> a -> [b] -> (a, [b])

handleCollisionDamage wmap tw x ys = handleCollisionDamage' x ys []

  where handleCollisionDamage' x [] nys = (x, nys)
        handleCollisionDamage' x (y:ys) nys =
          if not $ collisionWindow wmap (max
                                        (maxExpectedVelocity * tw)
                                        (collisionRadius x + collisionRadius y)) x y
            then handleCollisionDamage' x ys (nys ++ [y])
            else
              case collision wmap tw x y of
                Nothing -> handleCollisionDamage' x ys (nys ++ [y])
                Just _ -> let (nx, ny) = ( inflictDamage' y x
                                         , inflictDamage' x y
                                         ) in
                          handleCollisionDamage' nx ys (nys ++ [ny])

handleCollisionDamage' :: ( Damaging a
                         , Damageable a
                         , Colliding a
                         , Damaging b
                         , Damageable b
                         , Colliding b
                         ) => WrapMap -> Double -> [a] -> [b] -> ([a], [b])

handleCollisionDamage' wmap tw xs ys = handleCollisionDamage'' xs ys []

  where handleCollisionDamage'' [] ys nxs = (nxs, ys)
        handleCollisionDamage'' (x:xs) ys nxs =
          let (rx, rys) = handleCollisionDamage wmap tw x ys in
          handleCollisionDamage'' xs rys (nxs ++ [rx])

data Impacting = forall a. (Damaging a, Damageable a, Colliding a) => Impacting a