Entity.hs

{-# LANGUAGE DeriveGeneric #-}

{- |
Module      :  $Header$
Description :  The Entity type and its operations.
Copyright   :  (c) plaimi 2015
License     :  AGPL-3

Maintainer  :  blubber@plaimi.net
-} module Blubber.Server.Entity where

import Data.Serialize
  (
  Serialize,
  )
import GHC.Generics
  (
  Generic,
  )

import Blubber.Server.Vector
  (
  Vector (Vec),
  (^+^),
  (^-^),
  (^*^),
  (^/^),
  magVec,
  )

-- | An 'Entity' is a 'Blub' with a position and mass.
data Entity = MkEntity
            {position :: Vector -- ^ The position of the 'Blub'.
            ,mass     :: Double -- ^ The mass of the 'Blub'.
            ,entity   :: Blub   -- ^ The Blub itself.
            } deriving (Eq, Generic, Show)

-- | 'Entity's may be ordered based on their 'mass'.
instance Ord Entity where compare e f = compare (mass e) (mass f)

-- | 'Entity' uses a 'Serialize' instance to encode its data.
instance Serialize Entity

-- | The 'Blub' is our hero. It is either a 'NeutralBlub' that may simply be
--   consumed by 'PlayerBlub', or it is indeed a 'PlayerBlub'.
--   A human-controlled 'Blub' has a velocity and a target position in
--   addition to the usual 'Entity' stuff.
data Blub = NeutralBlub
          | PlayerBlub
          {velocity  :: Vector
          ,targetPos :: Vector
          } deriving (Eq, Generic, Show)

-- | 'Blub' uses a 'Serialize' instance to encode its data.
instance Serialize Blub

radius :: Entity -> Double
-- | The 'radius' of the 'Entity'.
radius = sqrt . mass

isNeutral :: Entity -> Bool
-- | 'isNeutral' is a quick hack to check if an 'Entity' holds a 'NeutralBlub'
--   or not.
isNeutral = n . entity where n NeutralBlub = True
                             n _           = False

intersect :: Entity -> Entity -> Maybe Vector
-- | Simple circle-circle-based intersect check of 'Entity's based on their
--   'radius'.
intersect e f | radius e + radius f > magVec v = Just v
              | otherwise                      = Nothing
  where v = position e ^-^ position f

fite :: (Entity, Entity) -> (Maybe Entity, Maybe Entity)
-- | A 'fite' between the passed in 'Entity's. The bigger one eats the
--   smaller. If they are equal no one eats each other. They just hug.
fite (b, c) = case b `intersect` c of
                Just _ | b > c     -> (Just $ b `blubber` c
                                      ,Nothing)
                       | b < c     -> (Nothing
                                      ,Just $ c `blubber` b)
                       | otherwise -> (Just b, Just c)
                Nothing            -> (Just b, Just c)

blubber :: Entity -> Entity -> Entity
-- | Let the first 'Entity' 'blubber' the second 'Entity'. I.e. EAT IT!
--   Omnomnom.
blubber b c | isNeutral b = b
            | otherwise   = b
                          {mass   = mass b + mass c
                          ,entity = (entity b)
                                  {velocity = (velocity (entity b) ^*^ mass b
                                    ^+^ vc ^*^ mass c) ^/^ (mass b + mass c)}
    }
  where vc  | isNeutral c = Vec 0 0
            | otherwise   = velocity (entity c)