diff --git a/Scope/Layer.hs b/Scope/Layer.hs --- a/Scope/Layer.hs +++ b/Scope/Layer.hs @@ -22,15 +22,16 @@ ) where import Control.Applicative ((<$>), (<*>), (<|>)) -import Control.Monad (join, replicateM, when, (>=>)) +import Control.Monad (foldM, join, replicateM, (>=>)) 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 qualified Data.Iteratee.IO.OffsetFd as OffI import Data.List (groupBy) import Data.Maybe (fromJust, listToMaybe) +import Data.Offset import Data.Time.Clock import Data.ZoomCache.Multichannel import Data.ZoomCache.Numeric @@ -67,8 +68,8 @@ 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 +scopeEnum :: ScopeRender m => ScopeFile -> I.Iteratee (Offset ByteString) m a -> m a +scopeEnum ScopeFile{..} iter = OffI.enumFdRandomOBS scopeBufSize fd iter >>= I.run layersFromFile :: ScopeFile -> IO ([ScopeLayer], Maybe (TimeStamp, TimeStamp), Maybe (UTCTime, UTCTime)) layersFromFile file@ScopeFile{..} = do @@ -136,21 +137,38 @@ ---------------------------------------------------------------- -plotLayers :: ScopeRender m => Scope ui -> m () -plotLayers scope = mapM_ f layersByFile +plotLayers :: ScopeRender m => Scope ui -> m (Scope ui) +plotLayers scope0 = foldM f scope0 layersByFile where - f :: ScopeRender m => [ScopeLayer] -> m () - f ls = plotFileLayers (lf . head $ ls) ls scope - layersByFile = groupBy ((==) `on` (fd . lf)) (layers scope) + f :: ScopeRender m => Scope ui -> [ScopeLayer] -> m (Scope ui) + f scope ls = do + file' <- plotFileLayers (lf . head $ ls) ls scope + return (updateFiles file' scope) + + updateFiles :: ScopeFile -> Scope ui -> Scope ui + updateFiles file scope = scope { layers = map u (layers scope) } + where + u (ScopeLayer l) + | (fd . layerFile $ l) == (fd file) + = ScopeLayer l{layerFile = file} + | otherwise + = ScopeLayer l + + layersByFile :: [[ScopeLayer]] + layersByFile = groupBy ((==) `on` (fd . lf)) (layers scope0) lf (ScopeLayer l) = layerFile l -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 +plotFileLayers :: ScopeRender m => ScopeFile -> [ScopeLayer] -> Scope ui -> m ScopeFile +plotFileLayers file layers scope = + if (any visible layers) + then scopeEnum file $ do + I.seek 0 + I.joinI $ enumBlock (scopeCF file) $ do + seekTimeStamp (scopeCF file) seekStart + I.joinI . (I.takeWhileE (before seekEnd) >=> I.take 1) $ I.sequence_ is + cf <- maybe (scopeCF file) (blkFile . unwrapOffset) <$> I.peek + return file{scopeCF = cf} + else return file where v = view scope is = map (plotLayer scope) layers @@ -167,7 +185,7 @@ base = join . listToMaybe $ lBase <$> take 1 layers lBase (ScopeLayer l) = layerBaseUTC l -plotLayer :: ScopeRender m => Scope ui -> ScopeLayer -> I.Iteratee [Block] m () +plotLayer :: ScopeRender m => Scope ui -> ScopeLayer -> I.Iteratee [Offset Block] m () plotLayer scope (ScopeLayer Layer{..}) = I.joinI . filterTracks [layerTrackNo] . I.joinI . convEnee $ render plotter where diff --git a/Scope/Types.hs b/Scope/Types.hs --- a/Scope/Types.hs +++ b/Scope/Types.hs @@ -68,6 +68,7 @@ , ScopeFile(..) , Scope(..) , scopeNew + , scopeClose , scopeUpdate , scopeModifyView @@ -84,9 +85,11 @@ import Control.Applicative ((<$>)) import Control.Monad.CatchIO -import Data.Time.Clock -import Data.Maybe import Data.Iteratee (Enumeratee) +import Data.List (nub) +import Data.Offset +import Data.Maybe +import Data.Time.Clock import Data.ZoomCache import System.Posix @@ -263,7 +266,7 @@ , layerBaseUTC :: Maybe UTCTime , startTime :: TimeStamp , endTime :: TimeStamp - , convEnee :: forall m . (Functor m, Monad m) => Enumeratee [Block] [a] m () + , convEnee :: forall m . (Functor m, Monad m) => Enumeratee [Offset Block] [a] m () , plotter :: LayerPlot a } @@ -301,6 +304,13 @@ , utcBounds = Nothing , layers = [] } + +scopeClose :: Scope ui -> IO (Scope ui) +scopeClose scope = do + mapM_ closeFd . nub . map fd' . layers $ scope + return scope{bounds=Nothing, utcBounds=Nothing, layers=[]} + where + fd' (ScopeLayer l) = fd . layerFile $ l scopeModifyView :: (View ui -> View ui) -> Scope ui -> Scope ui scopeModifyView f scope = scope{ view = f (view scope) } diff --git a/scope.cabal b/scope.cabal --- a/scope.cabal +++ b/scope.cabal @@ -1,6 +1,6 @@ Name: scope -Version: 0.6.1.0 +Version: 0.7.0.0 Synopsis: An interactive renderer for plotting time-series data @@ -74,7 +74,7 @@ old-locale, time, unix, - zoom-cache >= 1.1.0.0 && < 1.2.0.0 + zoom-cache >= 1.2.0.0 && < 1.3.0.0 Exposed-modules: Scope.Cairo @@ -109,7 +109,7 @@ old-locale, time, unix, - zoom-cache >= 1.1.0.0 && < 1.2.0.0 + zoom-cache >= 1.2.0.0 && < 1.3.0.0 ------------------------------------------------------------------------ -- Git repo diff --git a/src/GUI.hs b/src/GUI.hs --- a/src/GUI.hs +++ b/src/GUI.hs @@ -64,7 +64,6 @@ savea <- G.actionNew "SAVEA" "Save" (Just "Just a Stub") (Just G.stockSave) saveasa <- G.actionNew "SAVEASA" "Save As" (Just "Just a Stub") (Just G.stockSaveAs) quita <- G.actionNew "QUITA" "Quit" (Just "Just a Stub") (Just G.stockQuit) - quita `G.on` G.actionActivated $ myQuit window chan let fChooser action label = G.fileChooserDialogNew Nothing (Just window) action [(G.stockCancel, G.ResponseCancel), (label, G.ResponseAccept)] @@ -116,6 +115,8 @@ let scope = scopeCairoNew drawingArea adj scopeRef <- newIORef scope + quita `G.on` G.actionActivated $ myQuit scopeRef window chan + mapM_ (modifyIORefM scopeRef . addLayersFromFile) args openDialog `G.on` G.response $ myFileOpen scopeRef openDialog saveDialog `G.on` G.response $ myFileSave scopeRef saveDialog @@ -154,8 +155,9 @@ G.widgetShowAll window G.mainGUI -myQuit :: G.WidgetClass cls => cls -> Chan String -> IO () -myQuit window chan = do +myQuit :: G.WidgetClass cls => IORef (Scope ViewCairo) -> cls -> Chan String -> IO () +myQuit scopeRef window chan = do + scopeModifyMUpdate scopeRef scopeClose G.widgetDestroy window myWriteChan chan "quit" @@ -201,7 +203,7 @@ let c = canvas . viewUI . view $ scope win <- G.widgetGetDrawWindow c (width, height) <- G.widgetGetSize c - G.renderWithDrawable win $ plotWindow width height scope + G.renderWithDrawable win $ plotWindow width height ref return True writePng :: FilePath -> IORef (Scope ViewCairo) -> IO () @@ -210,7 +212,7 @@ let c = canvas . viewUI . view $ scope (width, height) <- G.widgetGetSize c C.withImageSurface C.FormatARGB32 width height $ \ result -> do - C.renderWith result $ plotWindow width height scope + C.renderWith result $ plotWindow width height ref C.surfaceWriteToPNG result path ---------------------------------------------------------------- @@ -317,10 +319,11 @@ ---------------------------------------------------------------- -plotWindow :: Int -> Int -> Scope ViewCairo -> C.Render () -plotWindow width height scope = do +plotWindow :: Int -> Int -> IORef (Scope ViewCairo) -> C.Render () +plotWindow width height ref = do + scope <- liftIO $ readIORef ref prologue width height - plotLayers scope + modifyIORefM ref plotLayers plotTimeline scope plotCursor scope @@ -459,9 +462,9 @@ ---------------------------------------------------------------------- -modifyIORefM :: IORef a -> (a -> IO a) -> IO () +modifyIORefM :: MonadIO m => IORef a -> (a -> m a) -> m () modifyIORefM ref f = do - x <- readIORef ref + x <- liftIO $ readIORef ref x' <- f x - writeIORef ref x' + liftIO $ writeIORef ref x'