vacuum-cairo 0.1 → 0.2
raw patch · 2 files changed
+280/−21 lines, 2 filesdep +paralleldep +strict-concurrencydep ~vacuum
Dependencies added: parallel, strict-concurrency
Dependency ranges changed: vacuum
Files
- System/Vacuum/Cairo.hs +276/−19
- vacuum-cairo.cabal +4/−2
System/Vacuum/Cairo.hs view
@@ -12,29 +12,134 @@ -- Will display a pop-up window of the data structure produced -- -module System.Vacuum.Cairo (view) where+module System.Vacuum.Cairo ( + view++ ) where+ import qualified Graphics.UI.Gtk as G import qualified Graphics.UI.Gtk.Gdk.Events as G import qualified Graphics.Rendering.Cairo as C import qualified Graphics.Rendering.Cairo.SVG as C+import qualified Graphics.UI.Gtk.Gdk.DrawWindow as G+import qualified Graphics.UI.Gtk.Gdk.Gdk as G+ import GHC.Vacuum import Text.PrettyPrint import Data.List import System.Process-import Control.Concurrent+import Control.Concurrent (forkIO,yield) import System.IO import Control.Monad import System.Exit import qualified Control.Exception as C +import Control.Concurrent.MVar.Strict+import System.IO.Unsafe+import Control.Parallel.Strategies++------------------------------------------------------------------------++data Session = Session {+ sWindow :: !G.Window ,+ sDrawing :: !G.DrawingArea ,+ sSVG :: !C.SVG+ }++instance NFData Session where+ rnf x = x `seq` ()++sessionRef = unsafePerformIO $ newEmptyMVar+{-# NOINLINE sessionRef #-}++-- | Create a new vacuum session+newSession :: IO ()+newSession = do+ G.unsafeInitGUIForThreadedRTS+ window <- G.windowNew+ canvas <- G.drawingAreaNew+ svg <- C.svgNewFromString welcome++ G.onKeyPress window $ anyKey (G.widgetDestroy window)+ G.onDestroy window (takeMVar sessionRef >> G.mainQuit)++ G.onExposeRect canvas $ const $ do+-- print "EXPOSE"+ withMVar sessionRef $ \(Session _ c svg) ->+ updateCanvas svg c+ return ()++ -- not needed.+ G.onExposeRect window $ const $ do+-- print "EXPOSE"+ withMVar sessionRef $ \(Session _ c svg) ->+ updateCanvas svg c+ return ()++-- G.widgetSetSizeRequest window 400 200+ G.set window [G.containerChild G.:= canvas]+ G.widgetShowAll window+ forkIO G.mainGUI++ let s = Session {+ sWindow = window,+ sDrawing = canvas,+ sSVG = svg+ }++ putMVar sessionRef $! s++-- | Render a value using the current session+view :: a -> IO ()+view a = do+ noSession <- isEmptyMVar sessionRef+ () <- when noSession $ newSession++ let dot = render. ppDot . nameGraph $ vacuum a+ rnf dot `seq` return ()++ -- TODO check for path+ svgstring <- myReadProcess "dot" ["-Tsvg"] dot+ svg <- C.svgNewFromString svgstring++-- TODO destroy old svg canvas here.+ c <- modifyMVar sessionRef $ \(Session win canvas svg') -> do+ updateCanvas svg canvas+ return ((Session win canvas svg), (canvas))++ -- hides expose events!+ G.widgetQueueDraw c+-- performGC+ yield+ return ()++++updateCanvas :: C.SVG -> G.DrawingArea -> IO Bool+updateCanvas svg canvas = do+ win <- G.widgetGetDrawWindow canvas+ (width, height) <- G.widgetGetSize canvas+ let (w,h) = (fromIntegral width,fromIntegral height)+ (sw,sh) = C.svgGetSize svg++ G.renderWithDrawable win $ do+ C.scale (w / fromIntegral sw) (h / fromIntegral sh)+ C.svgRender svg++ return True++------------------------------------------------------------------------++{- -- | Render a 'vacuum' image of the heap on a pop-up cairo canvas view :: a -> IO () view a = do let dot = render. ppDot . nameGraph $ vacuum a svg <- myReadProcess "dot" ["-Tsvg"] dot- renderableToWindow svg 800 600+ renderableToWindow svg+-} ------------------------------------------------------------------------ -- UI@@ -49,8 +154,8 @@ type SVGString = String -renderableToWindow :: SVGString -> Int -> Int -> IO ()-renderableToWindow chart windowWidth windowHeight = do+renderableToWindow :: SVGString -> IO ()+renderableToWindow chart = do svg <- C.svgNewFromString chart G.unsafeInitGUIForThreadedRTS@@ -59,27 +164,21 @@ canvas <- G.drawingAreaNew -- fix size -- G.windowSetResizable window False- G.widgetSetSizeRequest window windowWidth windowHeight+-- G.widgetSetSizeRequest window windowWidth windowHeight+ -- press any key to quit- G.onKeyPress window $ anyKey (G.widgetDestroy window)+ G.onKeyPress window $ \e -> case e of+ G.Key {G.eventKeyName=key}+ | key == "r" -> do+ return True+ _ -> anyKey (G.widgetDestroy window) e+ G.onDestroy window G.mainQuit G.onExpose canvas $ const (updateCanvas svg canvas) G.set window [G.containerChild G.:= canvas] G.widgetShowAll window G.mainGUI -updateCanvas :: C.SVG -> G.DrawingArea -> IO Bool-updateCanvas svg canvas = do- win <- G.widgetGetDrawWindow canvas- (width, height) <- G.widgetGetSize canvas- let (w,h) = (fromIntegral width,fromIntegral height)- let (sw,sh) = C.svgGetSize svg-- G.renderWithDrawable win $ do- C.scale (w / fromIntegral sw) (h / fromIntegral sh)- C.svgRender svg- return True- ------------------------------------------------------------------------ -- Talking to dot @@ -121,3 +220,161 @@ Nothing Nothing) -}+++------------------------------------------------------------------------++welcome = unlines+ ["<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"no\"?>",+ "<!-- Created with Inkscape (http://www.inkscape.org/) -->",+ "<svg",+ " xmlns:dc=\"http://purl.org/dc/elements/1.1/\"",+ " xmlns:cc=\"http://web.resource.org/cc/\"",+ " xmlns:rdf=\"http://www.w3.org/1999/02/22-rdf-syntax-ns#\"",+ " xmlns:svg=\"http://www.w3.org/2000/svg\"",+ " xmlns=\"http://www.w3.org/2000/svg\"",+ " xmlns:xlink=\"http://www.w3.org/1999/xlink\"",+ " xmlns:sodipodi=\"http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd\"",+ " xmlns:inkscape=\"http://www.inkscape.org/namespaces/inkscape\"",+ " width=\"260\"",+ " height=\"270\"",+ " id=\"svg2\"",+ " sodipodi:version=\"0.32\"",+ " inkscape:version=\"0.45\"",+ " sodipodi:docbase=\"/home/david/Inkscape Files/Wiki\"",+ " sodipodi:docname=\"GTK.svg\"",+ " inkscape:output_extension=\"org.inkscape.output.svg.inkscape\"",+ " version=\"1.0\"",+ " sodipodi:modified=\"true\">",+ " <defs",+ " id=\"defs4\">",+ " <linearGradient",+ " inkscape:collect=\"always\"",+ " id=\"linearGradient2259\">",+ " <stop",+ " style=\"stop-color:#fe798e;stop-opacity:1\"",+ " offset=\"0\"",+ " id=\"stop2261\" />",+ " <stop",+ " style=\"stop-color:#9c2219;stop-opacity:1\"",+ " offset=\"1\"",+ " id=\"stop2263\" />",+ " </linearGradient>",+ " <linearGradient",+ " inkscape:collect=\"always\"",+ " id=\"linearGradient2251\">",+ " <stop",+ " style=\"stop-color:#bff872;stop-opacity:1\"",+ " offset=\"0\"",+ " id=\"stop2253\" />",+ " <stop",+ " style=\"stop-color:#7de567;stop-opacity:1\"",+ " offset=\"1\"",+ " id=\"stop2255\" />",+ " </linearGradient>",+ " <linearGradient",+ " inkscape:collect=\"always\"",+ " id=\"linearGradient2243\">",+ " <stop",+ " style=\"stop-color:#92cbe2;stop-opacity:1\"",+ " offset=\"0\"",+ " id=\"stop2245\" />",+ " <stop",+ " style=\"stop-color:#7f95fe;stop-opacity:1\"",+ " offset=\"1\"",+ " id=\"stop2247\" />",+ " </linearGradient>",+ " <linearGradient",+ " inkscape:collect=\"always\"",+ " xlink:href=\"#linearGradient2243\"",+ " id=\"linearGradient2285\"",+ " gradientUnits=\"userSpaceOnUse\"",+ " gradientTransform=\"translate(92.2254,-0.313709)\"",+ " x1=\"-143\"",+ " y1=\"207.36218\"",+ " x2=\"-129.5\"",+ " y2=\"108.86218\" />",+ " <linearGradient",+ " inkscape:collect=\"always\"",+ " xlink:href=\"#linearGradient2251\"",+ " id=\"linearGradient2287\"",+ " gradientUnits=\"userSpaceOnUse\"",+ " gradientTransform=\"translate(92.2254,-0.313709)\"",+ " x1=\"-133.5\"",+ " y1=\"221.86218\"",+ " x2=\"-50\"",+ " y2=\"279.36218\" />",+ " <linearGradient",+ " inkscape:collect=\"always\"",+ " xlink:href=\"#linearGradient2259\"",+ " id=\"linearGradient2289\"",+ " gradientUnits=\"userSpaceOnUse\"",+ " gradientTransform=\"translate(92.2254,-0.313709)\"",+ " x1=\"-157.5\"",+ " y1=\"222.86218\"",+ " x2=\"-247.5\"",+ " y2=\"276.86218\" />",+ " </defs>",+ " <sodipodi:namedview",+ " id=\"base\"",+ " pagecolor=\"#ffffff\"",+ " bordercolor=\"#666666\"",+ " borderopacity=\"1.0\"",+ " gridtolerance=\"10000\"",+ " guidetolerance=\"10\"",+ " objecttolerance=\"10\"",+ " inkscape:pageopacity=\"0.0\"",+ " inkscape:pageshadow=\"2\"",+ " inkscape:zoom=\"1\"",+ " inkscape:cx=\"292.4078\"",+ " inkscape:cy=\"237.54502\"",+ " inkscape:document-units=\"px\"",+ " inkscape:current-layer=\"layer1\"",+ " inkscape:window-width=\"1280\"",+ " inkscape:window-height=\"948\"",+ " inkscape:window-x=\"0\"",+ " inkscape:window-y=\"24\"",+ " width=\"260px\"",+ " height=\"270px\" />",+ " <metadata",+ " id=\"metadata7\">",+ " <rdf:RDF>",+ " <cc:Work",+ " rdf:about=\"\">",+ " <dc:format>image/svg+xml</dc:format>",+ " <dc:type",+ " rdf:resource=\"http://purl.org/dc/dcmitype/StillImage\" />",+ " </cc:Work>",+ " </rdf:RDF>",+ " </metadata>",+ " <g",+ " inkscape:label=\"Layer 1\"",+ " inkscape:groupmode=\"layer\"",+ " id=\"layer1\"",+ " transform=\"translate(-45.007449,-54.076718)\">",+ " <g",+ " id=\"g2279\"",+ " transform=\"translate(224,-34.5)\">",+ " <path",+ " sodipodi:nodetypes=\"ccccc\"",+ " style=\"fill:url(#linearGradient2285);fill-opacity:1\"",+ " d=\"M -58.11348,213.41831 L -162.26826,151.37974 L -37.01785,100.04846 L 68.1307,158.15264 L -58.11348,213.41831 z \"",+ " id=\"path2231\" />",+ " <path",+ " style=\"fill:url(#linearGradient2287);fill-opacity:1\"",+ " d=\"M -51.56037,213.5916 L 72.03976,159.30293 L 54.30386,283.51375 L -62.14067,350.24024 L -51.56037,213.5916 z \"",+ " id=\"path2229\"",+ " sodipodi:nodetypes=\"ccccc\" />",+ " <path",+ " sodipodi:nodetypes=\"ccccc\"",+ " style=\"fill:url(#linearGradient2289);fill-opacity:1\"",+ " d=\"M -59.56037,347.18826 L -164.06037,282.96566 L -163.61166,159.3255 L -55.18554,215.49255 L -59.56037,347.18826 z \"",+ " id=\"path2227\" />",+ " <path",+ " style=\"fill:#000000\"",+ " d=\"M -66.27108,352.00632 C -69.30467,350.22909 -85.32501,339.74485 -101.87184,328.708 C -141.06516,302.56578 -152.91684,294.99749 -161.22644,290.80508 C -172.47362,285.13057 -171.42166,291.71277 -171.76785,224.84661 C -172.09132,162.36876 -172.8819,151.51349 -166.98072,153.09872 C -171.59657,148.70486 -149.89048,141.93362 -115.91158,126.8062 C -82.71848,112.02862 -46.04303,97.12968 -37.99045,95.151731 C -35.80415,94.614711 -30.58575,96.813551 -10.91381,106.56083 C 32.31874,127.98218 67.99593,147.7319 72.54924,152.76325 C 73.58759,153.91062 75.03553,154.84937 75.76688,154.84937 C 77.84679,154.84937 78.37332,158.95768 77.25844,166.48751 C 76.69538,170.29042 72.64193,195.0632 68.25078,221.53813 C 63.85962,248.01307 59.96508,272.38204 59.59625,275.69141 C 58.29011,287.41076 58.65986,286.97385 40.74281,297.9691 C 31.80145,303.4562 9.14236,316.66419 -9.61071,327.3202 C -28.36378,337.97622 -47.03613,348.65729 -51.10479,351.05592 C -55.17346,353.45455 -59.00931,355.3767 -59.62892,355.32736 C -60.24852,355.27802 -63.23749,353.78356 -66.27108,352.00632 z M -61.87106,326.08404 C -61.53987,317.12117 -60.90739,291.51119 -60.46556,269.17296 C -59.4846,219.57813 -59.22374,221.12454 -69.76193,214.06246 C -82.68227,205.404 -96.65592,197.35576 -120.42436,184.88302 C -133.38604,178.08124 -147.58846,170.35597 -151.98528,167.71576 C -157.4594,164.42865 -160.30462,163.24026 -161.01083,163.94598 C -162.29568,165.22992 -162.39159,217.12625 -161.17615,253.40053 L -160.31016,279.24588 L -153.15345,283.38712 C -146.97571,286.96188 -111.07469,311.08894 -76.29946,335.03636 C -70.50807,339.02452 -65.02796,342.30839 -64.12144,342.33386 C -62.68203,342.3743 -62.39695,340.31581 -61.87106,326.08404 z M -123.45447,281.63953 L -121.92862,231.56652 L -140.98255,221.52843 L -138.49408,200.85313 L -78.16426,229.52961 L -79.29283,248.93423 L -101.23414,239.89866 C -104.02169,251.08704 -104.55187,273.56224 -106.14867,290.70437 L -123.45447,281.63953 z M -9.61071,316.77116 C 34.17351,291.73098 48.95974,282.50651 49.5137,279.88608 C 49.76822,278.68213 50.70639,272.73304 51.59851,266.66586 C 52.49065,260.59869 56.34489,236.69937 60.1635,213.55627 C 66.55191,174.8386 67.87919,164.87776 66.64985,164.87776 C 65.35309,164.87776 41.87183,175.43096 11.95031,189.46143 C -6.52698,198.1256 -27.06009,207.7061 -33.67883,210.75142 C -40.29756,213.79674 -46.27431,216.80609 -46.96048,217.43886 C -49.01471,219.33318 -53.67591,334.1607 -51.88774,338.82058 C -51.3077,340.33214 -50.58188,340.15475 -45.46483,337.25078 C -42.2919,335.45011 -26.15754,326.23429 -9.61071,316.77116 z M -31.52427,299.57413 C -31.87775,272.99487 -33.95338,246.76003 -28.00983,218.92136 L -15.53109,218.69485 L -14.46997,256.84948 L 28.82336,204.1205 L 49.21858,198.81459 L 11.17117,250.94644 L 46.4177,267.81063 L 31.8401,277.19567 L -4.08659,261.22054 L -17.12774,267.67154 L -17.55651,293.33323 L -31.52427,299.57413 z M -44.98935,205.62376 C -42.07793,204.31693 -20.74221,194.22819 2.42335,183.20435 C 25.58892,172.18051 47.47586,161.89162 51.06101,160.34015 C 60.54302,156.23684 60.93348,155.67356 56.37503,152.674 C 49.35425,148.05414 13.69688,129.08139 -11.32169,116.65357 L -36.09795,104.34612 L -44.41536,107.15536 C -56.14763,111.11798 -89.54973,125.04344 -118.35237,137.97996 C -148.44864,151.49752 -152.51519,153.54112 -152.51519,155.14816 C -152.51519,155.84547 -145.85885,160.0994 -137.72332,164.60135 C -111.60287,179.05557 -54.81147,207.96913 -52.51064,207.98472 C -51.28536,207.99302 -47.90078,206.93059 -44.98935,205.62376 z M -60.75547,189.54567 C -75.28072,185.96717 -91.81229,177.57594 -96.0911,171.6097 C -99.47879,166.88602 -102.37326,159.22994 -102.37326,154.99297 C -102.37326,149.88393 -99.16092,142.63741 -94.96571,138.28271 C -89.64934,132.76424 -82.2461,130.42562 -63.03287,128.19542 C -43.93665,125.97879 -27.42575,126.6637 -17.57474,130.08117 C -8.29082,133.30188 -4.52834,135.30727 -2.61559,138.05436 C 2.38083,145.2301 5.93328,151.2196 5.93328,152.46787 C 5.93328,154.32106 1.29355,156.06801 -2.01293,155.45979 C -3.4339,155.1984 -6.26937,154.71168 -8.31397,154.3782 C -11.32445,153.88717 -12.45855,153.01191 -14.27723,149.776 C -16.85292,145.19318 -23.60657,140.51818 -30.15247,138.78687 C -40.15132,136.14228 -67.5992,138.35316 -76.05306,142.48406 C -80.82949,144.81802 -83.39709,149.93235 -84.08312,158.47883 C -84.55072,164.304 -84.36299,165.20843 -82.20604,167.52215 C -79.28527,170.65521 -71.09215,174.87312 -62.00697,177.92089 C -56.94497,179.61901 -54.0594,180.03115 -50.5755,179.55363 C -42.46315,178.44171 -41.49161,176.3237 -46.32188,170.28055 C -50.48755,165.06888 -51.4992,162.24318 -50.12122,159.66839 C -49.15472,157.86249 -48.34815,157.66756 -43.78911,158.13809 C -37.32875,158.80486 -23.72903,163.98325 -20.5194,166.99854 C -17.69425,169.65263 -17.2471,175.88082 -19.70523,178.33895 C -22.5073,181.14102 -34.94771,188.0685 -39.80016,189.52887 C -45.45811,191.23166 -53.88454,191.23841 -60.75547,189.54567 z \"",+ " id=\"path2225\"",+ " sodipodi:nodetypes=\"cssscssssssssssssccssssscccsscccccccccccssssssssscccccccccccccccssscccssssccssssssssssssssssssssssc\" />",+ " </g>",+ " </g>",+ "</svg>"]
vacuum-cairo.cabal view
@@ -1,5 +1,5 @@ name: vacuum-cairo-version: 0.1+version: 0.2 cabal-version: >= 1.2 build-type: Simple license: BSD3@@ -27,8 +27,10 @@ library build-depends: base >= 3,- vacuum,+ vacuum >= 0.0.5, gtk,+ parallel,+ strict-concurrency, cairo, svgcairo, process,