diff --git a/Data/Iteratee/ZoomCache.hs b/Data/Iteratee/ZoomCache.hs --- a/Data/Iteratee/ZoomCache.hs +++ b/Data/Iteratee/ZoomCache.hs @@ -185,9 +185,9 @@ Just TrackSpec{..} -> do d <- case specType of ZDouble -> do - PDDouble <$> replicateM count zReadFloat64be + PDDouble <$> replicateM count zRead ZInt -> do - PDInt <$> replicateM count zReadInt32 + PDInt <$> replicateM count zRead ts <- map TS <$> case specDRType of ConstantDR -> do return $ take count [unTS entryTime ..] @@ -311,3 +311,17 @@ if (den == 0) then return 0 else return $ (fromIntegral num) % (fromIntegral den) + +---------------------------------------------------------------------- + +class ZReadable a where + zRead :: (Functor m, MonadIO m) => Iteratee [Word8] m a + zStreamType :: (a, TrackType) + +instance ZReadable Double where + zRead = zReadFloat64be + zStreamType = (undefined, ZDouble) + +instance ZReadable Int where + zRead = zReadInt32 + zStreamType = (undefined, ZInt) diff --git a/Data/ZoomCache/Pretty.hs b/Data/ZoomCache/Pretty.hs --- a/Data/ZoomCache/Pretty.hs +++ b/Data/ZoomCache/Pretty.hs @@ -54,7 +54,9 @@ prettyTimeStamp :: Rational -> TimeStamp -> String prettyTimeStamp r (TS t) | d == 0 = "00:00:00.000" - -- | d < 100 = printf "%02d:%02d:%02d::%02d" hrs minN secN framesN + {- + | d < 100 = printf "%02d:%02d:%02d::%02d" hrs minN secN framesN + -} | otherwise = printf "%02d:%02d:%02d.%03d" hrs minN secN msN where d = denominator r diff --git a/Data/ZoomCache/Read.hs b/Data/ZoomCache/Read.hs --- a/Data/ZoomCache/Read.hs +++ b/Data/ZoomCache/Read.hs @@ -39,14 +39,14 @@ zoomInfoFile :: FilePath -> IO () zoomInfoFile path = I.fileDriverRandom iterHeaders path >>= info -zoomDumpFile :: FilePath -> IO () -zoomDumpFile = I.fileDriverRandom (mapStream dumpData) +zoomDumpFile :: TrackNo -> FilePath -> IO () +zoomDumpFile trackNo = I.fileDriverRandom (mapStream (dumpData trackNo)) -zoomDumpSummary :: FilePath -> IO () -zoomDumpSummary = I.fileDriverRandom (mapStream dumpSummary) +zoomDumpSummary :: TrackNo -> FilePath -> IO () +zoomDumpSummary trackNo = I.fileDriverRandom (mapStream (dumpSummary trackNo)) -zoomDumpSummaryLevel :: Int -> FilePath -> IO () -zoomDumpSummaryLevel lvl = I.fileDriverRandom (mapStream (dumpSummaryLevel lvl)) +zoomDumpSummaryLevel :: TrackNo -> Int -> FilePath -> IO () +zoomDumpSummaryLevel trackNo lvl = I.fileDriverRandom (mapStream (dumpSummaryLevel trackNo lvl)) ---------------------------------------------------------------------- @@ -59,27 +59,31 @@ streamRate StreamNull = Nothing streamRate s = specRate <$> IM.lookup (strmTrack s) (cfSpecs (strmFile s)) -dumpData :: Stream -> IO () -dumpData s@StreamPacket{..} = mapM_ (\(t,d) -> printf "%s: %s\n" t d) tds +dumpData :: TrackNo -> Stream -> IO () +dumpData trackNo s@StreamPacket{..} + | strmTrack == trackNo = mapM_ (\(t,d) -> printf "%s: %s\n" t d) tds + | otherwise = return () where pretty = case streamRate s of Just r -> prettyTimeStamp r Nothing -> show . unTS tds = zip (map pretty (packetTimeStamps strmPacket)) vals vals = case packetData strmPacket of - PDDouble ds -> map show ds + PDDouble ds -> map (printf "%.3f") ds PDInt is -> map show is -dumpData _ = return () +dumpData _ _ = return () -dumpSummary :: Stream -> IO () -dumpSummary s@StreamSummary{..} = case streamRate s of - Just r -> putStrLn $ prettySummary r strmSummary - Nothing -> return () -dumpSummary _ = return () +dumpSummary :: TrackNo -> Stream -> IO () +dumpSummary trackNo s@StreamSummary{..} + | strmTrack == trackNo = case streamRate s of + Just r -> putStrLn $ prettySummary r strmSummary + Nothing -> return () + | otherwise = return () +dumpSummary _ _ = return () -dumpSummaryLevel :: Int -> Stream -> IO () -dumpSummaryLevel level s@StreamSummary{..} - | level == summaryLevel strmSummary = dumpSummary s - | otherwise = return () -dumpSummaryLevel _ _ = return () +dumpSummaryLevel :: TrackNo -> Int -> Stream -> IO () +dumpSummaryLevel trackNo level s@StreamSummary{..} + | level == summaryLevel strmSummary && strmTrack == trackNo = dumpSummary trackNo s + | otherwise = return () +dumpSummaryLevel _ _ _ = return () diff --git a/Data/ZoomCache/Write.hs b/Data/ZoomCache/Write.hs --- a/Data/ZoomCache/Write.hs +++ b/Data/ZoomCache/Write.hs @@ -380,7 +380,7 @@ , ztsdEntry = 0.0 , ztsdExit = 0.0 , ztsdMin = floatMax - , ztsdMax = floatMin + , ztsdMax = negate floatMax , ztsdSum = 0.0 , ztsSumSq = 0.0 } diff --git a/tools/zoom-cache.hs b/tools/zoom-cache.hs --- a/tools/zoom-cache.hs +++ b/tools/zoom-cache.hs @@ -28,6 +28,7 @@ , label :: L.ByteString , rate :: Integer , wmLevel :: Int + , track :: TrackNo } instance Default Config where @@ -41,6 +42,7 @@ , label = "gen" , rate = 1000 , wmLevel = 1024 + , track = 1 } data Option = NoRaw @@ -49,6 +51,7 @@ | Label String | Rate String | Watermark String + | Track String deriving (Eq) options :: [OptDescr Option] @@ -68,6 +71,8 @@ "Set track rate" , Option ['w'] ["watermark"] (ReqArg Rate "watermark") "Set high-watermark level" + , Option ['t'] ["track"] (ReqArg Track "trackNo") + "Set or select track number" ] processArgs :: [String] -> IO (Config, [String]) @@ -93,6 +98,8 @@ 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} ------------------------------------------------------------ @@ -121,10 +128,10 @@ w ztype d | variable = withFileWrite (oneTrack ztype VariableDR rate' label) (not noRaw) - (sW >> mapM_ (write 1) (zip (map TS [1,3..]) d)) + (sW >> mapM_ (write track) (zip (map TS [1,3..]) d)) | otherwise = withFileWrite (oneTrack ztype ConstantDR rate' label) (not noRaw) - (sW >> mapM_ (write 1) d) + (sW >> mapM_ (write track) d) rate' = fromInteger rate sW = setWatermark 1 wmLevel @@ -162,7 +169,9 @@ } zoomDumpHandler :: App () () -zoomDumpHandler = mapM_ (liftIO . zoomDumpFile) =<< appArgs +zoomDumpHandler = do + (config, filenames) <- liftIO . processArgs =<< appArgs + mapM_ (liftIO . zoomDumpFile (track config)) filenames ------------------------------------------------------------ @@ -176,10 +185,12 @@ } zoomSummaryHandler :: App () () -zoomSummaryHandler = liftIO . f =<< appArgs +zoomSummaryHandler = do + (config, filenames) <- liftIO . processArgs =<< appArgs + liftIO . (f (track config)) $ filenames where - f (lvl:paths) = mapM_ (zoomDumpSummaryLevel (read lvl)) paths - f _ = putStrLn "Usage: zoom-cache summary n file.zxd" + f trackNo (lvl:paths) = mapM_ (zoomDumpSummaryLevel trackNo (read lvl)) paths + f _ _ = putStrLn "Usage: zoom-cache summary n file.zxd" ------------------------------------------------------------ -- The Application diff --git a/zoom-cache.cabal b/zoom-cache.cabal --- a/zoom-cache.cabal +++ b/zoom-cache.cabal @@ -7,7 +7,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.2.1.0 +Version: 0.2.1.1 -- A short (one-line) description of the package. Synopsis: A streamable, seekable, zoomable cache file format