scope 0.6.0.0 → 0.6.1.0
raw patch · 5 files changed
+192/−136 lines, 5 filesdep +bytestringdep +unixdep ~zoom-cache
Dependencies added: bytestring, unix
Dependency ranges changed: zoom-cache
Files
- Scope/Layer.hs +43/−25
- Scope/Numeric/IEEE754.hs +115/−0
- Scope/Plot.hs +0/−105
- Scope/Types.hs +26/−2
- scope.cabal +8/−4
Scope/Layer.hs view
@@ -22,27 +22,28 @@ ) where import Control.Applicative ((<$>), (<*>), (<|>))-import Control.Monad (join, replicateM, (>=>))+import Control.Monad (join, replicateM, when, (>=>)) import Control.Monad.Trans (lift)+import Data.ByteString (ByteString) import Data.Function (on) import qualified Data.IntMap as IM import qualified Data.Iteratee as I+import qualified Data.Iteratee.IO.Fd as I import Data.List (groupBy) import Data.Maybe (fromJust, listToMaybe) import Data.Time.Clock import Data.ZoomCache.Multichannel import Data.ZoomCache.Numeric+import System.Posix import qualified System.Random.MWC as MWC -import Scope.Plot+import Scope.Numeric.IEEE754() import Scope.Types hiding (b) import Scope.View ---------------------------------------------------------------------- -- Random, similar colors -type RGB = (Double, Double, Double)- genColor :: RGB -> Double -> MWC.GenIO -> IO RGB genColor (r, g, b) a gen = do let a' = 1.0 - a@@ -56,13 +57,25 @@ ---------------------------------------------------------------------- -layersFromFile :: FilePath -> IO ([ScopeLayer], Maybe (TimeStamp, TimeStamp), Maybe (UTCTime, UTCTime))-layersFromFile path = do- cf <- I.fileDriverRandom (iterHeaders standardIdentifiers) path- let base = baseUTC . cfGlobal $ cf- tracks = IM.keys . cfSpecs $ cf+scopeBufSize :: Int+scopeBufSize = 1024++openScopeFile :: FilePath -> IO ScopeFile+openScopeFile path = do+ fd <- openFd path ReadOnly Nothing defaultFileFlags+ let f = ScopeFile path fd undefined+ cf <- scopeEnum f (iterHeaders standardIdentifiers)+ return f{scopeCF = cf}++scopeEnum :: ScopeRender m => ScopeFile -> I.Iteratee ByteString m a -> m a+scopeEnum ScopeFile{..} iter = I.enumFdRandom scopeBufSize fd iter >>= I.run++layersFromFile :: ScopeFile -> IO ([ScopeLayer], Maybe (TimeStamp, TimeStamp), Maybe (UTCTime, UTCTime))+layersFromFile file@ScopeFile{..} = do+ let base = baseUTC . cfGlobal $ scopeCF+ tracks = IM.keys . cfSpecs $ scopeCF colors <- genColors (length tracks) (0.9, 0.9, 0.9) (0.5)- foldl1 merge <$> mapM (\t -> I.fileDriverRandom (iterListLayers base t) path)+ foldl1 merge <$> mapM (\t -> scopeEnum file (I.joinI $ enumBlock scopeCF $ iterListLayers base t)) (zip tracks colors) where merge :: ([ScopeLayer], Maybe (TimeStamp, TimeStamp), Maybe (UTCTime, UTCTime))@@ -72,7 +85,7 @@ (ls1 ++ ls2, unionBounds bs1 bs2, unionBounds ubs1 ubs2) iterListLayers base (trackNo, color) = listLayers base trackNo color <$>- wholeTrackSummaryListDouble standardIdentifiers trackNo+ wholeTrackSummaryListDouble trackNo listLayers :: Maybe UTCTime -> TrackNo -> RGB -> [Summary Double] -> ([ScopeLayer], Maybe (TimeStamp, TimeStamp), Maybe (UTCTime, UTCTime))@@ -91,20 +104,21 @@ rawListLayer :: Maybe UTCTime -> TrackNo -> [Summary Double] -> Layer (TimeStamp, [Double])- rawListLayer base trackNo ss = Layer path trackNo+ rawListLayer base trackNo ss = Layer file trackNo base (summaryEntry s) (summaryExit s)- enumListDouble (LayerFold (plotRawList (maxRange ss)) plotRawListInit Nothing)+ enumListDouble+ (rawLayerPlot (maxRange ss) (0,0,0)) where s = head ss sListLayer :: Maybe UTCTime -> TrackNo -> RGB -> [Summary Double] -> Layer [Summary Double]- sListLayer base trackNo (r, g, b) ss = Layer path trackNo+ sListLayer base trackNo rgb ss = Layer file trackNo base (summaryEntry s) (summaryExit s) (enumSummaryListDouble 1)- (LayerFold (plotSummaryList (maxRange ss)) (plotSummaryListInit r g b) Nothing)+ (summaryLayerPlot (maxRange ss) rgb) where s = head ss @@ -116,7 +130,7 @@ addLayersFromFile :: FilePath -> Scope ui -> IO (Scope ui) addLayersFromFile path scope = do- (newLayers, newBounds, newUTCBounds) <- layersFromFile path+ (newLayers, newBounds, newUTCBounds) <- layersFromFile =<< openScopeFile path let scope' = scopeUpdate newBounds newUTCBounds scope return $ scope' { layers = layers scope ++ newLayers } @@ -126,21 +140,25 @@ plotLayers scope = mapM_ f layersByFile where f :: ScopeRender m => [ScopeLayer] -> m ()- f ls = plotFileLayers (fn . head $ ls) ls scope- layersByFile = groupBy ((==) `on` fn) (layers scope)- fn (ScopeLayer l) = filename l+ f ls = plotFileLayers (lf . head $ ls) ls scope+ layersByFile = groupBy ((==) `on` (fd . lf)) (layers scope)+ lf (ScopeLayer l) = layerFile l -plotFileLayers :: ScopeRender m => FilePath -> [ScopeLayer] -> Scope ui -> m ()-plotFileLayers path layers scope =- flip I.fileDriverRandom path $ do- I.joinI $ enumCacheFile identifiers $ do+plotFileLayers :: ScopeRender m => ScopeFile -> [ScopeLayer] -> Scope ui -> m ()+plotFileLayers file layers scope = when (any visible layers) $+ scopeEnum file $ do+ I.seek 0+ I.joinI $ enumBlock (scopeCF file) $ do seekTimeStamp seekStart I.joinI . (I.takeWhileE (before seekEnd) >=> I.take 1) $ I.sequence_ is where v = view scope- identifiers = standardIdentifiers is = map (plotLayer scope) layers + visible (ScopeLayer Layer{..}) =+ maybe False (< endTime) seekStart &&+ maybe False (> startTime) seekEnd+ seekStart = ts (viewStartUTC scope v) <|> viewStartTime scope v seekEnd = ts (viewEndUTC scope v) <|> viewEndTime scope v @@ -149,7 +167,7 @@ base = join . listToMaybe $ lBase <$> take 1 layers lBase (ScopeLayer l) = layerBaseUTC l -plotLayer :: ScopeRender m => Scope ui -> ScopeLayer -> I.Iteratee [Stream] m ()+plotLayer :: ScopeRender m => Scope ui -> ScopeLayer -> I.Iteratee [Block] m () plotLayer scope (ScopeLayer Layer{..}) = I.joinI . filterTracks [layerTrackNo] . I.joinI . convEnee $ render plotter where
+ Scope/Numeric/IEEE754.hs view
@@ -0,0 +1,115 @@+{-# OPTIONS -Wall -fno-warn-orphans #-}+----------------------------------------------------------------------+{- |+ Module : Scope.Numeric.IEEE754+ Copyright : Conrad Parker+ License : BSD3-style (see LICENSE)++ Maintainer : Conrad Parker <conrad@metadecks.org>+ Stability : unstable+ Portability : unknown++ Scope plotting functions+-}++module Scope.Numeric.IEEE754 (+) where++import Control.Arrow (second)+import Data.Maybe (fromJust)+import Data.ZoomCache+import Data.ZoomCache.Numeric++import Scope.Types hiding (b)++----------------------------------------------------------------------++instance ScopePlot Double where+ rawLayerPlot = rawLayerPlotListDouble+ summaryLayerPlot = summaryLayerPlotListDouble++----------------------------------------------------------------------+-- Raw data++rawLayerPlotListDouble :: Double -> RGB -> LayerPlot (TimeStamp, [Double])+rawLayerPlotListDouble maxRange _rgb =+ LayerFold (plotRawListDouble maxRange) plotRawListInitDouble Nothing++plotRawListInitDouble :: [DrawLayer]+plotRawListInitDouble = repeat []++plotRawListDouble :: Double -> LayerFoldFunc (TimeStamp, [Double]) (Maybe [Double])+plotRawListDouble yRange x w Nothing (ts, ys) = plotRawListDouble yRange x w (Just ys) (ts, ys)+plotRawListDouble yRange x w (Just ys0) (ts, ys) =+ second Just $ foldl c ([], []) $ map f (zip3 (map yFunc [0..]) ys0 ys)+ where+ c :: ([a], [b]) -> ([a], b) -> ([a], [b])+ c (ds0, ss) (ds, s) = (ds0++ds, ss++[s])++ l = length ys+ yStep = 2.0 / fromIntegral l+ yFunc n v = (-1.0) + (n * yStep) + ((0.5) * yStep) + (v * yStep / yRange)+ f :: ((Double -> Double), Double, Double) -> ([DrawLayer], Double)+ f (y, s0, s) = second fromJust $ plotRaw1Double y x w (Just s0) (ts, s)++plotRaw1Double :: (Double -> Double) -> LayerFoldFunc (TimeStamp, Double) (Maybe Double)+plotRaw1Double f x w Nothing (ts, y) = plotRaw1Double f x w (Just y) (ts, y)+plotRaw1Double f x w (Just y0) (_ts, y) = (cmds, Just y')+ where+ cmds =+ [ [ MoveTo (x, y0)+ , LineTo (x+w, y')+ ]+ ]+ y' = f y++----------------------------------------------------------------------+-- Summary data++summaryLayerPlotListDouble :: Double -> RGB -> LayerPlot [Summary Double]+summaryLayerPlotListDouble maxRange rgb =+ LayerFold (plotSummaryListDouble maxRange) (plotSummaryListInitDouble rgb) Nothing++plotSummaryListInitDouble :: RGB -> [DrawLayer]+plotSummaryListInitDouble (r, g, b) = concat $ repeat+ [ [ SetRGBA r g b 0.3 ]+ , [ SetRGB (r*0.6) (g*0.6) (b*0.6) ]+ ]++plotSummaryListDouble :: Double+ -> LayerFoldFunc [Summary Double] (Maybe [Summary Double])+plotSummaryListDouble dYRange x w Nothing ss =+ plotSummaryListDouble dYRange x w (Just ss) ss+plotSummaryListDouble dYRange x w (Just ss0) ss = do+ second Just $ foldl c ([], []) $ map f (zip3 (map yFunc [0..]) ss0 ss)+ where+ c :: ([a], [b]) -> ([a], b) -> ([a], [b])+ c (ds0, sss) (ds, s) = (ds0++ds, sss++[s])++ l = length ss+ yStep = 2.0 / fromIntegral l+ yFunc n v = (-1.0) + (n * yStep) + ((0.5) * yStep) + (v * yStep / dYRange)+ f :: ((Double -> Double), Summary Double, Summary Double) -> ([DrawLayer], Summary Double)+ f (y, s0, s) = second fromJust $ plotSummary1Double y x w (Just s0) s++-- | Plot one numeric summary+plotSummary1Double :: (Double -> Double)+ -> LayerFoldFunc (Summary Double) (Maybe (Summary Double))+plotSummary1Double y x w Nothing s =+ plotSummary1Double y x w (Just s) s+plotSummary1Double y x w (Just s0) s = (cmds, Just s)+ where+ cmds =+ [ [ FillPoly [ (x, y (numMax sd0))+ , ((x+w), y (numMax sd))+ , ((x+w), y (numMin sd))+ , (x, y (numMin sd0))+ ]+ ]+ , [ MoveTo (x, y (numAvg sd0))+ , LineTo ((x+w), y (numAvg sd))+ ]+ ]+ sd0 = summaryData s0+ sd = summaryData s+
− Scope/Plot.hs
@@ -1,105 +0,0 @@-{-# OPTIONS -Wall #-}------------------------------------------------------------------------{- |- Module : Scope.Plot- Copyright : Conrad Parker- License : BSD3-style (see LICENSE)-- Maintainer : Conrad Parker <conrad@metadecks.org>- Stability : unstable- Portability : unknown-- Scope plotting functions--}--module Scope.Plot (- plotRawListInit- , plotRawList- , plotSummaryListInit- , plotSummaryList-) where--import Control.Arrow (second)-import Data.Maybe (fromJust)-import Data.ZoomCache-import Data.ZoomCache.Numeric--import Scope.Types hiding (b)--------------------------------------------------------------------------- Raw data--plotRawListInit :: [DrawLayer]-plotRawListInit = repeat []--plotRawList :: Double -> LayerFoldFunc (TimeStamp, [Double]) (Maybe [Double])-plotRawList yRange x w Nothing (ts, ys) = plotRawList yRange x w (Just ys) (ts, ys)-plotRawList yRange x w (Just ys0) (ts, ys) =- second Just $ foldl c ([], []) $ map f (zip3 (map yFunc [0..]) ys0 ys)- where- c :: ([a], [b]) -> ([a], b) -> ([a], [b])- c (ds0, ss) (ds, s) = (ds0++ds, ss++[s])-- l = length ys- yStep = 2.0 / fromIntegral l- yFunc n v = (-1.0) + (n * yStep) + ((0.5) * yStep) + (v * yStep / yRange)- f :: ((Double -> Double), Double, Double) -> ([DrawLayer], Double)- f (y, s0, s) = second fromJust $ plotRaw1 y x w (Just s0) (ts, s)--plotRaw1 :: (Double -> Double) -> LayerFoldFunc (TimeStamp, Double) (Maybe Double)-plotRaw1 f x w Nothing (ts, y) = plotRaw1 f x w (Just y) (ts, y)-plotRaw1 f x w (Just y0) (_ts, y) = (cmds, Just y')- where- cmds =- [ [ MoveTo (x, y0)- , LineTo (x+w, y')- ]- ]- y' = f y--------------------------------------------------------------------------- Summary data--plotSummaryListInit :: Double -> Double -> Double -> [DrawLayer]-plotSummaryListInit r g b = concat $ repeat- [ [ SetRGBA r g b 0.3 ]- , [ SetRGB (r*0.6) (g*0.6) (b*0.6) ]- ]--plotSummaryList :: Double- -> LayerFoldFunc [Summary Double] (Maybe [Summary Double])-plotSummaryList dYRange x w Nothing ss =- plotSummaryList dYRange x w (Just ss) ss-plotSummaryList dYRange x w (Just ss0) ss = do- second Just $ foldl c ([], []) $ map f (zip3 (map yFunc [0..]) ss0 ss)- where- c :: ([a], [b]) -> ([a], b) -> ([a], [b])- c (ds0, sss) (ds, s) = (ds0++ds, sss++[s])-- l = length ss- yStep = 2.0 / fromIntegral l- yFunc n v = (-1.0) + (n * yStep) + ((0.5) * yStep) + (v * yStep / dYRange)- f :: ((Double -> Double), Summary Double, Summary Double) -> ([DrawLayer], Summary Double)- f (y, s0, s) = second fromJust $ plotSummary1 y x w (Just s0) s---- | Plot one numeric summary-plotSummary1 :: (Double -> Double)- -> LayerFoldFunc (Summary Double) (Maybe (Summary Double))-plotSummary1 y x w Nothing s =- plotSummary1 y x w (Just s) s-plotSummary1 y x w (Just s0) s = (cmds, Just s)- where- cmds =- [ [ FillPoly [ (x, y (numMax sd0))- , ((x+w), y (numMax sd))- , ((x+w), y (numMin sd))- , (x, y (numMin sd0))- ]- ]- , [ MoveTo (x, y (numAvg sd0))- , LineTo ((x+w), y (numAvg sd))- ]- ]- sd0 = summaryData s0- sd = summaryData s-
Scope/Types.hs view
@@ -57,11 +57,15 @@ , zoomRange -- * Drawing commands+ , RGB , DrawCmd(..) , DrawLayer , ScopeRender(..) + , ScopePlot(..)+ -- * Scope+ , ScopeFile(..) , Scope(..) , scopeNew , scopeUpdate@@ -84,6 +88,7 @@ import Data.Maybe import Data.Iteratee (Enumeratee) import Data.ZoomCache+import System.Posix ---------------------------------------------------------------------- @@ -212,6 +217,8 @@ ---------------------------------------------------------------------- +type RGB = (Double, Double, Double)+ data DrawCmd = SetRGB Double Double Double | SetRGBA Double Double Double Double@@ -224,8 +231,19 @@ class (Functor m, MonadCatchIO m) => ScopeRender m where renderCmds :: [DrawCmd] -> m () +instance ScopeRender IO where+ renderCmds = const (return ())+ ---------------------------------------------------------------------- +data ScopeFile = ScopeFile+ { filename :: FilePath+ , fd :: Fd+ , scopeCF :: CacheFile+ }++----------------------------------------------------------------------+ type DrawLayer = [DrawCmd] -- | A layer plotting function which is just given the x position and x width@@ -240,16 +258,22 @@ | forall b . LayerFold (LayerFoldFunc a b) [DrawLayer] b data Layer a = Layer- { filename :: FilePath+ { layerFile :: ScopeFile , layerTrackNo :: TrackNo , layerBaseUTC :: Maybe UTCTime , startTime :: TimeStamp , endTime :: TimeStamp- , convEnee :: forall m . (Functor m, Monad m) => Enumeratee [Stream] [a] m ()+ , convEnee :: forall m . (Functor m, Monad m) => Enumeratee [Block] [a] m () , plotter :: LayerPlot a } data ScopeLayer = forall a . Timestampable a => ScopeLayer (Layer a)++----------------------------------------------------------------------++class ScopePlot a where+ rawLayerPlot :: a -> RGB -> LayerPlot (TimeStamp, [a])+ summaryLayerPlot :: a -> RGB -> LayerPlot [Summary a] ----------------------------------------------------------------------
scope.cabal view
@@ -1,6 +1,6 @@ Name: scope -Version: 0.6.0.0+Version: 0.6.1.0 Synopsis: An interactive renderer for plotting time-series data @@ -65,6 +65,7 @@ Build-Depends: cairo, gtk,+ bytestring >= 0.9 && < 0.10, containers >= 0.2 && < 0.5, iteratee >= 0.8.6.0 && < 0.9, MonadCatchIO-transformers > 0.2 && < 0.3,@@ -72,12 +73,13 @@ mwc-random, old-locale, time,- zoom-cache >= 1.0.0.0 && < 1.1.0.0+ unix,+ zoom-cache >= 1.1.0.0 && < 1.2.0.0 Exposed-modules: Scope.Cairo Scope.Layer- Scope.Plot+ Scope.Numeric.IEEE754 Scope.Types Scope.View @@ -97,6 +99,7 @@ cairo, glib, gtk,+ bytestring >= 0.9 && < 0.10, containers >= 0.2 && < 0.5, iteratee >= 0.8.6.0 && < 0.9, ListLike >= 1.0 && < 4,@@ -105,7 +108,8 @@ mwc-random, old-locale, time,- zoom-cache >= 1.0.0.0 && < 1.1.0.0+ unix,+ zoom-cache >= 1.1.0.0 && < 1.2.0.0 ------------------------------------------------------------------------ -- Git repo