{-# 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 {-
       I hope that the complicated computation of a proper upper bound
       is turned into a constant.
       -}
       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)
       {-
       The floating point type might be less precise
       than the integer type.
       In this case the upper bound might be rounded up
       when converting from integer to float.
       Then converting back from float to integer
       may yield a negative value.
       -}
       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


{- |
Warning:
This may produce negative results for positive input in some cases!
The problem is that (maxBound :: Int32) cannot be represented exactly as Float,
the Float value is actually a bit larger than the Int32 value.
Thus when converting the Float back to Int32 it becomes negative.
Better use 'fromCanonicalWith'.
-}
{-# 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
{-
The round procedure is complicated and usually unnecessary
int16FromCanonical = (P98.fromIntegral :: Int -> Int16) . round . scale16
-}
{- in GHC-6.4 inefficient, since 'round' for target Int16 is not optimized
int16FromCanonical = round . scale16
-}
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 scale16Double #-}
scale16Double :: (Ring.C a, Ord a) => a -> a
scale16Double x = 32767 * clip (-1) 1 x
-}

{-# INLINE int16FromDouble #-}
int16FromDouble :: Double -> Int16
{- Why is scale16 not inlined here? See FusionTest.mixTest3
int16FromDouble = P98.fromIntegral . double2Int . scale16
-}
-- int16FromDouble = P98.fromIntegral . double2Int . scale16Double
-- int16FromDouble x = P98.fromIntegral (double2Int (scale16 x))
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