{-# LANGUAGE NoImplicitPrelude #-}
module Synthesizer.Causal.Spatial where

import Control.Arrow (Arrow, arr, )

import qualified Algebra.NormedSpace.Euclidean as Euc
import qualified Algebra.Field                 as Field

import NumericPrelude.Numeric
import NumericPrelude.Base


{-|
simulate an moving sounding object

convert the way of the object through 2D or 3D space
into a delay and attenuation information,
sonicDelay is the reciprocal of the sonic velocity
-}
moveAround ::
   (Field.C a, Euc.C a v, Arrow arrow) =>
   a -> a -> v -> arrow v (a,a)
moveAround :: forall a v (arrow :: * -> * -> *).
(C a, C a v, Arrow arrow) =>
a -> a -> v -> arrow v (a, a)
moveAround a
att a
sonicDelay v
ear =
   forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ((\a
dist -> (a
sonicDelayforall a. C a => a -> a -> a
*a
dist, a
1forall a. C a => a -> a -> a
/(a
attforall a. C a => a -> a -> a
+a
dist)forall a. C a => a -> Integer -> a
^Integer
2)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a v. C a v => v -> a
Euc.norm forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. C a => a -> a -> a
subtract v
ear)