haskell-chart icon indicating copy to clipboard operation
haskell-chart copied to clipboard

Multiple SVGs interfering

Open gibiansky opened this issue 10 years ago • 6 comments

I am not sure that this is a chart or chart-cairo bug, but I don't have the expertise to deal with this myself...

If you generate two SVGs using Chart and chart-cairo, and then conjoin them into one HTML file, then when you display them the second one gets messed up. I think this is because the glyphs from the first one are used in the second one, sine they share names.

You can look at an example by curling and viewing this file, or here (see cell output 31).

Here is some code you can use to generate this broken HTML file:

{-# LANGUAGE OverloadedStrings #-}
import Graphics.Rendering.Chart
import Data.Default.Class
import Control.Lens
import Graphics.Rendering.Chart.Backend.Cairo


import Data.Colour
import Data.Colour.Names

xvals = [1.5, 2.5, 5, 8 :: Double ]
yvals = [0.025, 0.1, 9, 230 :: Double ]

xlvals = map LogValue xvals
ylvals = map LogValue yvals

-- | Connect the points (xs,ys) with a solid
--   line using the given color.
lineXY :: (PlotValue a, PlotValue b) => Colour Double -> [a] -> [b] -> Plot a b
lineXY col xs ys = toPlot p
    where
        p = plot_lines_style .~ solidLine 1 (opaque col)
            $ plot_lines_values .~ [zip xs ys]
            $ def

-- | Draw symbols at the points (xs,ys).
--
symbolXY ::
    (PlotValue a, PlotValue b) =>
    (AlphaColour Double -> PointStyle)
    -> Colour Double 
    -> [a] 
    -> [b] 
    -> Plot a b
symbolXY sym col xs ys = toPlot p
    where
        p = plot_points_style .~ sym (opaque col)
            $ plot_points_values .~ zip xs ys
            $ def

asCircle = filledCircles 10
asStar = stars 10 2

-- | This function will plot the given function of x over the list of xs.
plotIt :: 
  (PlotValue a, PlotValue b) =>
  (Colour Double -> [a] -> [b] -> Plot a b)
  -> [a]
  -> [b]
  -> Renderable ()

plotIt plotType xs ys = toRenderable l
    where
        l = layout_title .~ "Plot"
            $ layout_plots .~ [ plotType blue xs ys ]
            $ def

main = do
  let renderable = plotIt (symbolXY asCircle) xvals yvals
      renderable' = plotIt (symbolXY asStar) xlvals ylvals
      filename = "svg.svg"
      filename' = "svg2.svg"
      opts = def{_fo_format = SVG, _fo_size = (500, 400)}
  renderableToFile opts renderable filename
  renderableToFile opts renderable' filename'

Then run cat svg.svg svg2.svg > two.html, and view two.html in Firefox or Chrome.

Any idea what's going on? Is this a bug in browsers? Or in Chart? or what?

gibiansky avatar Mar 01 '14 03:03 gibiansky

It looks like there's no way around this uniqueness requirement?

gibiansky avatar Mar 01 '14 03:03 gibiansky

It seems odd to me that the definitions aren't local to their corresponding elements, but the stack overflow question you reference seems to say this is the case.

I don't think it's a problem in the chart svg driver - it generate unique ids within any single svg output. Rather that SVG files that are to be assembled into a single HTML file need to be processed in such a way to ensure ids are unique across the combined output.

I guess such a tools could be written in haskell or any other language.

timbod7 avatar Mar 04 '14 10:03 timbod7

Could it be possible to somehow pass an option to the renderer? Maybe something in the renderer options, like

opts = def{_fo_format = SVG, _fo_size = (500, 400), _fo_namespace = Just "uniquename"}

And then it would use that namespace?

Also, what is the simple way to process them? Can we just do string replacements for the glyphs somehow? Say, just something like sed 's/glyph/uniqueGlyphName/g'?

gibiansky avatar Mar 04 '14 16:03 gibiansky

I didn't realise until I looked at you example in more detail that you were using the cairo backend. I think it will be hard/impossible to prefix the glyph names to make them distinct in this backend, as the SVG generation is a c library. A quick look at the API:

 http://cairographics.org/manual/cairo-SVG-Surfaces.html

suggests that control over the glyph names is buried in the library.

There is the SVG backend based upon the diagrams library which may give you more control, and all the code is haskell. There's a need to step through the logic in the various libraries to see where the glyph names are created - it's still a layer below the chart library. Also there's another caveat here though - SVG generation via diagrams is much slower.

timbod7 avatar Mar 06 '14 12:03 timbod7

That's sad. Perhaps then it's worth just documenting this somewhere, noting the img tag plus base 64 work around, and leaving it at that.

gibiansky avatar Mar 06 '14 18:03 gibiansky

I've added a comment to the documentation for the cairo/SVG backennd combination.

It might be worth experimenting with the diagrams/SVG backend - depending on how it is called I think it won't generate glyphs in this way at all.

timbod7 avatar Mar 06 '14 20:03 timbod7