edge-0.8.18: Combat.hs

{-# LANGUAGE ExistentialQuantification #-}

module Combat where

import Updating ( Transient (expired')
                , InternallyUpdating ( preUpdate
                                     , postUpdate
                                     )
                )
import Animation ( Animation )
import Moving ( Locatable ( center )
              , Moving ( velocity )
              , Colliding ( collisionRadius )
              , collision
              , collisionWindow
              , collisionWindow'
              )
import Data.WrapAround ( WM )

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
  :: (Colliding a, Colliding t, Damageable t, Damageable a,
      Damaging a, Damaging t)
      => WM
      -> Double -- ^ elapsed time window
      -> a -> [t] -> (a, [t])
handleCollisionDamage w t x ys = acc x ys []

  where acc x [] a = (x, a)
        acc x (y:ys) a =
          if collisionWindow' w x y t
            then
              case collision w t x y of
                Nothing -> acc x ys (a ++ [y])
                Just _ -> let (nx, ny) = ( inflictDamage' y x
                                         , inflictDamage' x y
                                         ) in
                          acc nx ys (a ++ [ny])
            else acc x ys (a ++ [y])

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

handleCollisionDamage'
  :: (Colliding t, Colliding a, Damageable a, Damageable t,
      Damaging t, Damaging a)
  => WM
  -> Double -- ^ elapsed time window
  -> [a] -> [t] -> ([a], [t])
handleCollisionDamage' w t c d = acc c d []

  where acc [] b a = (a, b)
        acc (x:xs) b a =
          let (m, n) = handleCollisionDamage w t x b in
          acc xs n (a ++ [m])

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