-- | Define the behaviors of 'Ball'
{-# LANGUAGE
	GADTs
      , MultiParamTypeClasses
  #-}
module Satter.Ball
       (
         expectedTime
       ) where
import Satter.TwoD
import Satter.Types

alpha :: Double
alpha = 0.99

instance SObject Ball where
  geometricsOf = _geometrics_b
  sizeOf _ = ballSize
  updateIntention _ p@(Ball _ _) = return p
  updatePhysics _ _ = error "Don't call me!"
  (<!!) (Ball (Geometrics (x, y) (dx, dy) v) h) t =
    Ball
    (Geometrics
     (x + simulationScale * integral (dx * v) t, y + simulationScale * integral (dy * v) t)
     (dx, dy)
     (v * alpha ** t)
    )
    h

newPosition :: Ball -> Double -> TwoD
newPosition (Ball (Geometrics (x, y) (dx, dy) v) _) t =
  (x + simulationScale * integral (dx * v) t, y + simulationScale * integral (dy * v) t)

expectedTime :: Ball -> TwoD -> Double -> Double
expectedTime (Ball (Geometrics pos@(x, y) (dx, dy) vec) _) pos' o
  | vec == 0 = 0
  | 0 < j = log j / (k * simulationScale)
  | otherwise = d
  where
    l1 = dropLength (x, y) (x + dx, y + dy) pos'
    l' = pos <-> pos'
    l2 = sqrt $ l' ** 2 - l1 ** 2
    d = l2 / simulationScale
    k = log alpha
    j = 1 + k * d / vec -- (vec + o / 8)

-- | return distance based on the integral of the speed
integral :: Double -> Double -> Double
integral v t = v / k * (exp (t * k) -1)
  where
    k = log alpha

defaultBall = Ball (Geometrics (0, 0) (1,1) 1) Nothing
