{-# LANGUAGE Arrows, ExistentialQuantification, FlexibleContexts, ScopedTypeVariables #-}

module Euterpea.IO.Audio.Basics (
  outA, 
  integral,
  countDown, countUp,
  upsample,
  pchToHz, apToHz
) where

import Euterpea.Music
import Euterpea.IO.Audio.Types
import Control.Arrow
import Control.Arrow.Operations
import Control.Arrow.ArrowP


outA :: (Arrow a) => a b b
outA :: forall (a :: * -> * -> *) b. Arrow a => a b b
outA = (b -> b) -> a b b
forall b c. (b -> c) -> a b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr b -> b
forall a. a -> a
id

integral :: forall a p. (ArrowCircuit a, Clock p) => ArrowP a p Double Double
integral :: forall (a :: * -> * -> *) p.
(ArrowCircuit a, Clock p) =>
ArrowP a p Double Double
integral = 
    let dt :: Double
dt = Double
1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ p -> Double
forall p. Clock p => p -> Double
rate (p
forall a. HasCallStack => a
undefined :: p)
    in proc Double
x -> do
      rec let i' :: Double
i' = Double
i Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
dt
          Double
i <- Double -> ArrowP a p Double Double
forall b. b -> ArrowP a p b b
forall (a :: * -> * -> *) b. ArrowCircuit a => b -> a b b
delay Double
0 -< Double
i'
      ArrowP a p Double Double
forall (a :: * -> * -> *) b. Arrow a => a b b
outA -< Double
i

countDown :: ArrowCircuit a => Int -> a () Int
countDown :: forall (a :: * -> * -> *). ArrowCircuit a => Int -> a () Int
countDown Int
x = proc ()
_ -> do
    rec Int
i <- Int -> a Int Int
forall b. b -> a b b
forall (a :: * -> * -> *) b. ArrowCircuit a => b -> a b b
delay Int
x -< Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    a Int Int
forall (a :: * -> * -> *) b. Arrow a => a b b
outA -< Int
i

countUp :: ArrowCircuit a => a () Int
countUp :: forall (a :: * -> * -> *). ArrowCircuit a => a () Int
countUp = proc ()
_ -> do
    rec Int
i <- Int -> a Int Int
forall b. b -> a b b
forall (a :: * -> * -> *) b. ArrowCircuit a => b -> a b b
delay Int
0 -< Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
    a Int Int
forall (a :: * -> * -> *) b. Arrow a => a b b
outA -< Int
i


upsample :: forall a b c p1 p2. (ArrowChoice a, ArrowCircuit a, Clock p1, Clock p2, AudioSample c) 
         => ArrowP a p1 b c -> ArrowP a p2 b c
upsample :: forall (a :: * -> * -> *) b c p1 p2.
(ArrowChoice a, ArrowCircuit a, Clock p1, Clock p2,
 AudioSample c) =>
ArrowP a p1 b c -> ArrowP a p2 b c
upsample ArrowP a p1 b c
f = ArrowP a p2 b c
forall {p}. ArrowP a p b c
g 
   where g :: ArrowP a p b c
g = proc b
x -> do 
               rec
                 Double
cc <- Double -> ArrowP a p Double Double
forall b. b -> ArrowP a p b b
forall (a :: * -> * -> *) b. ArrowCircuit a => b -> a b b
delay Double
0 -< if Double
cc Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
rDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
1 then Double
0 else Double
ccDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
1
                 c
y <- if Double
cc Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0 then a b c -> ArrowP a p b c
forall (a :: * -> * -> *) p b c. a b c -> ArrowP a p b c
ArrowP (ArrowP a p1 b c -> a b c
forall (a :: * -> * -> *) p b c. ArrowP a p b c -> a b c
strip ArrowP a p1 b c
f) -< b
x 
                                 else c -> ArrowP a p c c
forall b. b -> ArrowP a p b b
forall (a :: * -> * -> *) b. ArrowCircuit a => b -> a b b
delay c
forall a. AudioSample a => a
zero       -< c
y
               ArrowP a p c c
forall (a :: * -> * -> *) b. Arrow a => a b b
outA -< c
y
         r :: Double
r = if Double
outRate Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
inRate 
             then [Char] -> Double
forall a. HasCallStack => [Char] -> a
error [Char]
"Cannot upsample a signal of higher rate to lower rate" 
             else Double
outRate Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
inRate
         inRate :: Double
inRate  = p1 -> Double
forall p. Clock p => p -> Double
rate (p1
forall a. HasCallStack => a
undefined :: p1)
         outRate :: Double
outRate = p2 -> Double
forall p. Clock p => p -> Double
rate (p2
forall a. HasCallStack => a
undefined :: p2)

-- Some useful auxiliary functions.


-- | Converting an AbsPitch to hertz (cycles per second):

apToHz :: Floating a => AbsPitch -> a
apToHz :: forall a. Floating a => Int -> a
apToHz Int
ap = a
440 a -> a -> a
forall a. Num a => a -> a -> a
* a
2 a -> a -> a
forall a. Floating a => a -> a -> a
** (Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
ap Int -> Int -> Int
forall a. Num a => a -> a -> a
- Pitch -> Int
absPitch (PitchClass
A,Int
4)) a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
12)

-- | Converting from a Pitch value to Hz:

pchToHz :: Floating a => Pitch -> a
pchToHz :: forall a. Floating a => Pitch -> a
pchToHz = Int -> a
forall a. Floating a => Int -> a
apToHz (Int -> a) -> (Pitch -> Int) -> Pitch -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pitch -> Int
absPitch