{-# LANGUAGE NoImplicitPrelude #-}
module Synthesizer.Basic.Binary (
C(..), toCanonical,
fromCanonicalWith, fromCanonicalSimpleWith,
numberOfSignalChannels,
int16ToCanonical, int16FromCanonical,
int16FromFloat, int16FromDouble,
) where
import qualified Synthesizer.Frame.Stereo as Stereo
import Data.Monoid (Monoid, mappend, )
import qualified Algebra.FloatingPoint as Float
import qualified Algebra.ToInteger as ToInteger
import qualified Algebra.RealField as RealField
import qualified Algebra.RealRing as RealRing
import qualified Algebra.Field as Field
import qualified Algebra.Ring as Ring
import Data.Ord.HT (limit, )
import Data.Tuple.HT (mapFst, )
import Data.Int (Int16, )
import GHC.Float (float2Int, double2Int, )
import NumericPrelude.Numeric
import NumericPrelude.Base
import qualified Prelude as P98
class C a where
outputFromCanonical ::
(Bounded int, ToInteger.C int, Monoid out) =>
(int -> out) -> a -> out
numberOfChannels :: a -> Int
instance C Float where
outputFromCanonical :: forall int out.
(Bounded int, C int, Monoid out) =>
(int -> out) -> Float -> out
outputFromCanonical int -> out
pack =
int -> out
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall real int.
(C real, Bounded int, C int) =>
(real -> int) -> real -> int
fromCanonicalWith
(forall a b. (C a, C b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall real int. C real => (real -> int) -> real -> int
truncToRound Float -> Int
float2Int)
numberOfChannels :: Float -> Int
numberOfChannels Float
_ = Int
1
instance C Double where
outputFromCanonical :: forall int out.
(Bounded int, C int, Monoid out) =>
(int -> out) -> Double -> out
outputFromCanonical int -> out
pack =
int -> out
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall real int.
(C real, Bounded int, C int) =>
(real -> int) -> real -> int
fromCanonicalWith
(forall a b. (C a, C b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall real int. C real => (real -> int) -> real -> int
truncToRound Double -> Int
double2Int)
numberOfChannels :: Double -> Int
numberOfChannels Double
_ = Int
1
instance (C a, C b) => C (a,b) where
outputFromCanonical :: forall int out.
(Bounded int, C int, Monoid out) =>
(int -> out) -> (a, b) -> out
outputFromCanonical int -> out
pack (a, b)
x =
forall a int out.
(C a, Bounded int, C int, Monoid out) =>
(int -> out) -> a -> out
outputFromCanonical int -> out
pack (forall a b. (a, b) -> a
fst (a, b)
x) forall a. Monoid a => a -> a -> a
`mappend`
forall a int out.
(C a, Bounded int, C int, Monoid out) =>
(int -> out) -> a -> out
outputFromCanonical int -> out
pack (forall a b. (a, b) -> b
snd (a, b)
x)
numberOfChannels :: (a, b) -> Int
numberOfChannels (a, b)
x =
forall a. C a => a -> Int
numberOfChannels (forall a b. (a, b) -> a
fst (a, b)
x) forall a. C a => a -> a -> a
+
forall a. C a => a -> Int
numberOfChannels (forall a b. (a, b) -> b
snd (a, b)
x)
instance (C a) => C (Stereo.T a) where
outputFromCanonical :: forall int out.
(Bounded int, C int, Monoid out) =>
(int -> out) -> T a -> out
outputFromCanonical int -> out
pack T a
x =
forall a int out.
(C a, Bounded int, C int, Monoid out) =>
(int -> out) -> a -> out
outputFromCanonical int -> out
pack (forall a. T a -> a
Stereo.left T a
x) forall a. Monoid a => a -> a -> a
`mappend`
forall a int out.
(C a, Bounded int, C int, Monoid out) =>
(int -> out) -> a -> out
outputFromCanonical int -> out
pack (forall a. T a -> a
Stereo.right T a
x)
numberOfChannels :: T a -> Int
numberOfChannels T a
x =
forall a. C a => a -> Int
numberOfChannels (forall a. T a -> a
Stereo.left T a
x) forall a. C a => a -> a -> a
+
forall a. C a => a -> Int
numberOfChannels (forall a. T a -> a
Stereo.right T a
x)
{-# INLINE numberOfSignalChannels #-}
numberOfSignalChannels ::
C yv => sig yv -> Int
numberOfSignalChannels :: forall yv (sig :: * -> *). C yv => sig yv -> Int
numberOfSignalChannels sig yv
sig =
let aux :: C yv => sig yv -> yv -> Int
aux :: forall yv (sig :: * -> *). C yv => sig yv -> yv -> Int
aux sig yv
_ yv
dummy = forall a. C a => a -> Int
numberOfChannels yv
dummy
in forall yv (sig :: * -> *). C yv => sig yv -> yv -> Int
aux sig yv
sig forall a. HasCallStack => a
undefined
{-# INLINE fromCanonicalWith #-}
fromCanonicalWith ::
(Float.C real, Bounded int, ToInteger.C int) =>
(real -> int) -> (real -> int)
fromCanonicalWith :: forall real int.
(C real, Bounded int, C int) =>
(real -> int) -> real -> int
fromCanonicalWith real -> int
rnd real
r =
let
s :: real
s = forall a b. (C a, C b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound forall a. a -> a -> a
`asTypeOf` int
i)
ss :: real
ss = if real -> int
rnd real
s forall a. Ord a => a -> a -> Bool
< int
0 then forall a. C a => a -> a
decreaseFloat real
s else real
s
i :: int
i = real -> int
rnd (real
ss forall a. C a => a -> a -> a
* forall a. Ord a => (a, a) -> a -> a
limit (-real
1, real
1) real
r)
in int
i
{-# INLINE decreaseFloat #-}
decreaseFloat :: Float.C a => a -> a
decreaseFloat :: forall a. C a => a -> a
decreaseFloat =
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. C a => Integer -> Int -> a
Float.encode forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst (forall a. C a => a -> a -> a
subtract Integer
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. C a => a -> (Integer, Int)
Float.decode
{-# INLINE fromCanonicalSimpleWith #-}
fromCanonicalSimpleWith ::
(RealRing.C real, Bounded int, ToInteger.C int) =>
(real -> int) -> (real -> int)
fromCanonicalSimpleWith :: forall real int.
(C real, Bounded int, C int) =>
(real -> int) -> real -> int
fromCanonicalSimpleWith real -> int
rnd real
r =
let s :: real
s = forall a b. (C a, C b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound forall a. a -> a -> a
`asTypeOf` int
i)
i :: int
i = real -> int
rnd (real
s forall a. C a => a -> a -> a
* forall a. Ord a => (a, a) -> a -> a
limit (-real
1, real
1) real
r)
in int
i
{-# INLINE truncToRound #-}
truncToRound ::
(RealField.C real) =>
(real -> int) -> (real -> int)
truncToRound :: forall real int. C real => (real -> int) -> real -> int
truncToRound real -> int
trunc real
x =
real -> int
trunc forall a b. (a -> b) -> a -> b
$
if real
xforall a. Ord a => a -> a -> Bool
<real
0
then real
x forall a. C a => a -> a -> a
- real
0.5
else real
x forall a. C a => a -> a -> a
+ real
0.5
{-# INLINE scale16 #-}
scale16 :: (Ring.C a, Ord a) => a -> a
scale16 :: forall a. (C a, Ord a) => a -> a
scale16 a
x = a
32767 forall a. C a => a -> a -> a
* forall a. Ord a => (a, a) -> a -> a
limit (-a
1, a
1) a
x
{-# INLINE int16FromCanonical #-}
int16FromCanonical :: (RealRing.C a) => a -> Int16
int16FromCanonical :: forall a. C a => a -> Int16
int16FromCanonical =
(forall a b. (Integral a, Num b) => a -> b
P98.fromIntegral :: Int -> Int16) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (C a, C b) => a -> b
RealRing.roundSimple forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (C a, Ord a) => a -> a
scale16
{-# INLINE int16FromFloat #-}
int16FromFloat :: Float -> Int16
int16FromFloat :: Float -> Int16
int16FromFloat = forall a b. (Integral a, Num b) => a -> b
P98.fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Int
float2Int forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (C a, Ord a) => a -> a
scale16
{-# INLINE int16FromDouble #-}
int16FromDouble :: Double -> Int16
int16FromDouble :: Double -> Int16
int16FromDouble = forall a b. (Integral a, Num b) => a -> b
P98.fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Int
double2Int forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double
32767forall a. C a => a -> a -> a
*) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => (a, a) -> a -> a
limit (-Double
1, Double
1)
{-# INLINE toCanonical #-}
toCanonical ::
(Field.C real, Bounded int, ToInteger.C int) =>
(int -> real)
toCanonical :: forall real int. (C real, Bounded int, C int) => int -> real
toCanonical int
i =
let s :: real
s = forall a b. (C a, C b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound forall a. a -> a -> a
`asTypeOf` int
i)
in forall a b. (C a, C b) => a -> b
fromIntegral int
i forall a. C a => a -> a -> a
/ real
s
{-# INLINE int16ToCanonical #-}
int16ToCanonical :: (Field.C a) => Int16 -> a
int16ToCanonical :: forall a. C a => Int16 -> a
int16ToCanonical Int16
x = forall a b. (C a, C b) => a -> b
fromIntegral Int16
x forall a. C a => a -> a -> a
/ a
32767