edge-0.8.16: Moving.hs

module Moving where

import Data.WrapAround ( WM
                       , WP
                       , add'
                       )
import qualified Data.WrapAround as W (distance)
import Math ( mulSV
                    , vectMag
                    , isPos
                    , divideProduct
                    , mulSV
                    , addV
                    , zeroProtect
                    )
import qualified Math as T (distance)
import Data.List (find)
import Control.Monad (join)
import Common ( Velocity
              , Angle
              , Time
              )
import Data.Maybe (isJust)

maxExpectedVelocity = 700 -- should equal max velocity of fastest object in arena

coordVector :: Floating t
  => t -- ^ angle
  -> t -- ^ magnitude
  -> (t, t)
coordVector a b = (cos a * b, sin a * b)

newVelocity
  :: Velocity -- ^ original velocity
  -> Double   -- ^ rate of acceleration
  -> Angle    -- ^ angle of thrust
  -> Double   -- ^ maximum speed allowed
  -> Time     -- ^ time elapsed
  -> (Double, Double)
newVelocity v r a l t =
  let d = coordVector a (t * r) in
  let (x, y) = addV v d in
  let m = zeroProtect 0.1 (vectMag (x, y)) in
  let n = if isPos x then asin (y / m)
                   else pi - asin (y / m) in
  coordVector n (min m l)

newLocation :: WM
            -> WP -- ^ original location
            -> Velocity  -- ^ velocity
            -> Time      -- ^ elapsed time
            -> WP
newLocation w a b t = add' w a (mulSV t b)

newLocation' a b c = newLocation b (center a) (velocity a) c

class Locatable a where
  center :: a -> WP

class (Locatable a) => Moving a where

  velocity :: a -> Velocity

class (Moving a) => Colliding a where

  collisionRadius :: a -> Double

data Collision = Collision { time :: Time -- since start of collision detection
                                           -- window frame
                           , center1 :: WP -- at point of collision
                           , center2 :: WP -- likewise
                           }

collision
  :: (Colliding a, Colliding a1)
  => WM
  -> Double -- ^ time window for checking collision
  -> a -> a1 -> Maybe Collision
collision w tw a b =
  do (t, (p1, p2), _) <- find (\(_, _, d) -> d <= r) z
     Just Collision { time = t
                    , center1 = p1
                    , center2 = p2
                    }
  where (r1, r2) = (collisionRadius a, collisionRadius b)
        r = r1 + r2
        dD = T.distance (velocity a) (velocity b)
        s = (fromIntegral . ceiling) (dD / r)
        m = [ divideProduct x tw s | x <- [0..s] ]
        f x y = add' w x (mulSV y (velocity a))
        u = [ (f (center a) t, f (center b) t) | t <- m ]

        z = zip3 m u [ W.distance w p1 p2 | (p1, p2) <- u ]

collisionWindow
  :: (Colliding a, Colliding b)
  => WM
  -> Double -- ^ range
  -> a -> b -> Bool
collisionWindow a b c d =
  W.distance a (center c) (center d) <= b

collisionWindow' a b c t
  = collisionWindow a
      (max (maxExpectedVelocity * 2 * t)
      (collisionRadius b + collisionRadius c)) b c

collisionScan :: (Colliding a, Colliding b) => WM -> a -> [b] -> Time -> Maybe Collision
collisionScan w c cs t =
  let collisions = map (collision w t c)
                     [ a | a <- cs
                     , collisionWindow' w c a t
                     ] in
  join (find isJust collisions)