diff --git a/Scope/Layer.hs b/Scope/Layer.hs --- a/Scope/Layer.hs +++ b/Scope/Layer.hs @@ -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 diff --git a/Scope/Numeric/IEEE754.hs b/Scope/Numeric/IEEE754.hs new file mode 100644 --- /dev/null +++ b/Scope/Numeric/IEEE754.hs @@ -0,0 +1,115 @@ +{-# OPTIONS -Wall -fno-warn-orphans #-} +---------------------------------------------------------------------- +{- | + Module : Scope.Numeric.IEEE754 + Copyright : Conrad Parker + License : BSD3-style (see LICENSE) + + Maintainer : Conrad Parker + 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 + diff --git a/Scope/Plot.hs b/Scope/Plot.hs deleted file mode 100644 --- a/Scope/Plot.hs +++ /dev/null @@ -1,105 +0,0 @@ -{-# OPTIONS -Wall #-} ----------------------------------------------------------------------- -{- | - Module : Scope.Plot - Copyright : Conrad Parker - License : BSD3-style (see LICENSE) - - Maintainer : Conrad Parker - 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 - diff --git a/Scope/Types.hs b/Scope/Types.hs --- a/Scope/Types.hs +++ b/Scope/Types.hs @@ -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] ---------------------------------------------------------------------- diff --git a/scope.cabal b/scope.cabal --- a/scope.cabal +++ b/scope.cabal @@ -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