edge-0.9.0.2: Unit.hs

{-# LANGUAGE ExistentialQuantification #-}

module Unit ( SimpleUnit (..)
            , SmartUnit (..)
            , firing
            ) where

import Animation ( Audible(..), Animation(..) )
import Moving ( Locatable(..), Colliding(..), Moving(..) )
import Combat
    ( Damaging(..), Damageable(..), Launcher(..), Projectile )
import Updating
    ( Transient(..), InternallyUpdating(..), Observant(..) )
import Common ( Time )
import Data.Maybe ()
-- Simple, i.e., no sensory awareness and related A.I.
data SimpleUnit = forall a. ( Animation a
                       , Colliding a
                       , Transient a
                       , Damageable a
                       , Damaging a
                       , Launcher a
                       , Audible a
                       ) => SimpleUnit a

instance Colliding SimpleUnit where

  collisionRadius (SimpleUnit a) = collisionRadius a

instance Moving SimpleUnit where

  velocity (SimpleUnit a) = velocity a

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

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

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

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

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

data SmartUnit = forall a. ( Animation a
                      , Colliding a
                      , Transient a
                      , Damageable a
                      , Damaging a
                      , Launcher a
                      , Audible a
                      , Observant a
                      ) => SmartUnit a

instance Colliding SmartUnit where

  collisionRadius (SmartUnit a) = collisionRadius a

instance Moving SmartUnit where

  velocity (SmartUnit a) = velocity a

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

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

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

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

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

instance Observant SmartUnit where
  updateVision (SmartUnit a) arena = SmartUnit (updateVision a arena)

instance Launcher SimpleUnit where
  deployProjectiles (SimpleUnit a) = let (ps, a') = deployProjectiles a in
                                     (ps, SimpleUnit a')

instance Launcher SmartUnit where
  deployProjectiles (SmartUnit a) = let (ps, a') = deployProjectiles a in
                                     (ps, SmartUnit a')

instance Audible SimpleUnit where
  processAudio (SimpleUnit a) wp = do a' <- processAudio a wp
                                      return (SimpleUnit a')

  terminateAudio (SimpleUnit a) = do a' <- terminateAudio a
                                     return (SimpleUnit a')

instance Audible SmartUnit where
  processAudio (SmartUnit a) wp = do a' <- processAudio a wp
                                     return (SmartUnit a')

  terminateAudio (SmartUnit a) = do a' <- terminateAudio a
                                    return (SmartUnit a')

-- | Func abstracting the firing of projectiles
firing :: a -- ^ the object
       -> (a -> Time) -- ^ func that retrieves time since last shot
       -> Time -- ^ desired shot delay
       -> (a -> Time -> a) -- ^ func which sets time since last shot in object
       -> (a -> [Projectile] -> a) -- ^ func which sets projectiles in object
       -> (a -> Bool -> a) -- ^ func which sets shot sound queued status
       -> [Projectile] -- ^ new projectiles
       -> Time -- ^ elapsed time
       -> (a -> [Projectile]) -- ^ func which retrieves projectiles in object
       -> a
firing a f b g h i c d j =
  if m >= b then i (h (g a 0) (c ++ j a)) True else g a m
  where m = f a + d