diff --git a/tools/zoom-cache-sndfile.hs b/tools/zoom-cache-sndfile.hs --- a/tools/zoom-cache-sndfile.hs +++ b/tools/zoom-cache-sndfile.hs @@ -12,13 +12,13 @@ import Control.Monad (foldM) import Control.Monad.State (execStateT) import Control.Monad.Trans (liftIO, MonadIO) -import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as C import Data.Default +import qualified Data.IntMap as IM import qualified Data.Vector.Storable as SV import Data.ZoomCache import Data.ZoomCache.Dump -import Data.ZoomCache.Multichannel +import Data.ZoomCache.Multichannel() import Data.ZoomCache.PCM import qualified Sound.File.Sndfile as SF import qualified Sound.File.Sndfile.Buffer.Vector as SFV @@ -31,14 +31,11 @@ data Config = Config { noRaw :: Bool - , delta :: Bool - , zlib :: Bool - , variable :: Bool - , intData :: Bool - , label :: ByteString - , rate :: Integer , wmLevel :: Int , track :: TrackNo + , intData :: Bool + , variable :: Bool + , spec :: TrackSpec } instance Default Config where @@ -47,25 +44,25 @@ defConfig :: Config defConfig = Config { noRaw = False - , delta = False - , zlib = False - , variable = False - , intData = False - , label = "gen" - , rate = 1000 , wmLevel = 1024 , track = 1 + , intData = False + , variable = False + , spec = def { specDeltaEncode = False + , specZlibCompress = False + , specName = "gen" + } } data Option = NoRaw + | Watermark String + | Track String | Delta | ZLib | Variable | IntData - | Label String | Rate String - | Watermark String - | Track String + | Label String deriving (Eq) options :: [OptDescr Option] @@ -75,6 +72,10 @@ genOptions = [ Option ['z'] ["no-raw"] (NoArg NoRaw) "Do NOT include raw data in the output" + , Option ['w'] ["watermark"] (ReqArg Watermark "watermark") + "Set high-watermark level" + , Option ['t'] ["track"] (ReqArg Track "trackNo") + "Set or select track number" , Option ['d'] ["delta"] (NoArg Delta) "Delta-encode data" , Option ['Z'] ["zlib"] (NoArg ZLib) @@ -83,14 +84,10 @@ "Generate variable-rate data" , Option ['i'] ["integer"] (NoArg IntData) "Generate ingeger data" - , Option ['l'] ["label"] (ReqArg Label "label") - "Set track label" , Option ['r'] ["rate"] (ReqArg Rate "data-rate") "Set track rate" - , Option ['w'] ["watermark"] (ReqArg Watermark "watermark") - "Set high-watermark level" - , Option ['t'] ["track"] (ReqArg Track "trackNo") - "Set or select track number" + , Option ['l'] ["label"] (ReqArg Label "label") + "Set track label" ] processArgs :: [String] -> IO (Config, [String]) @@ -106,22 +103,27 @@ where processOneOption config NoRaw = do return $ config {noRaw = True} + processOneOption config (Watermark s) = do + return $ config {wmLevel = read s} + processOneOption config (Track s) = do + return $ config {track = read s} + processOneOption config Delta = do - return $ config {delta = True} + return $ config { spec = (spec config){specDeltaEncode = True} } processOneOption config ZLib = do - return $ config {zlib = True} + return $ config { spec = (spec config){specZlibCompress = True} } processOneOption config Variable = do - return $ config {variable = True} + return $ config { variable = True + , spec = (spec config){specSRType = VariableSR} + } processOneOption config IntData = do - return $ config {intData = True} - processOneOption config (Label s) = do - return $ config {label = C.pack s} + return $ config { intData = True + , spec = setCodec (undefined :: Int) (spec config) + } processOneOption config (Rate s) = do - return $ config {rate = read s} - processOneOption config (Watermark s) = do - return $ config {wmLevel = read s} - processOneOption config (Track s) = do - return $ config {track = read s} + return $ config { spec = (spec config){specRate = fromInteger $ read s} } + processOneOption config (Label s) = do + return $ config { spec = (spec config){specName = C.pack s} } ------------------------------------------------------------ @@ -148,13 +150,12 @@ w :: (ZoomReadable a, ZoomWrite a, ZoomWrite (SampleOffset, a)) => [a] -> FilePath -> IO () w d - | variable = withFileWrite (oneTrack (head d) delta zlib VariableSR rate' label) - (not noRaw) + | variable = withFileWrite (IM.singleton track $ setCodec (head d) spec) + Nothing (not noRaw) (sW >> mapM_ (write track) (zip (map SO [1,3..]) d)) - | otherwise = withFileWrite (oneTrack (head d) delta zlib ConstantSR rate' label) - (not noRaw) + | otherwise = withFileWrite (IM.singleton track $ setCodec (head d) spec) + Nothing (not noRaw) (sW >> mapM_ (write track) d) - rate' = fromInteger rate sW = setWatermark 1 wmLevel ------------------------------------------------------------ @@ -233,21 +234,20 @@ } encodeHandler :: App () () -encodeHandler = mapM_ (liftIO . encodeFile) =<< appArgs +encodeHandler = do + (config, filenames) <- liftIO . processArgs =<< appArgs + liftIO $ mapM_ (encodeFile config) filenames -encodeFile :: FilePath -> IO () -encodeFile path = do +encodeFile :: Config -> FilePath -> IO () +encodeFile Config{..} path = do h <- SF.openFile path SF.ReadMode info let sfInfo = SF.hInfo h sfRate = fromIntegral . SF.samplerate $ sfInfo sfChannels = fromIntegral . SF.channels $ sfInfo + spec' = spec { specRate = sfRate } - z <- openWrite (oneTrackMultichannel - sfChannels - (undefined :: PCM Double) - False -- delta - False -- zlib - ConstantSR sfRate "pcm") + z <- openWrite (IM.singleton track $ setCodecMultichannel sfChannels (undefined :: PCM Double) spec') + Nothing -- baseUTC True -- doRaw (path ++ ".zoom") z' <- foldFrames (encodeBuffer sfChannels) z h 1024 diff --git a/zoom-cache-sndfile.cabal b/zoom-cache-sndfile.cabal --- a/zoom-cache-sndfile.cabal +++ b/zoom-cache-sndfile.cabal @@ -3,7 +3,7 @@ -- 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.3.0.0 +Version: 1.0.0.0 Synopsis: Tools for generating zoom-cache-pcm files @@ -40,13 +40,14 @@ Build-depends: bytestring >= 0.9 && < 0.10, + containers >= 0.2 && < 0.5, data-default, hsndfile >= 0.5.2 && < 0.6, hsndfile-vector >= 0.5.2 && < 0.6, mtl >= 2.0.0.0 && < 3, ui-command, vector, - zoom-cache >= 0.9.0.0 && < 0.10, + zoom-cache >= 1.0.0.0 && < 1.1.0.0, zoom-cache-pcm >= 0.2.0.0 && < 0.3 -- Other-modules: