{-# LANGUAGE NoImplicitPrelude #-}
module Synthesizer.Plain.Play where

import qualified Synthesizer.Plain.Builder as Builder
import qualified Synthesizer.Basic.Binary as BinSmp

import qualified Sound.Sox.Frame as Frame
import qualified Sound.Sox.Frame.Stereo as Stereo
import qualified Sound.Sox.Option.Format as SoxOpt
import qualified Sound.Sox.Play as Play
import qualified Sound.Sox.Signal.List as SoxList

import Foreign.Storable (Storable, )
import Data.Int (Int16, )
import Data.Monoid (mconcat, )

import System.Exit (ExitCode, )

import qualified Algebra.ToInteger as ToInteger
import qualified Algebra.RealRing as RealRing

import NumericPrelude.Numeric
import NumericPrelude.Base


{- |
See 'Synthesizer.Plain.File.write'.
-}
render ::
   (Storable int, Frame.C int, ToInteger.C int, Bounded int,
    RealRing.C a, BinSmp.C v) =>
   Builder.Put int -> a -> (a -> [v]) -> IO ExitCode
render :: forall int a v.
(Storable int, C int, C int, Bounded int, C a, C v) =>
Put int -> a -> (a -> [v]) -> IO ExitCode
render Put int
put a
sampleRate a -> [v]
renderer =
   forall int a v.
(Storable int, C int, C int, Bounded int, C a, C v) =>
Put int -> a -> [v] -> IO ExitCode
auto Put int
put a
sampleRate (a -> [v]
renderer a
sampleRate)

renderToInt16 :: (RealRing.C a, BinSmp.C v) => a -> (a -> [v]) -> IO ExitCode
renderToInt16 :: forall a v. (C a, C v) => a -> (a -> [v]) -> IO ExitCode
renderToInt16 a
sampleRate a -> [v]
renderer =
   forall a v. (C a, C v) => a -> [v] -> IO ExitCode
toInt16 a
sampleRate (a -> [v]
renderer a
sampleRate)

renderMonoToInt16 :: (RealRing.C a) => a -> (a -> [a]) -> IO ExitCode
renderMonoToInt16 :: forall a. C a => a -> (a -> [a]) -> IO ExitCode
renderMonoToInt16 a
sampleRate a -> [a]
renderer =
   forall a. C a => a -> [a] -> IO ExitCode
monoToInt16 a
sampleRate (a -> [a]
renderer a
sampleRate)

renderStereoToInt16 :: (RealRing.C a) => a -> (a -> [(a,a)]) -> IO ExitCode
renderStereoToInt16 :: forall a. C a => a -> (a -> [(a, a)]) -> IO ExitCode
renderStereoToInt16 a
sampleRate a -> [(a, a)]
renderer =
   forall a. C a => a -> [(a, a)] -> IO ExitCode
stereoToInt16 a
sampleRate (a -> [(a, a)]
renderer a
sampleRate)


{- |
See 'Synthesizer.Plain.File.write'.
-}
auto ::
   (Storable int, Frame.C int, ToInteger.C int, Bounded int,
    RealRing.C a, BinSmp.C v) =>
   Builder.Put int -> a -> [v] -> IO ExitCode
auto :: forall int a v.
(Storable int, C int, C int, Bounded int, C a, C v) =>
Put int -> a -> [v] -> IO ExitCode
auto Put int
put a
sampleRate [v]
signal =
   forall a v. (C a, C v, Storable v) => T -> a -> [v] -> IO ExitCode
raw
      (Int -> T
SoxOpt.numberOfChannels (forall yv (sig :: * -> *). C yv => sig yv -> Int
BinSmp.numberOfSignalChannels [v]
signal))
      a
sampleRate
      (forall a. T a -> [a]
Builder.run forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a int out.
(C a, Bounded int, C int, Monoid out) =>
(int -> out) -> a -> out
BinSmp.outputFromCanonical Put int
put) forall a b. (a -> b) -> a -> b
$
       [v]
signal)

toInt16 :: (RealRing.C a, BinSmp.C v) => a -> [v] -> IO ExitCode
toInt16 :: forall a v. (C a, C v) => a -> [v] -> IO ExitCode
toInt16 =
   forall int a v.
(Storable int, C int, C int, Bounded int, C a, C v) =>
Put int -> a -> [v] -> IO ExitCode
auto (forall a. Put a
Builder.put :: Builder.Put Int16)

monoToInt16 :: (RealRing.C a) => a -> [a] -> IO ExitCode
monoToInt16 :: forall a. C a => a -> [a] -> IO ExitCode
monoToInt16 a
sampleRate [a]
signal =
   forall a v. (C a, C v, Storable v) => T -> a -> [v] -> IO ExitCode
raw T
SoxOpt.none a
sampleRate
      (forall a b. (a -> b) -> [a] -> [b]
map forall a. C a => a -> Int16
BinSmp.int16FromCanonical [a]
signal)

stereoToInt16 :: (RealRing.C a) => a -> [(a,a)] -> IO ExitCode
stereoToInt16 :: forall a. C a => a -> [(a, a)] -> IO ExitCode
stereoToInt16 a
sampleRate [(a, a)]
signal =
   forall a v. (C a, C v, Storable v) => T -> a -> [v] -> IO ExitCode
raw T
SoxOpt.none a
sampleRate
      (forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. C a => a -> Int16
BinSmp.int16FromCanonical forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. a -> a -> T a
Stereo.cons) [(a, a)]
signal)


raw :: (RealRing.C a, Frame.C v, Storable v) =>
   SoxOpt.T -> a -> [v] -> IO ExitCode
raw :: forall a v. (C a, C v, Storable v) => T -> a -> [v] -> IO ExitCode
raw T
opts a
sampleRate [v]
signal =
   forall y (sig :: * -> *).
C y =>
(Handle -> sig y -> IO ()) -> T -> T -> Int -> sig y -> IO ExitCode
Play.extended forall a. Storable a => Handle -> [a] -> IO ()
SoxList.put T
opts T
SoxOpt.none (forall a b. (C a, C b) => a -> b
round a
sampleRate) [v]
signal


exampleMono :: IO ExitCode
exampleMono :: IO ExitCode
exampleMono =
   forall a. C a => a -> [a] -> IO ExitCode
monoToInt16 (Double
11025::Double) (forall a b. (a -> b) -> [a] -> [b]
map forall a. C a => a -> a
sin [Double
0::Double,Double
0.2..])

exampleStereo :: IO ExitCode
exampleStereo :: IO ExitCode
exampleStereo =
   forall a. C a => a -> [(a, a)] -> IO ExitCode
stereoToInt16 (Double
11025::Double) forall a b. (a -> b) -> a -> b
$
      forall a b. [a] -> [b] -> [(a, b)]
zip
         (forall a b. (a -> b) -> [a] -> [b]
map forall a. C a => a -> a
sin [Double
0::Double,Double
0.199..])
         (forall a b. (a -> b) -> [a] -> [b]
map forall a. C a => a -> a
sin [Double
0::Double,Double
0.201..])