{-# 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 {-
       I hope that the complicated computation of a proper upper bound
       is turned into a constant.
       -}
       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)
       {-
       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 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


{- |
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 = 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
{-
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 =
   (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 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 = 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