diff --git a/Scope/Types.hs b/Scope/Types.hs --- a/Scope/Types.hs +++ b/Scope/Types.hs @@ -220,6 +220,7 @@ , viewY1 :: Double , viewX2 :: DataX , viewY2 :: Double + , pointerX :: Maybe CanvasX , dragDX :: Maybe DataX -- DataX of pointer at drag down } @@ -234,7 +235,7 @@ 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 +viewInit c adj = View c adj (DataX 0.0) (-1.0) (DataX 1.0) 1.0 Nothing Nothing viewTransform :: Transform DataX -> View -> View viewTransform tf v@View{..} = v { diff --git a/Scope/View.hs b/Scope/View.hs --- a/Scope/View.hs +++ b/Scope/View.hs @@ -111,7 +111,11 @@ viewButtonDown cX v = v { dragDX = Just (canvasToData v cX) } viewButtonMotion :: CanvasX -> View -> View -viewButtonMotion cX v@View{..} = viewAlign cX (fromJust dragDX) v +viewButtonMotion cX v@View{..} = case dragDX of + Just dX -> viewAlign cX dX v' + Nothing -> v' + where + v' = v { pointerX = Just cX } viewButtonRelease :: View -> View viewButtonRelease v = v { dragDX = Nothing} diff --git a/demo/demo-2ch.zoom b/demo/demo-2ch.zoom deleted file mode 100644 Binary files a/demo/demo-2ch.zoom and /dev/null differ diff --git a/demo/demo-offset1.zoom b/demo/demo-offset1.zoom deleted file mode 100644 Binary files a/demo/demo-offset1.zoom and /dev/null differ diff --git a/demo/demo-short1.zoom b/demo/demo-short1.zoom deleted file mode 100644 Binary files a/demo/demo-short1.zoom and /dev/null differ diff --git a/demo/demo1.zoom b/demo/demo1.zoom Binary files a/demo/demo1.zoom and b/demo/demo1.zoom differ diff --git a/demo/demo2.zoom b/demo/demo2.zoom Binary files a/demo/demo2.zoom and b/demo/demo2.zoom differ diff --git a/demo/demo3.zoom b/demo/demo3.zoom Binary files a/demo/demo3.zoom and b/demo/demo3.zoom differ diff --git a/demo/demo4.zoom b/demo/demo4.zoom Binary files a/demo/demo4.zoom and b/demo/demo4.zoom differ diff --git a/scope.cabal b/scope.cabal --- a/scope.cabal +++ b/scope.cabal @@ -1,6 +1,6 @@ Name: scope -Version: 0.5.1.0 +Version: 0.5.2.0 Synopsis: An interactive renderer for plotting time-series data @@ -16,7 +16,7 @@ To run it, simply: . @ - $ cabal install scope + $ cabal install gtk2hs-buildtools scope $ scope @ . @@ -50,9 +50,6 @@ 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. @@ -71,7 +68,7 @@ iteratee >= 0.8.6.0 && < 0.9, MonadCatchIO-transformers > 0.2 && < 0.3, mtl >= 2.0.0.0 && < 3, - zoom-cache >= 0.9.0.0 && < 0.10 + zoom-cache >= 0.9.1.0 && < 0.10 Exposed-modules: Scope.View @@ -99,7 +96,7 @@ MonadCatchIO-transformers > 0.2 && < 0.3, mtl >= 2.0.0.0 && < 3, mwc-random, - zoom-cache >= 0.9.0.0 && < 0.10 + zoom-cache >= 0.9.1.0 && < 0.10 ------------------------------------------------------------------------ -- Git repo diff --git a/src/GUI.hs b/src/GUI.hs --- a/src/GUI.hs +++ b/src/GUI.hs @@ -4,12 +4,6 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} {-# OPTIONS -Wall -fno-warn-unused-do-bind -fno-warn-orphans #-} --- --- Based on Gtk2Hs/demo/cairo/Drawing2.hs --- Author: Johan Bockgård --- --- This code is in the public domain. --- module GUI ( guiMain @@ -46,17 +40,6 @@ windowWidth = 500 windowHeight = 500 -{- --- Write image to file -_writePng :: IO () -_writePng = - C.withImageSurface C.FormatARGB32 width height $ \ result -> do - C.renderWith result $ plotWindow width height - C.surfaceWriteToPNG result "Draw.png" - where width = windowWidth - height = windowHeight --} - -- Display image in window guiMain :: Chan String -> [String] -> IO () guiMain chan args = do @@ -104,7 +87,6 @@ saveDialog <- fChooser G.FileChooserActionSave G.stockSave savea `G.on` G.actionActivated $ G.widgetShow saveDialog saveasa `G.on` G.actionActivated $ G.widgetShow saveDialog - saveDialog `G.on` G.response $ myFileSave saveDialog -- Edit menu cut1 <- G.actionNew "cut1" "Cut" (Just "Just a Stub") (Just G.stockCut) @@ -145,6 +127,7 @@ mapM_ (modifyIORefM scopeRef . addLayersFromFile) args openDialog `G.on` G.response $ myFileOpen scopeRef openDialog + saveDialog `G.on` G.response $ myFileSave scopeRef saveDialog adj `G.onValueChanged` (scroll scopeRef) @@ -158,7 +141,7 @@ G.widgetAddEvents drawingArea [ G.KeyPressMask , G.KeyReleaseMask - -- , G.PointerMotionMask + , G.PointerMotionMask , G.ButtonMotionMask , G.ScrollMask ] @@ -200,8 +183,14 @@ _ -> return () G.widgetHide fcdialog -myFileSave :: G.FileChooserDialog -> G.ResponseId -> IO () -myFileSave _ _ = return () +myFileSave :: IORef Scope -> G.FileChooserDialog -> G.ResponseId -> IO () +myFileSave scopeRef fcdialog response = do + case response of + G.ResponseAccept -> do + Just filename <- G.fileChooserGetFilename fcdialog + writePng filename scopeRef + _ -> return () + G.widgetHide fcdialog myCut :: IO () myCut = putStrLn "Cut" @@ -224,6 +213,15 @@ G.renderWithDrawable win $ plotWindow width height scope return True +writePng :: FilePath -> IORef Scope -> IO () +writePng path ref = do + scope <- readIORef ref + let c = canvas . view $ scope + (width, height) <- G.widgetGetSize c + C.withImageSurface C.FormatARGB32 width height $ \ result -> do + C.renderWith result $ plotWindow width height scope + C.surfaceWriteToPNG result path + ---------------------------------------------------------------- scopeAlign :: IORef Scope -> CanvasX -> DataX -> IO () @@ -367,6 +365,8 @@ plotWindow width height scope = do prologue width height (view scope) plotLayers scope + plotTimeline scope + plotCursor scope -- Set up stuff prologue :: Int -> Int -> View -> C.Render () @@ -436,6 +436,93 @@ ---------------------------------------------------------------- +plotCursor :: Scope -> C.Render () +plotCursor scope = maybe (return ()) f pointerX + where + View{..} = view scope + f :: CanvasX -> C.Render () + f (CanvasX cX) = do + C.setSourceRGBA 0 0.7 0 0.4 + C.moveTo cX (-1.0) + C.lineTo cX 1.0 + C.stroke + +---------------------------------------------------------------- + +plotTimeline :: Scope -> C.Render () +plotTimeline scope = do + case (dataToTimeStamp scope viewX1, dataToTimeStamp scope viewX2) of + (Just s, Just e) -> do + plotAllTicks s e + plotAllLabels s e + _ -> return () + maybe (return ()) plotArrow pointerX + where + View{..} = view scope + + plotAllTicks :: TimeStamp -> TimeStamp -> C.Render () + plotAllTicks s e = do + plotTicks 0.001 0.05 s e + plotTicks 0.01 0.1 s e + plotTicks 0.02 1.0 s e + plotTicks 0.04 5.0 s e + plotTicks 0.06 10.0 s e + plotTicks 0.08 60.0 s e + plotTicks 0.10 3600.0 s e + + plotTicks :: Double -> Double -> TimeStamp -> TimeStamp -> C.Render () + plotTicks len step (TS start) (TS end) = + when doDraw $ mapM_ (plotTick len) (map TS [s, s+step .. end]) + where + doDraw = (end - start) / step < 100 + s = (fromIntegral (floor (start/step) :: Integer)) * step + + plotTick :: Double -> TimeStamp -> C.Render () + plotTick len ts = do + let (CanvasX cX) = timeStampToCanvas scope ts + C.setSourceRGBA 0 0 0 1.0 + C.moveTo cX 0.90 + C.lineTo cX (0.90 + len) + C.stroke + + plotAllLabels :: TimeStamp -> TimeStamp -> C.Render () + plotAllLabels (TS start) (TS end) = + mapM_ (\s -> plotLabels s (TS start) (TS end)) steps + where + readable x = let viz = (end - start) / x in (viz < 5 && viz >= 1) + steps = take 1 . filter readable $ [3600, 60, 10, 5, 1, 0.1, 0.05] + + plotLabels :: Double -> TimeStamp -> TimeStamp -> C.Render () + plotLabels step (TS start) (TS end) = keepState $ do + let flipY = M.Matrix 1 0 0 (-2.2) 0 0 + C.transform flipY + + let s = (fromIntegral (floor (start/step) :: Integer)) * step + mapM_ (plotLabel . TS) [s, s+step .. end] + + plotLabel :: TimeStamp -> C.Render () + plotLabel ts = do + let CanvasX cX = timeStampToCanvas scope ts + drawString (prettyTimeStamp ts) cX (-0.44) + +drawString :: String -> Double -> Double -> C.Render () +drawString s x y = do + C.selectFontFace "sans" C.FontSlantNormal C.FontWeightNormal + C.setFontSize 0.02 + C.moveTo x y + C.textPath s + C.fillPreserve + +plotArrow :: CanvasX -> C.Render () +plotArrow (CanvasX cX) = do + C.setSourceRGBA 0 0 0 0.9 + C.moveTo (cX-0.004) (0.99) + C.lineTo (cX+0.004) (0.99) + C.lineTo cX (0.98) + C.fill + +---------------------------------------------------------------- + plotLayers :: Scope -> C.Render () plotLayers scope = mapM_ f layersByFile where @@ -449,20 +536,16 @@ flip I.fileDriverRandom path $ do I.joinI $ enumCacheFile identifiers $ do seekTimeStamp (viewStartTime scope (view scope)) - I.sequence_ is + I.joinI . (I.takeWhileE (before (viewEndTime scope v)) >=> I.take 1) $ I.sequence_ is where + v = view scope identifiers = standardIdentifiers is = map (plotLayer scope) layers plotLayer :: Scope -> ScopeLayer -> I.Iteratee [Stream] Render () plotLayer scope (ScopeLayer Layer{..}) = - I.joinI . filterTracks [trackNo] . I.joinI . convEnee $ foldData + I.joinI . filterTracks [trackNo] . I.joinI . convEnee $ render plotter where - v@View{..} = view scope - - foldData = do - I.joinI . I.takeWhileE (before (viewEndTime scope v)) $ render plotter - render (LayerMap f) = do d0'm <- I.tryHead case d0'm of