diff --git a/Data/ZoomCache/PCM.hs b/Data/ZoomCache/PCM.hs new file mode 100644 --- /dev/null +++ b/Data/ZoomCache/PCM.hs @@ -0,0 +1,31 @@ +{-# OPTIONS -Wall #-} + +module Data.ZoomCache.PCM ( + -- * PCM Type + PCM(..) + + -- * Codec identifiers + , pcmIdentifiers +) where + +import Data.ByteString (ByteString) +import Data.Int +import Data.ZoomCache.Codec (Codec, identifyCodec) + +import Data.ZoomCache.PCM.Types + +import Data.ZoomCache.PCM.IEEE754() +import Data.ZoomCache.PCM.Int() + +---------------------------------------------------------------------- + +pcmIdentifiers :: [ByteString -> Maybe Codec] +pcmIdentifiers = + [ identifyCodec (undefined :: PCM Float) + , identifyCodec (undefined :: PCM Double) + , identifyCodec (undefined :: PCM Int) + , identifyCodec (undefined :: PCM Int8) + , identifyCodec (undefined :: PCM Int16) + , identifyCodec (undefined :: PCM Int32) + , identifyCodec (undefined :: PCM Int64) + ] diff --git a/Data/ZoomCache/PCM/IEEE754.hs b/Data/ZoomCache/PCM/IEEE754.hs new file mode 100644 --- /dev/null +++ b/Data/ZoomCache/PCM/IEEE754.hs @@ -0,0 +1,236 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeFamilies #-} +{-# OPTIONS_GHC -Wall -fno-warn-orphans #-} +---------------------------------------------------------------------- +{- | + Module : Data.ZoomCache.PCM.IEEE754 + Copyright : Conrad Parker + License : BSD3-style (see LICENSE) + + Maintainer : Conrad Parker + Stability : unstable + Portability : unknown + +Default codec implementation for PCM Audio of type Float and Double. +This module implements the interfaces documented in "Data.ZoomCache.Codec". + +The table below describes the encoding of SummaryData for PCM.Float. + +@ + | ... | -35 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Min (float) | 36-39 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Max (float) | 40-43 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Mean [DC Bias] (float) | 44-47 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | RMS (float) | 48-51 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ +@ + +The table below describes the encoding of SummaryData for PCM.Double. + +@ + | ... | -35 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Min (double) | 36-39 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | | 40-43 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Max (double) | 44-47 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | | 48-51 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Mean [DC Bias] (double) | 52-55 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | | 56-59 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | RMS (double) | 60-63 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | | 64-67 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ +@ + +Field encoding formats: + + @float@: big-endian IEEE 754-2008 binary32 (IEEE 754-1985 single) + @double@: big-endian IEEE 754-2008 binary64 (IEEE 754-1985 double) + +-} +---------------------------------------------------------------------- + +module Data.ZoomCache.PCM.IEEE754 ( + SummaryData(..) + , SummaryWork(..) +)where + +import Blaze.ByteString.Builder +import Control.Applicative ((<$>)) +import Control.Monad.Trans (MonadIO) +import Data.ByteString (ByteString) +import Data.Iteratee (Iteratee) +import Data.Word +import Text.Printf + +import Data.ZoomCache.Codec +import Data.ZoomCache.PCM.Internal +import Data.ZoomCache.PCM.Types + +---------------------------------------------------------------------- +-- Float + +instance ZoomReadable (PCM Float) where + data SummaryData (PCM Float) = SummaryPCMFloat + { summaryPCMFloatMin :: {-# UNPACK #-}!Float + , summaryPCMFloatMax :: {-# UNPACK #-}!Float + , summaryPCMFloatAvg :: {-# UNPACK #-}!Double + , summaryPCMFloatRMS :: {-# UNPACK #-}!Double + } + + trackIdentifier = const "ZPCMf32b" + + readRaw = PCM <$> readFloat32be + readSummary = readSummaryPCM + + prettyRaw = prettyPacketPCMFloat + prettySummaryData = prettySummaryPCMFloat + +{-# SPECIALIZE readSummaryPCM :: (Functor m, MonadIO m) => Iteratee [Word8] m (SummaryData (PCM Float)) #-} +{-# SPECIALIZE readSummaryPCM :: (Functor m, MonadIO m) => Iteratee ByteString m (SummaryData (PCM Float)) #-} + +instance ZoomWrite (PCM Float) where + write = writeData + +instance ZoomWrite (TimeStamp, PCM Float) where + write = writeDataVBR + +instance ZoomWritable (PCM Float) where + data SummaryWork (PCM Float) = SummaryWorkPCMFloat + { swPCMFloatTime :: {-# UNPACK #-}!TimeStamp + , swPCMFloatMin :: {-# UNPACK #-}!Float + , swPCMFloatMax :: {-# UNPACK #-}!Float + , swPCMFloatSum :: {-# UNPACK #-}!Double + , swPCMFloatSumSq :: {-# UNPACK #-}!Double + } + fromRaw = pcmFromRaw . unPCM + fromSummaryData = fromSummaryPCM + + initSummaryWork = initSummaryPCMFloat + toSummaryData = mkSummaryPCM + updateSummaryData = updateSummaryPCM + appendSummaryData = appendSummaryPCM + +instance ZoomPCM Float where + pcmFromRaw = fromFloat + + pcmMin = summaryPCMFloatMin + pcmMax = summaryPCMFloatMax + pcmAvg = summaryPCMFloatAvg + pcmRMS = summaryPCMFloatRMS + + pcmWorkTime = swPCMFloatTime + pcmWorkMin = swPCMFloatMin + pcmWorkMax = swPCMFloatMax + pcmWorkSum = swPCMFloatSum + pcmWorkSumSq = swPCMFloatSumSq + + pcmMkSummary = SummaryPCMFloat + pcmMkSummaryWork = SummaryWorkPCMFloat + +{-# SPECIALIZE fromSummaryPCM :: SummaryData (PCM Float) -> Builder #-} +{-# SPECIALIZE mkSummaryPCM :: TimeStampDiff -> SummaryWork (PCM Float) -> SummaryData (PCM Float) #-} +{-# SPECIALIZE appendSummaryPCM :: TimeStampDiff -> SummaryData (PCM Float) -> TimeStampDiff -> SummaryData (PCM Float) -> SummaryData (PCM Float) #-} +{-# SPECIALIZE updateSummaryPCM :: TimeStamp -> PCM Float -> SummaryWork (PCM Float) -> SummaryWork (PCM Float) #-} + +---------------------------------------------------------------------- +-- Double + +instance ZoomReadable (PCM Double) where + data SummaryData (PCM Double) = SummaryPCMDouble + { summaryPCMDoubleMin :: {-# UNPACK #-}!Double + , summaryPCMDoubleMax :: {-# UNPACK #-}!Double + , summaryPCMDoubleAvg :: {-# UNPACK #-}!Double + , summaryPCMDoubleRMS :: {-# UNPACK #-}!Double + } + + trackIdentifier = const "ZPCMf64b" + + readRaw = PCM <$> readDouble64be + readSummary = readSummaryPCM + + prettyRaw = prettyPacketPCMFloat + prettySummaryData = prettySummaryPCMFloat + +{-# SPECIALIZE readSummaryPCM :: (Functor m, MonadIO m) => Iteratee [Word8] m (SummaryData (PCM Double)) #-} +{-# SPECIALIZE readSummaryPCM :: (Functor m, MonadIO m) => Iteratee ByteString m (SummaryData (PCM Double)) #-} + +instance ZoomWrite (PCM Double) where + write = writeData + +instance ZoomWrite (TimeStamp, PCM Double) where + write = writeDataVBR + +instance ZoomWritable (PCM Double) where + data SummaryWork (PCM Double) = SummaryWorkPCMDouble + { swPCMDoubleTime :: {-# UNPACK #-}!TimeStamp + , swPCMDoubleMin :: {-# UNPACK #-}!Double + , swPCMDoubleMax :: {-# UNPACK #-}!Double + , swPCMDoubleSum :: {-# UNPACK #-}!Double + , swPCMDoubleSumSq :: {-# UNPACK #-}!Double + } + fromRaw = pcmFromRaw . unPCM + fromSummaryData = fromSummaryPCM + + initSummaryWork = initSummaryPCMFloat + toSummaryData = mkSummaryPCM + updateSummaryData = updateSummaryPCM + appendSummaryData = appendSummaryPCM + +instance ZoomPCM Double where + pcmFromRaw = fromDouble + + pcmMin = summaryPCMDoubleMin + pcmMax = summaryPCMDoubleMax + pcmAvg = summaryPCMDoubleAvg + pcmRMS = summaryPCMDoubleRMS + + pcmWorkTime = swPCMDoubleTime + pcmWorkMin = swPCMDoubleMin + pcmWorkMax = swPCMDoubleMax + pcmWorkSum = swPCMDoubleSum + pcmWorkSumSq = swPCMDoubleSumSq + + pcmMkSummary = SummaryPCMDouble + pcmMkSummaryWork = SummaryWorkPCMDouble + +{-# SPECIALIZE fromSummaryPCM :: SummaryData (PCM Double) -> Builder #-} +{-# SPECIALIZE mkSummaryPCM :: TimeStampDiff -> SummaryWork (PCM Double) -> SummaryData (PCM Double) #-} +{-# SPECIALIZE appendSummaryPCM :: TimeStampDiff -> SummaryData (PCM Double) -> TimeStampDiff -> SummaryData (PCM Double) -> SummaryData (PCM Double) #-} +{-# SPECIALIZE updateSummaryPCM :: TimeStamp -> PCM Double -> SummaryWork (PCM Double) -> SummaryWork (PCM Double) #-} + +---------------------------------------------------------------------- +-- Helpers for float and double + +prettyPacketPCMFloat :: PrintfArg a => PCM a -> String +prettyPacketPCMFloat = printf "%.3f" . unPCM + +prettySummaryPCMFloat :: (PrintfArg a, ZoomPCM a) + => SummaryData (PCM a) -> String +prettySummaryPCMFloat s = concat + [ printf "\tmin: %.3f\tmax: %.3f\t" (pcmMin s) (pcmMax s) + , printf "avg: %.3f\trms: %.3f" (pcmAvg s) (pcmRMS s) + ] + +initSummaryPCMFloat :: (RealFloat a, ZoomPCM a) + => TimeStamp -> SummaryWork (PCM a) +initSummaryPCMFloat entry = pcmMkSummaryWork + entry + floatMax + (negate floatMax) + 0.0 + 0.0 diff --git a/Data/ZoomCache/PCM/Int.hs b/Data/ZoomCache/PCM/Int.hs new file mode 100644 --- /dev/null +++ b/Data/ZoomCache/PCM/Int.hs @@ -0,0 +1,461 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeFamilies #-} +{-# OPTIONS_GHC -Wall -fno-warn-orphans #-} +---------------------------------------------------------------------- +{- | + Module : Data.ZoomCache.PCM.Int + Copyright : Conrad Parker + License : BSD3-style (see LICENSE) + + Maintainer : Conrad Parker + Stability : unstable + Portability : unknown + +Default codec implementation for PCM Audio of type Int. This module +implements the interfaces documented in "Data.ZoomCache.Codec". + +The table below describes the encoding of SummaryData for 'PCM Int16': + +@ + | ... | -35 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Min (int16) | Max (int16) | 36-39 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Mean [DC Bias] (double) | 40-43 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | | 44-47 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | RMS (double) | 48-51 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | | 52-55 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ +@ + +The table below describes the encoding of SummaryData for 'PCM Int' and +'PCM Int32': + +@ + | ... | -35 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Min (int32) | 36-39 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Max (int32) | 40-43 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Mean [DC Bias] (double) | 44-47 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | | 48-51 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | RMS (double) | 52-55 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | | 56-59 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ +@ + +The table below describes the encoding of SummaryData for 'PCM Int64': + +@ + | ... | -35 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Min (int64) | 36-39 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | | 40-43 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Max (int64) | 44-47 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | | 48-51 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Mean [DC Bias] (double) | 52-55 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | | 56-59 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | RMS (double) | 60-63 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | | 64-67 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ +@ + +Field encoding formats: + + @int32@: 32bit big endian + + @int64@: 64bit big endian + + @double@: big-endian IEEE 754-2008 binary64 (IEEE 754-1985 double) + +-} +---------------------------------------------------------------------- + +module Data.ZoomCache.PCM.Int ( + SummaryData(..) + , SummaryWork(..) +)where + +import Blaze.ByteString.Builder +import Control.Applicative ((<$>)) +import Control.Monad.Trans (MonadIO) +import Data.ByteString (ByteString) +import Data.Int +import Data.Iteratee (Iteratee) +import Data.Word +import Text.Printf + +import Data.ZoomCache.Codec +import Data.ZoomCache.PCM.Internal +import Data.ZoomCache.PCM.Types + +---------------------------------------------------------------------- +-- Int + +instance ZoomReadable (PCM Int) where + data SummaryData (PCM Int) = SummaryPCMInt + { summaryIntMin :: {-# UNPACK #-}!Int + , summaryIntMax :: {-# UNPACK #-}!Int + , summaryIntAvg :: {-# UNPACK #-}!Double + , summaryIntRMS :: {-# UNPACK #-}!Double + } + + trackIdentifier = const "ZPCMi32b" + + readRaw = PCM <$> readInt32be + readSummary = readSummaryPCM + + prettyRaw = prettyPacketPCMInt + prettySummaryData = prettySummaryPCMInt + +{-# SPECIALIZE readSummaryPCM :: (Functor m, MonadIO m) => Iteratee [Word8] m (SummaryData (PCM Int)) #-} +{-# SPECIALIZE readSummaryPCM :: (Functor m, MonadIO m) => Iteratee ByteString m (SummaryData (PCM Int)) #-} + +instance ZoomWrite (PCM Int) where + write = writeData + +instance ZoomWrite (TimeStamp, (PCM Int)) where + write = writeDataVBR + +instance ZoomWritable (PCM Int) where + data SummaryWork (PCM Int) = SummaryWorkPCMInt + { swPCMIntTime :: {-# UNPACK #-}!TimeStamp + , swPCMIntMin :: {-# UNPACK #-}!Int + , swPCMIntMax :: {-# UNPACK #-}!Int + , swPCMIntSum :: {-# UNPACK #-}!Double + , swPCMIntSumSq :: {-# UNPACK #-}!Double + } + + fromRaw = pcmFromRaw . unPCM + fromSummaryData = fromSummaryPCM + + initSummaryWork = initSummaryPCMBounded + toSummaryData = mkSummaryPCM + updateSummaryData = updateSummaryPCM + appendSummaryData = appendSummaryPCM + +instance ZoomPCM Int where + pcmFromRaw = fromIntegral32be + + pcmMin = summaryIntMin + pcmMax = summaryIntMax + pcmAvg = summaryIntAvg + pcmRMS = summaryIntRMS + + pcmWorkTime = swPCMIntTime + pcmWorkMin = swPCMIntMin + pcmWorkMax = swPCMIntMax + pcmWorkSum = swPCMIntSum + pcmWorkSumSq = swPCMIntSumSq + + pcmMkSummary = SummaryPCMInt + pcmMkSummaryWork = SummaryWorkPCMInt + +{-# SPECIALIZE fromSummaryPCM :: SummaryData (PCM Int) -> Builder #-} +{-# SPECIALIZE initSummaryPCMBounded :: TimeStamp -> SummaryWork (PCM Int) #-} +{-# SPECIALIZE mkSummaryPCM :: TimeStampDiff -> SummaryWork (PCM Int) -> SummaryData (PCM Int) #-} +{-# SPECIALIZE appendSummaryPCM :: TimeStampDiff -> SummaryData (PCM Int) -> TimeStampDiff -> SummaryData (PCM Int) -> SummaryData (PCM Int) #-} +{-# SPECIALIZE updateSummaryPCM :: TimeStamp -> PCM Int -> SummaryWork (PCM Int) -> SummaryWork (PCM Int) #-} + +---------------------------------------------------------------------- +-- Int8 + +instance ZoomReadable (PCM Int8) where + data SummaryData (PCM Int8) = SummaryPCMInt8 + { summaryInt8Min :: {-# UNPACK #-}!Int8 + , summaryInt8Max :: {-# UNPACK #-}!Int8 + , summaryInt8Avg :: {-# UNPACK #-}!Double + , summaryInt8RMS :: {-# UNPACK #-}!Double + } + + trackIdentifier = const "ZPCMiS8b" + + readRaw = PCM <$> readInt8 + readSummary = readSummaryPCM + + prettyRaw = prettyPacketPCMInt + prettySummaryData = prettySummaryPCMInt + +{-# SPECIALIZE readSummaryPCM :: (Functor m, MonadIO m) => Iteratee [Word8] m (SummaryData (PCM Int8)) #-} +{-# SPECIALIZE readSummaryPCM :: (Functor m, MonadIO m) => Iteratee ByteString m (SummaryData (PCM Int8)) #-} + +instance ZoomWrite (PCM Int8) where + write = writeData + +instance ZoomWrite (TimeStamp, (PCM Int8)) where + write = writeDataVBR + +instance ZoomWritable (PCM Int8) where + data SummaryWork (PCM Int8) = SummaryWorkPCMInt8 + { swPCMInt8Time :: {-# UNPACK #-}!TimeStamp + , swPCMInt8Min :: {-# UNPACK #-}!Int8 + , swPCMInt8Max :: {-# UNPACK #-}!Int8 + , swPCMInt8Sum :: {-# UNPACK #-}!Double + , swPCMInt8SumSq :: {-# UNPACK #-}!Double + } + + fromRaw = pcmFromRaw . unPCM + fromSummaryData = fromSummaryPCM + + initSummaryWork = initSummaryPCMBounded + toSummaryData = mkSummaryPCM + updateSummaryData = updateSummaryPCM + appendSummaryData = appendSummaryPCM + +instance ZoomPCM Int8 where + pcmFromRaw = fromInt8 + + pcmMin = summaryInt8Min + pcmMax = summaryInt8Max + pcmAvg = summaryInt8Avg + pcmRMS = summaryInt8RMS + + pcmWorkTime = swPCMInt8Time + pcmWorkMin = swPCMInt8Min + pcmWorkMax = swPCMInt8Max + pcmWorkSum = swPCMInt8Sum + pcmWorkSumSq = swPCMInt8SumSq + + pcmMkSummary = SummaryPCMInt8 + pcmMkSummaryWork = SummaryWorkPCMInt8 + +{-# SPECIALIZE fromSummaryPCM :: SummaryData (PCM Int8) -> Builder #-} +{-# SPECIALIZE initSummaryPCMBounded :: TimeStamp -> SummaryWork (PCM Int8) #-} +{-# SPECIALIZE mkSummaryPCM :: TimeStampDiff -> SummaryWork (PCM Int8) -> SummaryData (PCM Int8) #-} +{-# SPECIALIZE appendSummaryPCM :: TimeStampDiff -> SummaryData (PCM Int8) -> TimeStampDiff -> SummaryData (PCM Int8) -> SummaryData (PCM Int8) #-} +{-# SPECIALIZE updateSummaryPCM :: TimeStamp -> PCM Int8 -> SummaryWork (PCM Int8) -> SummaryWork (PCM Int8) #-} + +---------------------------------------------------------------------- +-- Int16 + +instance ZoomReadable (PCM Int16) where + data SummaryData (PCM Int16) = SummaryPCMInt16 + { summaryInt16Min :: {-# UNPACK #-}!Int16 + , summaryInt16Max :: {-# UNPACK #-}!Int16 + , summaryInt16Avg :: {-# UNPACK #-}!Double + , summaryInt16RMS :: {-# UNPACK #-}!Double + } + + trackIdentifier = const "ZPCMi16b" + + readRaw = PCM <$> readInt16be + readSummary = readSummaryPCM + + prettyRaw = prettyPacketPCMInt + prettySummaryData = prettySummaryPCMInt + +{-# SPECIALIZE readSummaryPCM :: (Functor m, MonadIO m) => Iteratee [Word8] m (SummaryData (PCM Int16)) #-} +{-# SPECIALIZE readSummaryPCM :: (Functor m, MonadIO m) => Iteratee ByteString m (SummaryData (PCM Int16)) #-} + +instance ZoomWrite (PCM Int16) where + write = writeData + +instance ZoomWrite (TimeStamp, (PCM Int16)) where + write = writeDataVBR + +instance ZoomWritable (PCM Int16) where + data SummaryWork (PCM Int16) = SummaryWorkPCMInt16 + { swPCMInt16Time :: {-# UNPACK #-}!TimeStamp + , swPCMInt16Min :: {-# UNPACK #-}!Int16 + , swPCMInt16Max :: {-# UNPACK #-}!Int16 + , swPCMInt16Sum :: {-# UNPACK #-}!Double + , swPCMInt16SumSq :: {-# UNPACK #-}!Double + } + + fromRaw = pcmFromRaw . unPCM + fromSummaryData = fromSummaryPCM + + initSummaryWork = initSummaryPCMBounded + toSummaryData = mkSummaryPCM + updateSummaryData = updateSummaryPCM + appendSummaryData = appendSummaryPCM + +instance ZoomPCM Int16 where + pcmFromRaw = fromInt16be + + pcmMin = summaryInt16Min + pcmMax = summaryInt16Max + pcmAvg = summaryInt16Avg + pcmRMS = summaryInt16RMS + + pcmWorkTime = swPCMInt16Time + pcmWorkMin = swPCMInt16Min + pcmWorkMax = swPCMInt16Max + pcmWorkSum = swPCMInt16Sum + pcmWorkSumSq = swPCMInt16SumSq + + pcmMkSummary = SummaryPCMInt16 + pcmMkSummaryWork = SummaryWorkPCMInt16 + +{-# SPECIALIZE fromSummaryPCM :: SummaryData (PCM Int16) -> Builder #-} +{-# SPECIALIZE initSummaryPCMBounded :: TimeStamp -> SummaryWork (PCM Int16) #-} +{-# SPECIALIZE mkSummaryPCM :: TimeStampDiff -> SummaryWork (PCM Int16) -> SummaryData (PCM Int16) #-} +{-# SPECIALIZE appendSummaryPCM :: TimeStampDiff -> SummaryData (PCM Int16) -> TimeStampDiff -> SummaryData (PCM Int16) -> SummaryData (PCM Int16) #-} +{-# SPECIALIZE updateSummaryPCM :: TimeStamp -> PCM Int16 -> SummaryWork (PCM Int16) -> SummaryWork (PCM Int16) #-} + +---------------------------------------------------------------------- +-- Int32 + +instance ZoomReadable (PCM Int32) where + data SummaryData (PCM Int32) = SummaryPCMInt32 + { summaryInt32Min :: {-# UNPACK #-}!Int32 + , summaryInt32Max :: {-# UNPACK #-}!Int32 + , summaryInt32Avg :: {-# UNPACK #-}!Double + , summaryInt32RMS :: {-# UNPACK #-}!Double + } + + trackIdentifier = const "ZPCMi32b" + + readRaw = PCM <$> readInt32be + readSummary = readSummaryPCM + + prettyRaw = prettyPacketPCMInt + prettySummaryData = prettySummaryPCMInt + +{-# SPECIALIZE readSummaryPCM :: (Functor m, MonadIO m) => Iteratee [Word8] m (SummaryData (PCM Int32)) #-} +{-# SPECIALIZE readSummaryPCM :: (Functor m, MonadIO m) => Iteratee ByteString m (SummaryData (PCM Int32)) #-} + +instance ZoomWrite (PCM Int32) where + write = writeData + +instance ZoomWrite (TimeStamp, (PCM Int32)) where + write = writeDataVBR + +instance ZoomWritable (PCM Int32) where + data SummaryWork (PCM Int32) = SummaryWorkPCMInt32 + { swPCMInt32Time :: {-# UNPACK #-}!TimeStamp + , swPCMInt32Min :: {-# UNPACK #-}!Int32 + , swPCMInt32Max :: {-# UNPACK #-}!Int32 + , swPCMInt32Sum :: {-# UNPACK #-}!Double + , swPCMInt32SumSq :: {-# UNPACK #-}!Double + } + + fromRaw = pcmFromRaw . unPCM + fromSummaryData = fromSummaryPCM + + initSummaryWork = initSummaryPCMBounded + toSummaryData = mkSummaryPCM + updateSummaryData = updateSummaryPCM + appendSummaryData = appendSummaryPCM + +instance ZoomPCM Int32 where + pcmFromRaw = fromIntegral32be + + pcmMin = summaryInt32Min + pcmMax = summaryInt32Max + pcmAvg = summaryInt32Avg + pcmRMS = summaryInt32RMS + + pcmWorkTime = swPCMInt32Time + pcmWorkMin = swPCMInt32Min + pcmWorkMax = swPCMInt32Max + pcmWorkSum = swPCMInt32Sum + pcmWorkSumSq = swPCMInt32SumSq + + pcmMkSummary = SummaryPCMInt32 + pcmMkSummaryWork = SummaryWorkPCMInt32 + +{-# SPECIALIZE fromSummaryPCM :: SummaryData (PCM Int32) -> Builder #-} +{-# SPECIALIZE initSummaryPCMBounded :: TimeStamp -> SummaryWork (PCM Int32) #-} +{-# SPECIALIZE mkSummaryPCM :: TimeStampDiff -> SummaryWork (PCM Int32) -> SummaryData (PCM Int32) #-} +{-# SPECIALIZE appendSummaryPCM :: TimeStampDiff -> SummaryData (PCM Int32) -> TimeStampDiff -> SummaryData (PCM Int32) -> SummaryData (PCM Int32) #-} +{-# SPECIALIZE updateSummaryPCM :: TimeStamp -> PCM Int32 -> SummaryWork (PCM Int32) -> SummaryWork (PCM Int32) #-} + +---------------------------------------------------------------------- +-- Int64 + +instance ZoomReadable (PCM Int64) where + data SummaryData (PCM Int64) = SummaryPCMInt64 + { summaryInt64Min :: {-# UNPACK #-}!Int64 + , summaryInt64Max :: {-# UNPACK #-}!Int64 + , summaryInt64Avg :: {-# UNPACK #-}!Double + , summaryInt64RMS :: {-# UNPACK #-}!Double + } + + trackIdentifier = const "ZPCMi64b" + + readRaw = PCM <$> readInt64be + readSummary = readSummaryPCM + + prettyRaw = prettyPacketPCMInt + prettySummaryData = prettySummaryPCMInt + +{-# SPECIALIZE readSummaryPCM :: (Functor m, MonadIO m) => Iteratee [Word8] m (SummaryData (PCM Int64)) #-} +{-# SPECIALIZE readSummaryPCM :: (Functor m, MonadIO m) => Iteratee ByteString m (SummaryData (PCM Int64)) #-} + +instance ZoomWrite (PCM Int64) where + write = writeData + +instance ZoomWrite (TimeStamp, (PCM Int64)) where + write = writeDataVBR + +instance ZoomWritable (PCM Int64) where + data SummaryWork (PCM Int64) = SummaryWorkPCMInt64 + { swPCMInt64Time :: {-# UNPACK #-}!TimeStamp + , swPCMInt64Min :: {-# UNPACK #-}!Int64 + , swPCMInt64Max :: {-# UNPACK #-}!Int64 + , swPCMInt64Sum :: {-# UNPACK #-}!Double + , swPCMInt64SumSq :: {-# UNPACK #-}!Double + } + + fromRaw = pcmFromRaw . unPCM + fromSummaryData = fromSummaryPCM + + initSummaryWork = initSummaryPCMBounded + toSummaryData = mkSummaryPCM + updateSummaryData = updateSummaryPCM + appendSummaryData = appendSummaryPCM + +instance ZoomPCM Int64 where + pcmFromRaw = fromInt64be + + pcmMin = summaryInt64Min + pcmMax = summaryInt64Max + pcmAvg = summaryInt64Avg + pcmRMS = summaryInt64RMS + + pcmWorkTime = swPCMInt64Time + pcmWorkMin = swPCMInt64Min + pcmWorkMax = swPCMInt64Max + pcmWorkSum = swPCMInt64Sum + pcmWorkSumSq = swPCMInt64SumSq + + pcmMkSummary = SummaryPCMInt64 + pcmMkSummaryWork = SummaryWorkPCMInt64 + +{-# SPECIALIZE fromSummaryPCM :: SummaryData (PCM Int64) -> Builder #-} +{-# SPECIALIZE initSummaryPCMBounded :: TimeStamp -> SummaryWork (PCM Int64) #-} +{-# SPECIALIZE mkSummaryPCM :: TimeStampDiff -> SummaryWork (PCM Int64) -> SummaryData (PCM Int64) #-} +{-# SPECIALIZE appendSummaryPCM :: TimeStampDiff -> SummaryData (PCM Int64) -> TimeStampDiff -> SummaryData (PCM Int64) -> SummaryData (PCM Int64) #-} +{-# SPECIALIZE updateSummaryPCM :: TimeStamp -> PCM Int64 -> SummaryWork (PCM Int64) -> SummaryWork (PCM Int64) #-} + +---------------------------------------------------------------------- + +prettyPacketPCMInt :: Show a => PCM a -> String +prettyPacketPCMInt = show . unPCM + +prettySummaryPCMInt :: (PrintfArg a, ZoomPCM a) + => SummaryData (PCM a) -> String +prettySummaryPCMInt s = concat + [ printf "\tmin: %d\tmax: %d\t" (pcmMin s) (pcmMax s) + , printf "avg: %.3f\trms: %.3f" (pcmAvg s) (pcmRMS s) + ] + diff --git a/Data/ZoomCache/PCM/Internal.hs b/Data/ZoomCache/PCM/Internal.hs new file mode 100644 --- /dev/null +++ b/Data/ZoomCache/PCM/Internal.hs @@ -0,0 +1,87 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE FlexibleContexts #-} +{-# OPTIONS -Wall #-} + +module Data.ZoomCache.PCM.Internal ( + -- * Functions + readSummaryPCM + , fromSummaryPCM + , initSummaryPCMBounded + , mkSummaryPCM + , appendSummaryPCM + , updateSummaryPCM +) where + +import Blaze.ByteString.Builder +import Control.Applicative ((<$>)) +import Control.Monad (replicateM) +import Control.Monad.Trans (MonadIO) +import Data.Iteratee (Iteratee) +import qualified Data.Iteratee as I +import qualified Data.ListLike as LL +import Data.Monoid +import Data.Word + +import Data.ZoomCache.Codec +import Data.ZoomCache.PCM.Types + +---------------------------------------------------------------------- + +readSummaryPCM :: (I.Nullable s, LL.ListLike s Word8, + Functor m, MonadIO m, + ZoomPCM a) + => Iteratee s m (SummaryData (PCM a)) +readSummaryPCM = do + [mn,mx] <- replicateM 2 (unPCM <$> readRaw) + [avg,rms] <- replicateM 2 readDouble64be + return (pcmMkSummary mn mx avg rms) +{-# INLINABLE readSummaryPCM #-} + +fromSummaryPCM :: ZoomPCM a + => SummaryData (PCM a) -> Builder +fromSummaryPCM s = mconcat $ + map pcmFromRaw [pcmMin s, pcmMax s] ++ + map fromDouble [pcmAvg s, pcmRMS s] +{-# INLINABLE fromSummaryPCM #-} + +initSummaryPCMBounded :: (Bounded a, ZoomPCM a) + => TimeStamp -> SummaryWork (PCM a) +initSummaryPCMBounded entry = pcmMkSummaryWork entry maxBound minBound 0.0 0.0 +{-# INLINEABLE initSummaryPCMBounded #-} + +mkSummaryPCM :: ZoomPCM a + => TimeStampDiff -> SummaryWork (PCM a) + -> SummaryData (PCM a) +mkSummaryPCM (TSDiff dur) sw = + pcmMkSummary (pcmWorkMin sw) (pcmWorkMax sw) + (pcmWorkSum sw / fromIntegral dur) + (sqrt $ (pcmWorkSumSq sw) / fromIntegral dur) +{-# INLINEABLE mkSummaryPCM #-} + +appendSummaryPCM :: ZoomPCM a + => TimeStampDiff -> SummaryData (PCM a) + -> TimeStampDiff -> SummaryData (PCM a) + -> SummaryData (PCM a) +appendSummaryPCM (TSDiff dur1) s1 (TSDiff dur2) s2 = pcmMkSummary + (min (pcmMin s1) (pcmMin s2)) + (max (pcmMax s1) (pcmMax s2)) + (((pcmAvg s1 * fromIntegral dur1) + (pcmAvg s2 * fromIntegral dur2)) / fromIntegral durSum) + (sqrt $ ((pcmRMS s1 * pcmRMS s1 * fromIntegral dur1) + + (pcmRMS s2 * pcmRMS s2 * fromIntegral dur2)) / + fromIntegral durSum) + where + !durSum = dur1 + dur2 +{-# INLINEABLE appendSummaryPCM #-} + +updateSummaryPCM :: ZoomPCM a + => TimeStamp -> PCM a + -> SummaryWork (PCM a) + -> SummaryWork (PCM a) +updateSummaryPCM t (PCM d) sw = + pcmMkSummaryWork t (min (pcmWorkMin sw) d) + (max (pcmWorkMax sw) d) + ((pcmWorkSum sw) + realToFrac (d * dur)) + ((pcmWorkSumSq sw) + realToFrac (d*d * dur)) + where + !dur = fromIntegral $ (unTS t) - (unTS (pcmWorkTime sw)) +{-# INLINEABLE updateSummaryPCM #-} diff --git a/Data/ZoomCache/PCM/Types.hs b/Data/ZoomCache/PCM/Types.hs new file mode 100644 --- /dev/null +++ b/Data/ZoomCache/PCM/Types.hs @@ -0,0 +1,43 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE FlexibleContexts #-} +{-# OPTIONS -Wall #-} + +module Data.ZoomCache.PCM.Types ( + -- * PCM Type + PCM(..) + + -- * Classes + , ZoomPCM(..) +) where + +import Blaze.ByteString.Builder +import Data.Typeable +import Data.ZoomCache.Codec + +---------------------------------------------------------------------- +-- PCM + +data PCM a = PCM { unPCM :: !a } + deriving (Typeable) + +---------------------------------------------------------------------- +-- ZoomPCM + +class (Ord a, Real a, ZoomReadable (PCM a), ZoomWritable (PCM a)) => ZoomPCM a where + pcmFromRaw :: a -> Builder + + pcmMin :: SummaryData (PCM a) -> a + pcmMax :: SummaryData (PCM a) -> a + pcmAvg :: SummaryData (PCM a) -> Double + pcmRMS :: SummaryData (PCM a) -> Double + + pcmWorkTime :: SummaryWork (PCM a) -> TimeStamp + pcmWorkMin :: SummaryWork (PCM a) -> a + pcmWorkMax :: SummaryWork (PCM a) -> a + pcmWorkSum :: SummaryWork (PCM a) -> Double + pcmWorkSumSq :: SummaryWork (PCM a) -> Double + + pcmMkSummary :: a -> a -> Double -> Double -> SummaryData (PCM a) + pcmMkSummaryWork :: TimeStamp -> a -> a -> Double -> Double + -> SummaryWork (PCM a) + diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,26 @@ +Copyright Conrad Parker 2011 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/zoom-cache-pcm.cabal b/zoom-cache-pcm.cabal new file mode 100644 --- /dev/null +++ b/zoom-cache-pcm.cabal @@ -0,0 +1,67 @@ +Name: zoom-cache-pcm + +-- The package version. See the Haskell package versioning policy +-- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for +-- standards guiding when and how versions should be incremented. +Version: 0.1.0.0 + +Synopsis: Library for zoom-cache PCM audio codecs + +Description: + zoom-cache-pcm is a fairly simple data file format for storing and summarizing + streams of PCM audio. See the zoom-cache package for general information about + zoom-cache files. + . + This library provides codecs for use with the zoom-cache package, allowing you + to build applications which read and write zoom-cache-pcm files. Tools for + encoding and dumping zoom-cache-pcm files are in the package zoom-cache-sndfile. + . + When developing applications that read or write zoom-cache-pcm files, it should + be sufficient to import only the module "Data.ZoomCache.PCM". + +License: BSD3 +License-file: LICENSE +Author: Conrad Parker +Maintainer: Conrad Parker +Stability: Experimental +Category: Sound + +Cabal-version: >=1.2 +Build-type: Simple + +flag splitBase + description: Use the split-up base package. + +-- Extra-source-files: + +Library + if flag(splitBase) + build-depends: + base >= 3 && < 6 + else + build-depends: + base < 3 + + Build-depends: + blaze-builder, + bytestring >= 0.9 && < 0.10, + containers >= 0.2 && < 0.5, + iteratee >= 0.8.6.0 && < 0.9, + ListLike >= 1.0 && < 4, + MonadCatchIO-transformers > 0.2 && < 0.3, + mtl >= 2.0.0.0 && < 3, + zoom-cache >= 0.5.1.0 && < 0.6 + + Exposed-modules: + Data.ZoomCache.PCM + Data.ZoomCache.PCM.IEEE754 + Data.ZoomCache.PCM.Int + Data.ZoomCache.PCM.Internal + Data.ZoomCache.PCM.Types + + -- Modules not exported by this package. + -- Other-modules: + + -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source. + -- Build-tools: +