1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
|
module GUI.SaveAs (saveAsPDF, saveAsPNG) where
-- Imports for ThreadScope
import GUI.Timeline.Render (renderTraces, renderYScaleArea)
import GUI.Timeline.Render.Constants
import GUI.Timeline.Ticks (renderXScaleArea)
import GUI.Types
import Events.HECs
-- Imports for GTK
import Graphics.UI.Gtk hiding (rectangle)
import Graphics.Rendering.Cairo
( Render
, Operator(..)
, Format(..)
, rectangle
, getOperator
, setOperator
, fill
, translate
, liftIO
, withPDFSurface
, renderWith
, withImageSurface
, surfaceWriteToPNG
)
saveAs :: HECs -> ViewParameters -> Double -> DrawingArea
-> (Int, Int, Render ())
saveAs hecs params'@ViewParameters{xScaleAreaHeight, width,
height = oldHeight {-, histogramHeight-}}
yScaleAreaWidth yScaleArea =
let histTotalHeight = histXScaleHeight -- + histogramHeight
params@ViewParameters{height} =
params'{ viewTraces = viewTraces params' -- ++ [TraceHistogram]
, height = oldHeight + histTotalHeight + tracePad
}
w = ceiling yScaleAreaWidth + width
h = xScaleAreaHeight + height
drawTraces = renderTraces params hecs (Rectangle 0 0 width height)
drawXScale = renderXScaleArea params hecs
drawYScale = renderYScaleArea params hecs yScaleArea
-- Functions renderTraces and renderXScaleArea draw to the left of 0
-- which is not seen in the normal mode, but would be seen in export,
-- so it has to be cleared before renderYScaleArea is written on top:
clearLeftArea = do
rectangle 0 0 yScaleAreaWidth (fromIntegral h)
op <- getOperator
setOperator OperatorClear
fill
setOperator op
drawAll = do
translate yScaleAreaWidth (fromIntegral xScaleAreaHeight)
drawTraces
translate 0 (- fromIntegral xScaleAreaHeight)
drawXScale
translate (-yScaleAreaWidth) 0
clearLeftArea
translate 0 (fromIntegral xScaleAreaHeight)
drawYScale
in (w, h, drawAll)
saveAsPDF :: FilePath -> HECs -> ViewParameters -> DrawingArea -> IO ()
saveAsPDF filename hecs params yScaleArea = do
(xoffset, _) <- liftIO $ widgetGetSize yScaleArea
let (w', h', drawAll) = saveAs hecs params (fromIntegral xoffset) yScaleArea
withPDFSurface filename (fromIntegral w') (fromIntegral h') $ \surface ->
renderWith surface drawAll
saveAsPNG :: FilePath -> HECs -> ViewParameters -> DrawingArea -> IO ()
saveAsPNG filename hecs params yScaleArea = do
(xoffset, _) <- liftIO $ widgetGetSize yScaleArea
let (w', h', drawAll) = saveAs hecs params (fromIntegral xoffset) yScaleArea
withImageSurface FormatARGB32 w' h' $ \surface -> do
renderWith surface drawAll
surfaceWriteToPNG surface filename
|
