{-# 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 (int -> out) -> (Float -> int) -> Float -> out
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(Float -> int) -> Float -> int
forall real int.
(C real, Bounded int, C int) =>
(real -> int) -> real -> int
fromCanonicalWith
(Int -> int
forall a b. (C a, C b) => a -> b
fromIntegral (Int -> int) -> (Float -> Int) -> Float -> int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Float -> Int) -> Float -> Int
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 (int -> out) -> (Double -> int) -> Double -> out
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(Double -> int) -> Double -> int
forall real int.
(C real, Bounded int, C int) =>
(real -> int) -> real -> int
fromCanonicalWith
(Int -> int
forall a b. (C a, C b) => a -> b
fromIntegral (Int -> int) -> (Double -> Int) -> Double -> int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Int) -> Double -> Int
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 =
(int -> out) -> a -> out
forall a int out.
(C a, Bounded int, C int, Monoid out) =>
(int -> out) -> a -> out
forall int out.
(Bounded int, C int, Monoid out) =>
(int -> out) -> a -> out
outputFromCanonical int -> out
pack ((a, b) -> a
forall a b. (a, b) -> a
fst (a, b)
x) out -> out -> out
forall a. Monoid a => a -> a -> a
`mappend`
(int -> out) -> b -> out
forall a int out.
(C a, Bounded int, C int, Monoid out) =>
(int -> out) -> a -> out
forall int out.
(Bounded int, C int, Monoid out) =>
(int -> out) -> b -> out
outputFromCanonical int -> out
pack ((a, b) -> b
forall a b. (a, b) -> b
snd (a, b)
x)
numberOfChannels :: (a, b) -> Int
numberOfChannels (a, b)
x =
a -> Int
forall a. C a => a -> Int
numberOfChannels ((a, b) -> a
forall a b. (a, b) -> a
fst (a, b)
x) Int -> Int -> Int
forall a. C a => a -> a -> a
+
b -> Int
forall a. C a => a -> Int
numberOfChannels ((a, b) -> b
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 =
(int -> out) -> a -> out
forall a int out.
(C a, Bounded int, C int, Monoid out) =>
(int -> out) -> a -> out
forall int out.
(Bounded int, C int, Monoid out) =>
(int -> out) -> a -> out
outputFromCanonical int -> out
pack (T a -> a
forall a. T a -> a
Stereo.left T a
x) out -> out -> out
forall a. Monoid a => a -> a -> a
`mappend`
(int -> out) -> a -> out
forall a int out.
(C a, Bounded int, C int, Monoid out) =>
(int -> out) -> a -> out
forall int out.
(Bounded int, C int, Monoid out) =>
(int -> out) -> a -> out
outputFromCanonical int -> out
pack (T a -> a
forall a. T a -> a
Stereo.right T a
x)
numberOfChannels :: T a -> Int
numberOfChannels T a
x =
a -> Int
forall a. C a => a -> Int
numberOfChannels (T a -> a
forall a. T a -> a
Stereo.left T a
x) Int -> Int -> Int
forall a. C a => a -> a -> a
+
a -> Int
forall a. C a => a -> Int
numberOfChannels (T a -> a
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 = yv -> Int
forall a. C a => a -> Int
numberOfChannels yv
dummy
in sig yv -> yv -> Int
forall yv (sig :: * -> *). C yv => sig yv -> yv -> Int
aux sig yv
sig yv
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 = int -> real
forall a b. (C a, C b) => a -> b
fromIntegral (int
forall a. Bounded a => a
maxBound int -> int -> int
forall a. a -> a -> a
`asTypeOf` int
i)
ss :: real
ss = if real -> int
rnd real
s int -> int -> Bool
forall a. Ord a => a -> a -> Bool
< int
0 then real -> real
forall a. C a => a -> a
decreaseFloat real
s else real
s
i :: int
i = real -> int
rnd (real
ss real -> real -> real
forall a. C a => a -> a -> a
* (real, real) -> real -> real
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 =
(Integer -> Int -> a) -> (Integer, Int) -> a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Integer -> Int -> a
forall a. C a => Integer -> Int -> a
Float.encode ((Integer, Int) -> a) -> (a -> (Integer, Int)) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Integer) -> (Integer, Int) -> (Integer, Int)
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst (Integer -> Integer -> Integer
forall a. C a => a -> a -> a
subtract Integer
1) ((Integer, Int) -> (Integer, Int))
-> (a -> (Integer, Int)) -> a -> (Integer, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> (Integer, Int)
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 = int -> real
forall a b. (C a, C b) => a -> b
fromIntegral (int
forall a. Bounded a => a
maxBound int -> int -> int
forall a. a -> a -> a
`asTypeOf` int
i)
i :: int
i = real -> int
rnd (real
s real -> real -> real
forall a. C a => a -> a -> a
* (real, real) -> real -> real
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 (real -> int) -> real -> int
forall a b. (a -> b) -> a -> b
$
if real
xreal -> real -> Bool
forall a. Ord a => a -> a -> Bool
<real
0
then real
x real -> real -> real
forall a. C a => a -> a -> a
- real
0.5
else real
x real -> real -> real
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 a -> a -> a
forall a. C a => a -> a -> a
* (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 =
(Int -> Int16
forall a b. (Integral a, Num b) => a -> b
P98.fromIntegral :: Int -> Int16) (Int -> Int16) -> (a -> Int) -> a -> Int16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Int
forall a b. (C a, C b) => a -> b
RealRing.roundSimple (a -> Int) -> (a -> a) -> a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
forall a. (C a, Ord a) => a -> a
scale16
{-# INLINE int16FromFloat #-}
int16FromFloat :: Float -> Int16
int16FromFloat :: Float -> Int16
int16FromFloat = Int -> Int16
forall a b. (Integral a, Num b) => a -> b
P98.fromIntegral (Int -> Int16) -> (Float -> Int) -> Float -> Int16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Int
float2Int (Float -> Int) -> (Float -> Float) -> Float -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float
forall a. (C a, Ord a) => a -> a
scale16
{-# INLINE int16FromDouble #-}
int16FromDouble :: Double -> Int16
int16FromDouble :: Double -> Int16
int16FromDouble = Int -> Int16
forall a b. (Integral a, Num b) => a -> b
P98.fromIntegral (Int -> Int16) -> (Double -> Int) -> Double -> Int16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Int
double2Int (Double -> Int) -> (Double -> Double) -> Double -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double
32767Double -> Double -> Double
forall a. C a => a -> a -> a
*) (Double -> Double) -> (Double -> Double) -> Double -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double, Double) -> Double -> Double
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 = int -> real
forall a b. (C a, C b) => a -> b
fromIntegral (int
forall a. Bounded a => a
maxBound int -> int -> int
forall a. a -> a -> a
`asTypeOf` int
i)
in int -> real
forall a b. (C a, C b) => a -> b
fromIntegral int
i real -> real -> real
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 = Int16 -> a
forall a b. (C a, C b) => a -> b
fromIntegral Int16
x a -> a -> a
forall a. C a => a -> a -> a
/ a
32767