scope 0.5.0.0 → 0.5.1.0
raw patch · 11 files changed
+276/−82 lines, 11 filesdep +ListLikedep ~zoom-cachebinary-added
Dependencies added: ListLike
Dependency ranges changed: zoom-cache
Files
- Scope/Types.hs +68/−14
- Scope/View.hs +52/−6
- demo/demo-2ch.zoom binary
- demo/demo-offset1.zoom binary
- demo/demo-short1.zoom binary
- demo/demo1.zoom binary
- demo/demo2.zoom binary
- demo/demo3.zoom binary
- demo/demo4.zoom binary
- scope.cabal +7/−3
- src/GUI.hs +149/−59
Scope/Types.hs view
@@ -45,14 +45,20 @@ , DataX(..) , DataY(..) - , restrictPair- , restrictPair01- , translatePair- , zoomPair+ , Transform(..)+ , mkTransform+ , mkTSDataTransform + , translateRange+ , unionRange+ , restrictRange+ , restrictRange01+ , zoomRange+ -- * Scope , Scope(..) , scopeNew+ , scopeTransform -- * Views , View(..)@@ -65,6 +71,7 @@ , ScopeLayer(..) ) where +import Control.Applicative ((<$>)) import Data.Maybe import Data.Iteratee (Enumeratee) import Data.ZoomCache@@ -74,6 +81,8 @@ ---------------------------------------------------------------------- +data Transform a = Transform { m :: Double, b :: a }+ class Coordinate a where fromDouble :: Double -> a toDouble :: a -> Double@@ -83,6 +92,8 @@ -- | Translate x by translate :: a -> a -> a + transform :: Transform a -> a -> a+ newtype ScreenX = ScreenX Double deriving (Eq, Ord, Show) newtype ScreenY = ScreenY Double deriving (Eq, Ord, Show) newtype CanvasX = CanvasX Double deriving (Eq, Ord, Show)@@ -95,31 +106,45 @@ toDouble = id distance x1 x2 = x2 - x1 translate t x = x + t+ transform Transform{..} x = m * x + b instance Coordinate ScreenX where fromDouble d = ScreenX d toDouble (ScreenX d) = d distance (ScreenX x1) (ScreenX x2) = ScreenX (distance x1 x2) translate (ScreenX t) (ScreenX x) = ScreenX (translate t x)+ transform (Transform m (ScreenX b)) (ScreenX x) = ScreenX (transform (Transform m b) x) instance Coordinate CanvasX where fromDouble d = CanvasX d toDouble (CanvasX d) = d distance (CanvasX x1) (CanvasX x2) = CanvasX (distance x1 x2) translate (CanvasX t) (CanvasX x) = CanvasX (translate t x)+ transform (Transform m (CanvasX b)) (CanvasX x) = CanvasX (transform (Transform m b) x) instance Coordinate DataX where fromDouble d = DataX d toDouble (DataX d) = d distance (DataX x1) (DataX x2) = DataX (distance x1 x2) translate (DataX t) (DataX x) = DataX (translate t x)+ transform (Transform m (DataX b)) (DataX x) = DataX (transform (Transform m b) x) -translatePair :: Coordinate a => a -> (a, a) -> (a, a)-translatePair t (x1, x2) = (translate t x1, translate t x2)+instance Coordinate TimeStamp where+ fromDouble d = TS d+ toDouble (TS d) = d+ distance (TS x1) (TS x2) = TS (distance x1 x2)+ translate (TS t) (TS x) = TS (translate t x)+ transform (Transform m (TS b)) (TS x) = TS (transform (Transform m b) x) +translateRange :: Coordinate a => a -> (a, a) -> (a, a)+translateRange t (x1, x2) = (translate t x1, translate t x2)++unionRange :: Ord a => (a, a) -> (a, a) -> (a, a)+unionRange (a1, a2) (b1, b2) = (min a1 b1, max a2 b2)+ -- | Restrict a window to within a given range-restrictPair :: (Ord a, Coordinate a) => (a, a) -> (a, a) -> (a, a)-restrictPair (rangeX1, rangeX2) (x1, x2)+restrictRange :: (Ord a, Coordinate a) => (a, a) -> (a, a) -> (a, a)+restrictRange (rangeX1, rangeX2) (x1, x2) | w >= rW = (rangeX1, rangeX2) | x1 < rangeX1 = (rangeX1, translate rangeX1 w) | x2 > rangeX2 = (x1', rangeX2)@@ -129,17 +154,33 @@ w = distance x1 x2 x1' = distance w rangeX2 -restrictPair01 :: (Ord a, Coordinate a) => (a, a) -> (a, a)-restrictPair01 = restrictPair (fromDouble 0.0, fromDouble 1.0)+restrictRange01 :: (Ord a, Coordinate a) => (a, a) -> (a, a)+restrictRange01 = restrictRange (fromDouble 0.0, fromDouble 1.0) -zoomPair :: Coordinate a => CanvasX -> Double -> (a, a) -> (a, a)-zoomPair (CanvasX focus) mult (x1, x2) = (translate off1 x1, translate off2 x2)+zoomRange :: Coordinate a => CanvasX -> Double -> (a, a) -> (a, a)+zoomRange (CanvasX focus) mult (x1, x2) = (translate off1 x1, translate off2 x2) where off1 = fromDouble $ (oldW - newW) * focus off2 = fromDouble $ (newW - oldW) * (1.0 - focus) oldW = toDouble $ distance x1 x2 newW = min 1.0 (oldW * mult) +mkTransform :: Coordinate a => (a, a) -> (a, a) -> Transform a+mkTransform (old1, old2) (new1, new2) = Transform m b+ where+ oldW = distance old1 old2+ newW = distance new1 new2+ m = toDouble oldW / toDouble newW+ b = distance new1 old1++mkTSDataTransform :: (TimeStamp, TimeStamp) -> (TimeStamp, TimeStamp) -> Transform DataX+mkTSDataTransform (old1, old2) (new1, new2) = Transform m b+ where+ oldW = distance old1 old2+ newW = distance new1 new2+ m = toDouble oldW / toDouble newW+ b = fromDouble $ toDouble (distance new1 old1) / toDouble newW+ ---------------------------------------------------------------------- -- | A layer plotting function which is just given the x position and x width@@ -156,17 +197,19 @@ data Layer a = Layer { filename :: FilePath , trackNo :: TrackNo- , dataLength :: Int+ , startTime :: TimeStamp+ , endTime :: TimeStamp , convEnee :: Enumeratee [Stream] [a] C.Render () , plotter :: LayerPlot a } -data ScopeLayer = forall a . ScopeLayer (Layer a)+data ScopeLayer = forall a . Timestampable a => ScopeLayer (Layer a) ---------------------------------------------------------------------- data Scope = Scope { view :: View+ , bounds :: Maybe (TimeStamp, TimeStamp) , layers :: [ScopeLayer] } @@ -183,10 +226,21 @@ scopeNew :: G.DrawingArea -> G.Adjustment -> Scope scopeNew c adj = Scope { view = viewInit c adj+ , bounds = Nothing , layers = [] } +scopeTransform :: Transform DataX -> Scope -> Scope+scopeTransform tf scope@Scope{..} = scope { view = viewTransform tf view }+ viewInit :: G.DrawingArea -> G.Adjustment -> View viewInit c adj = View c adj (DataX 0.0) (-1.0) (DataX 1.0) 1.0 Nothing++viewTransform :: Transform DataX -> View -> View+viewTransform tf v@View{..} = v {+ viewX1 = transform tf viewX1+ , viewX2 = transform tf viewX2+ , dragDX = transform tf <$> dragDX+ } ----------------------------------------------------------------------
Scope/View.hs view
@@ -14,8 +14,17 @@ ---------------------------------------------------------------------- module Scope.View (+ -- * Coordinate conversions+ timeStampToData+ , dataToTimeStamp+ , timeStampToCanvas++ , viewStartTime+ , viewEndTime+ , viewDuration+ -- * Motion, zooming- viewAlign+ , viewAlign , viewMoveTo , viewZoomOutOn @@ -26,6 +35,7 @@ ) where import Data.Maybe (fromJust)+import Data.ZoomCache import Scope.Types @@ -35,6 +45,42 @@ canvasToData View{..} (CanvasX cX) = translate viewX1 $ DataX (cX * toDouble (distance viewX1 viewX2)) +timeStampToData :: Scope -> TimeStamp -> Maybe DataX+timeStampToData Scope{..} (TS ts) = fmap tsToData bounds+ where+ tsToData :: (TimeStamp, TimeStamp) -> DataX+ tsToData (TS t1, TS t2) = DataX $ ts - t1 / (t2 - t1)++dataToTimeStamp :: Scope -> DataX -> Maybe TimeStamp+dataToTimeStamp Scope{..} (DataX dX) = fmap dataToTS bounds+ where+ dataToTS :: (TimeStamp, TimeStamp) -> TimeStamp+ dataToTS (TS t1, TS t2) = TS $ t1 + dX * (t2 - t1)++timeStampToCanvas :: Scope -> TimeStamp -> CanvasX+timeStampToCanvas scope ts = CanvasX $+ toDouble (distance vt1 ts) / toDouble (distance vt1 vt2)+ where+ v = view scope+ vt1 = fromJust $ dataToTimeStamp scope (viewX1 v)+ vt2 = fromJust $ dataToTimeStamp scope (viewX2 v)++----------------------------------------------------------------------++viewStartTime :: Scope -> View -> Maybe TimeStamp+viewStartTime scope View{..} = dataToTimeStamp scope viewX1++viewEndTime :: Scope -> View -> Maybe TimeStamp+viewEndTime scope View{..} = dataToTimeStamp scope viewX2++viewDuration :: Scope -> View -> Maybe TimeStampDiff+viewDuration scope view =+ case (viewStartTime scope view, viewEndTime scope view) of+ (Just s, Just e) -> Just $ timeStampDiff e s+ _ -> Nothing++----------------------------------------------------------------------+ viewSetEnds :: DataX -> DataX -> View -> View viewSetEnds x1 x2 v@View{..} = v { viewX1 = x1, viewX2 = x2 } @@ -46,20 +92,20 @@ DataX vW = distance viewX1 viewX2 -- current width of view window newX1 = max 0 $ dx - (cx * vW) newX2 = newX1 + vW- (newX1', newX2') = restrictPair01 (newX1, newX2)+ (newX1', newX2') = restrictRange01 (newX1, newX2) viewMoveTo :: Double -> View -> View viewMoveTo val v@View{..} = viewSetEnds newX1' newX2' v where- (newX1', newX2') = restrictPair01 .- translatePair (distance viewX1 (DataX val)) $+ (newX1', newX2') = restrictRange01 .+ translateRange (distance viewX1 (DataX val)) $ (viewX1, viewX2) viewZoomOutOn :: CanvasX -> Double -> View -> View viewZoomOutOn focus mult v@View{..} = viewSetEnds newX1 newX2' v where- (newX1, newX2') = restrictPair01 $- zoomPair focus mult (viewX1, viewX2)+ (newX1, newX2') = restrictRange01 $+ zoomRange focus mult (viewX1, viewX2) viewButtonDown :: CanvasX -> View -> View viewButtonDown cX v = v { dragDX = Just (canvasToData v cX) }
+ demo/demo-2ch.zoom view
binary file changed (absent → 175298 bytes)
+ demo/demo-offset1.zoom view
binary file changed (absent → 111586 bytes)
+ demo/demo-short1.zoom view
binary file changed (absent → 33886 bytes)
demo/demo1.zoom view
binary file changed (111582 → 111586 bytes)
demo/demo2.zoom view
binary file changed (111582 → 111586 bytes)
demo/demo3.zoom view
binary file changed (111582 → 111586 bytes)
demo/demo4.zoom view
binary file changed (111582 → 111586 bytes)
scope.cabal view
@@ -1,6 +1,6 @@ Name: scope -Version: 0.5.0.0+Version: 0.5.1.0 Synopsis: An interactive renderer for plotting time-series data @@ -50,6 +50,9 @@ demo/demo2.zoom demo/demo3.zoom demo/demo4.zoom+ demo/demo-2ch.zoom+ demo/demo-offset1.zoom+ demo/demo-short1.zoom flag splitBase description: Use the split-up base package.@@ -68,7 +71,7 @@ iteratee >= 0.8.6.0 && < 0.9, MonadCatchIO-transformers > 0.2 && < 0.3, mtl >= 2.0.0.0 && < 3,- zoom-cache >= 0.8.1.0 && < 0.9+ zoom-cache >= 0.9.0.0 && < 0.10 Exposed-modules: Scope.View@@ -92,10 +95,11 @@ glib, gtk, iteratee >= 0.8.6.0 && < 0.9,+ ListLike >= 1.0 && < 4, MonadCatchIO-transformers > 0.2 && < 0.3, mtl >= 2.0.0.0 && < 3, mwc-random,- zoom-cache >= 0.8.1.0 && < 0.9+ zoom-cache >= 0.9.0.0 && < 0.10 ------------------------------------------------------------------------ -- Git repo
src/GUI.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE FlexibleInstances #-} -- TimeStampable {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} {-# OPTIONS -Wall -fno-warn-unused-do-bind -fno-warn-orphans #-}@@ -26,6 +27,7 @@ import Data.List (groupBy) import Data.Maybe import qualified Data.Iteratee as I+import Data.ZoomCache.Multichannel import Data.ZoomCache.Numeric import qualified Graphics.UI.Gtk as G import qualified Graphics.Rendering.Cairo as C@@ -34,8 +36,6 @@ import qualified Graphics.Rendering.Cairo.Matrix as M import qualified System.Random.MWC as MWC --- import Text.Printf- import Paths_scope as My import Scope.View import Scope.Types@@ -196,7 +196,7 @@ case response of G.ResponseAccept -> do Just filename <- G.fileChooserGetFilename fcdialog- scopeModifyMRedraw scopeRef (addLayersFromFile filename)+ scopeModifyMUpdate scopeRef (addLayersFromFile filename) _ -> return () G.widgetHide fcdialog @@ -256,10 +256,13 @@ scopeZoomOutOn ref focus mult = scopeModifyUpdate ref (scopeModifyView (viewZoomOutOn focus mult)) -scopeModifyMRedraw :: IORef Scope -> (Scope -> IO Scope) -> IO ()-scopeModifyMRedraw ref f = do+scopeModifyMUpdate :: IORef Scope -> (Scope -> IO Scope) -> IO ()+scopeModifyMUpdate ref f = do modifyIORefM ref f- G.widgetQueueDraw =<< canvas . view <$> readIORef ref+ View{..} <- view <$> readIORef ref+ G.adjustmentSetValue adj (toDouble viewX1)+ G.adjustmentSetPageSize adj $ toDouble (distance viewX1 viewX2)+ G.widgetQueueDraw canvas scopeModifyUpdate :: IORef Scope -> (Scope -> Scope) -> IO () scopeModifyUpdate ref f = do@@ -422,6 +425,17 @@ ---------------------------------------------------------------- +class TimeStampable a where+ timeStamp :: a -> TimeStamp++instance TimeStampable (TimeStamp, a) where+ timeStamp (ts, _) = ts++instance TimeStampable (Summary a) where+ timeStamp = summaryEntry++----------------------------------------------------------------+ plotLayers :: Scope -> C.Render () plotLayers scope = mapM_ f layersByFile where@@ -432,7 +446,10 @@ plotFileLayers :: FilePath -> [ScopeLayer] -> Scope -> C.Render () plotFileLayers path layers scope =- I.fileDriverRandom (I.joinI $ enumCacheFile identifiers (I.sequence_ is)) path+ flip I.fileDriverRandom path $ do+ I.joinI $ enumCacheFile identifiers $ do+ seekTimeStamp (viewStartTime scope (view scope))+ I.sequence_ is where identifiers = standardIdentifiers is = map (plotLayer scope) layers@@ -441,63 +458,87 @@ plotLayer scope (ScopeLayer Layer{..}) = I.joinI . filterTracks [trackNo] . I.joinI . convEnee $ foldData where- View{..} = view scope+ v@View{..} = view scope foldData = do- I.drop skipLength- I.joinI . I.take visibleLength $ render plotter+ I.joinI . I.takeWhileE (before (viewEndTime scope v)) $ render plotter render (LayerMap f) = do- I.foldM renderMap canvasX0- return ()+ d0'm <- I.tryHead+ case d0'm of+ Just d0 -> I.foldM renderMap (toX d0) >> return ()+ Nothing -> return () where- renderMap x d = do- f x stepWidth d- return (x + stepWidth)+ renderMap x0 d = do+ let x = toX d+ f x0 (x-x0) d+ return x render (LayerFold f b00) = do- I.foldM renderFold (canvasX0, b00)- return ()+ d0'm <- I.tryHead+ case d0'm of+ Just d0 -> I.foldM renderFold (toX d0, b00) >> return ()+ Nothing -> return () where- renderFold (x, b0) d = do- b <- f x stepWidth b0 d- return (x + stepWidth, b)-- -- | Canvas X coordinate of first data point- canvasX0 = (fromIntegral skipLength - skip) * stepWidth-- -- | Count of data points to drop before rendering- skipLength = floor skip-- -- | DataX coordinate of start of view- skip = fromIntegral dataLength * toDouble viewX1-- -- | Count of data points visible in view- visibleLength = ceiling viz + 2-- -- | Canvas x length per data point- stepWidth = 1.0 / viz+ renderFold (x0, b0) d = do+ let x = toX d+ b <- f x0 (x-x0) b0 d+ return (x, b) - -- | Fractional number of data points visible in view- viz = fromIntegral dataLength * toDouble (distance viewX1 viewX2)+ toX :: Timestampable a => a -> Double+ toX = toDouble . timeStampToCanvas scope . fromJust . timestamp ---------------------------------------------------------------------- -- Raw data -plotRaw :: Double -> LayerFoldFunc (TimeStamp, Double) (Maybe Double)-plotRaw yR x w Nothing (ts, y) = plotRaw yR x w (Just y) (ts, y)-plotRaw yR x w (Just y0) (_ts, y) = do+_plotRaw :: Double -> LayerFoldFunc (TimeStamp, Double) (Maybe Double)+_plotRaw yR = plotRaw1 (\y -> y * 2.0 / yR)++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) =+ Just <$> mapM f (zip3 (map yFunc [0..]) ys0 ys)+ where+ 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) -> C.Render Double+ f (y, s0, s) = 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) = do+ let y' = f y C.moveTo x y0- C.lineTo (x+w) (y * 2.0 {- (viewY2 v - viewY1 v)-} / yR)- return (Just y)+ C.lineTo (x+w) y'+ C.stroke+ return (Just y') ---------------------------------------------------------------------- -- Summary data -plotSummary :: Double -> Double -> Double -> Double+_plotSummary :: Double -> Double -> Double -> Double+ -> LayerFoldFunc (Summary Double) (Maybe (Summary Double))+_plotSummary dYRange = plotSummary1 (\v -> v * 4.0 / dYRange)++plotSummaryList :: Double -> Double -> Double -> Double+ -> LayerFoldFunc [Summary Double] (Maybe [Summary Double])+plotSummaryList dYRange r g b x w Nothing ss =+ plotSummaryList dYRange r g b x w (Just ss) ss+plotSummaryList dYRange r g b x w (Just ss0) ss = do+ Just <$> mapM f (zip3 (map yFunc [0..]) ss0 ss)+ where+ 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) -> C.Render (Summary Double)+ f (y, s0, s) = fromJust <$> plotSummary1 y r g b x w (Just s0) s++-- | Plot one numeric summary+plotSummary1 :: (Double -> Double) -> Double -> Double -> Double -> LayerFoldFunc (Summary Double) (Maybe (Summary Double))-plotSummary dYRange r g b x w Nothing s =- plotSummary dYRange r g b x w (Just s) s-plotSummary dYRange r g b x w (Just s0) s = do+plotSummary1 y r g b x w Nothing s =+ plotSummary1 y r g b x w (Just s) s+plotSummary1 y r g b x w (Just s0) s = do C.setSourceRGBA r g b 0.3 C.moveTo x (y (numMax sd0)) C.lineTo (x+w) (y (numMax sd))@@ -513,7 +554,6 @@ where sd0 = summaryData s0 sd = summaryData s- y v = v * 4.0 / dYRange ---------------------------------------------------------------------- @@ -538,34 +578,84 @@ ---------------------------------------------------------------------- -layersFromFile :: FilePath -> IO [ScopeLayer]+layersFromFile :: FilePath -> IO ([ScopeLayer], Maybe (TimeStamp, TimeStamp)) layersFromFile path = do tracks <- IM.keys . cfSpecs <$> I.fileDriverRandom (iterHeaders standardIdentifiers) path colors <- genColors (length tracks) (0.9, 0.9, 0.9) (0.5)- concat <$> mapM (\t -> I.fileDriverRandom (iterLayers t) path) (zip tracks colors)+ -- foldl1 merge <$> mapM (\t -> I.fileDriverRandom (iterLayers t) path) (zip tracks colors)+ foldl1 merge <$> mapM (\t -> I.fileDriverRandom (iterListLayers t) path) (zip tracks colors) where+ merge :: ([ScopeLayer], Maybe (TimeStamp, TimeStamp))+ -> ([ScopeLayer], Maybe (TimeStamp, TimeStamp))+ -> ([ScopeLayer], Maybe (TimeStamp, TimeStamp))+ merge (ls1, bs1) (ls2, bs2) = (ls1 ++ ls2, unionBounds bs1 bs2)++{- iterLayers (trackNo, color) = layers trackNo color <$>- wholeTrackSummaryDouble standardIdentifiers trackNo+ wholeTrackSummaryListDouble standardIdentifiers trackNo - layers :: TrackNo -> RGB -> Summary Double -> [ScopeLayer]- layers trackNo rgb s = [ ScopeLayer (rawLayer trackNo s)- , ScopeLayer (sLayer trackNo rgb s)- ]+ layers :: TrackNo -> RGB -> Summary Double -> ([ScopeLayer], Maybe (TimeStamp, TimeStamp))+ layers trackNo rgb s = ([ ScopeLayer (rawLayer trackNo s)+ , ScopeLayer (sLayer trackNo rgb s)+ ]+ , Just (summaryEntry s, summaryExit s)) rawLayer :: TrackNo -> Summary Double -> Layer (TimeStamp, Double)- rawLayer trackNo s = Layer path trackNo 5000 enumDouble (LayerFold (plotRaw (yRange s)) Nothing)+ rawLayer trackNo s = Layer path trackNo (summaryEntry s) (summaryExit s)+ enumDouble (LayerFold (plotRaw (yRange s)) Nothing) sLayer :: TrackNo -> RGB -> Summary Double -> Layer (Summary Double)- sLayer trackNo (r, g, b) s = Layer path trackNo 600 (enumSummaryDouble 1)- (LayerFold (plotSummary (yRange s) r g b) Nothing)+ sLayer trackNo (r, g, b) s = Layer path trackNo (summaryEntry s) (summaryExit s)+ (enumSummaryDouble 1) (LayerFold (plotSummary (yRange s) r g b) Nothing)+-} + iterListLayers (trackNo, color) = listLayers trackNo color <$>+ wholeTrackSummaryListDouble standardIdentifiers trackNo++ listLayers :: TrackNo -> RGB -> [Summary Double] -> ([ScopeLayer], Maybe (TimeStamp, TimeStamp))+ listLayers trackNo rgb ss = ([ ScopeLayer (rawListLayer trackNo ss)+ , ScopeLayer (sListLayer trackNo rgb ss)+ ]+ , Just (summaryEntry s, summaryExit s))+ where+ s = head ss++ rawListLayer :: TrackNo -> [Summary Double] -> Layer (TimeStamp, [Double])+ rawListLayer trackNo ss = Layer path trackNo (summaryEntry s) (summaryExit s)+ enumListDouble (LayerFold (plotRawList (maxRange ss)) Nothing)+ where+ s = head ss++ sListLayer :: TrackNo -> RGB -> [Summary Double] -> Layer [Summary Double]+ sListLayer trackNo (r, g, b) ss = Layer path trackNo (summaryEntry s) (summaryExit s)+ (enumSummaryListDouble 1) (LayerFold (plotSummaryList (maxRange ss) r g b) Nothing)+ where+ s = head ss++ maxRange :: [Summary Double] -> Double+ maxRange = maximum . map yRange+ yRange :: Summary Double -> Double yRange s = 2 * ((abs . numMin . summaryData $ s) + (abs . numMax . summaryData $ s)) +unionBounds :: Ord a => Maybe (a, a) -> Maybe (a, a) -> Maybe (a, a)+unionBounds a Nothing = a+unionBounds Nothing b = b+unionBounds (Just r1) (Just r2) = Just (unionRange r1 r2)+ addLayersFromFile :: FilePath -> Scope -> IO Scope addLayersFromFile path scope = do- newLayers <- layersFromFile path- return $ scope { layers = layers scope ++ newLayers }+ (newLayers, newBounds) <- layersFromFile path+ let oldBounds = bounds scope+ mb = unionBounds oldBounds newBounds+ t = case oldBounds of+ Just ob -> if oldBounds == mb+ then id+ else scopeTransform (mkTSDataTransform ob (fromJust mb))+ _ -> id+ return $ (t scope) { layers = layers scope ++ newLayers+ , bounds = mb+ } modifyIORefM :: IORef a -> (a -> IO a) -> IO () modifyIORefM ref f = do