module Data.MediaBus.Media.Audio.Raw.Alaw
( ALaw()
, encodeALawSample
, decodeALawSample
, alawSample
, alawValue
) where
import Control.Lens
import Control.DeepSeq (NFData)
import Data.Bits
import Data.Default
import Data.Function (on)
import Data.Int
import Data.MediaBus.Media.Audio.Raw
import Data.MediaBus.Media.Audio.Raw.Signed16bit
import Data.MediaBus.Media.Blank
import Data.Typeable
import Data.Word
import Foreign.Storable
import GHC.Generics (Generic)
import Test.QuickCheck (Arbitrary(..))
newtype ALaw = MkALaw
{ _alawValue :: Word8
} deriving ( Show
, Storable
, Num
, Eq
, Bits
, Arbitrary
, Generic
, NFData
, Default
, Typeable
)
alawValue :: Iso' ALaw Word8
alawValue = iso _alawValue MkALaw
alawSample :: Iso' ALaw S16
alawSample = iso decodeALawSample encodeALawSample
instance CanBeBlank ALaw where
blank = 0xD5
instance IsPcmValue ALaw where
pcmAverage !x !y = encodeALawSample $ (pcmAverage `on` decodeALawSample) x y
decodeALawSample :: ALaw -> S16
decodeALawSample (MkALaw !a') =
let !a = a' `xor` 85
!quant_mask = 15
!quant_shift = 4
!seg_mask = 112
!seg_shift = 4
tBase, tAbs, seg :: Int16
!seg = (fromIntegral a .&. seg_mask) `shiftR` seg_shift
!tBase = (fromIntegral a .&. quant_mask) `shiftL` quant_shift
!tAbs =
case seg of
0 -> tBase + 8
1 -> tBase + 264
_ -> (tBase + 264) `shiftL` fromIntegral (seg 1)
!isPos = testBit a 7
in MkS16 $
if isPos
then tAbs
else tAbs * (1)
encodeALawSample :: S16 -> ALaw
encodeALawSample (MkS16 !pcmVal') =
let !pcmVal = pcmVal' `shiftR` 3
(!mask, !pcmValAbs) =
if pcmVal >= 0
then ( 0xD5
, pcmVal)
else ( 0x55
, (1) * pcmVal 1)
!segment
| pcmValAbs <= 31 = 0
| pcmValAbs <= 63 = 1
| pcmValAbs <= 127 = 2
| pcmValAbs <= 255 = 3
| pcmValAbs <= 511 = 4
| pcmValAbs <= 1023 = 5
| pcmValAbs <= 2047 = 6
| pcmValAbs <= 4095 = 7
| otherwise = 8
!res =
if segment == 8
then 0x7F
else let !segShift =
if segment < 2
then 1
else fromIntegral segment
in shiftL segment 4 .|. (shiftR pcmValAbs segShift .&. 0xF)
in MkALaw (fromIntegral res `xor` mask)