Creating an SVG device - Part 3

Introduction

This series of vignettes will walk through the process of creating a very basic SVG output device using devout.

The only code to be written is R code. All the tricky C/C++ code is taken care of within devout.

Vignettes in this series:

  1. A simple callback function
  2. Setting up a ‘canvas’ upon which to write the SVG
  3. This vignette:
    • Adding support for device calls which draw on the canvas
  4. Simple experimentation

Adding support for device calls which draw on the canvas

In the previous vignettes we create a callback function (svg_callback()) and implemented handlers for device_call = "open" and "close".

Now we will add handlers for the device calls which want to draw a graphics primitive e.g. rect, line, circle.

The svg_open() and svg_close() functions are adapted to only write the lead-in and lead-out parts of an SVG document. The size for the SVG canvas is found in the device settings i.e. state$dd. For a list of all the possible device settings, please see devinfo$dd.

device settings (click to open) 
devinfo$dd %>%
  knitr::kable(caption = "Device settings")
Device settings
name type length description default
left numeric 1 left raster coordinate 0
top numeric 1 top raster coordinate 0
right numeric 1 right raster coordinate width * 72
bottom numeric 1 bottom raster coordinate height * 72
clipLeft numeric 1 rectangular clipping extents 0
clipTop numeric 1 rectangular clipping extents 0
clipRight numeric 1 rectangular clipping extents width * 72
clipBottom numeric 1 rectangular clipping extents height * 72
xcharOffset numeric 1 x character addressing offset - unused 0.49
yCharOffset numeric 1 y character addressing offset 0.3333
yLineBias numeric 1 1/2 interline space as frac of line height 0.2
ipr numeric 2 Inches per raster c(x, y) c(1/72, 1/72)
cra numeric 2 Character size in rasters c(x, y) c(0.9 * startps, 1.2 * startps)
gamma numeric 1 Device Gamma Correction 1
canClip logical 1 Device-level clipping TRUE
canHAdj integer 1 Can do at least some horiz adjust of text: 0 = none, 1 = {0, 0.5, 1}, 2 = [0, 1] 0L
canChangeGamma logical 1 can the gamma factor be modified? FALSE
displayListOn logical 1 toggle for initial display list status FALSE
haveTransparency integer 1 1 = no, 2 = yes 2L
haveTransparentBg integer 1 1 = no, 2 = fully, 3 = semi 2L
haveRaster integer 1 1 = no, 2 = yes, 3 = except for missing values 2L
haveCapture integer 1 1 = no, 2 = yes 2L
haveLocator integer 1 1 = no, 2 = yes 2L
startfill integer 4 sets par(bg) and gpar(fill) c(255L, 255L, 255L, 255L)
startcol integer 4 sets par(fg), par(col) and gpar(col) c(0L, 0L, 0L, 255L)
startps numeric 1 initial pointsize 12
startlty integer 1 initial linetype 0L
startfont integer 1 initial font 1L
startgamma numeric 1 initial gamma correction 1
wantSymbolUTF8 logical 1 NFI TRUE
hasTextUTF8 logical 1 Device supports UTF8 text TRUE
useRotatedTextInContour logical 1 Is rotated text good enough to be preferable to Hershey in contour label TRUE
canGenMouseDown logical 1 can the device generate mousedown events FALSE
canGenMouseMove logical 1 can the device generate mousemove events FALSE
canGenMouseUp logical 1 can the device generate mouseup events FALSE
canGenKeybd logical 1 can the device generate keyboard events FALSE
canGenIdle logical 1 can the device generate idle events FALSE
gettingEvent logical 1 This is set while getGraphicsEvent is actively looking for events FALSE 


#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# When opening a device
#  - create a "canvas".  For svg, the canvas is just a text string of SVG 
#    commands that we'll keep adding to with each device call
#  - add the canvas to the 'state$rdata' list
#  - always return the state so we keep the canvas across different device calls
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
svg_open <- function(args, state) {
  state$rdata$svg <- glue::glue('<svg height="{state$dd$bottom/72}" width="{state$dd$right/72}">')
  state
}

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# When the device is closed, add the closing svg tag and output to file
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
svg_close <- function(args, state) {  
  state$rdata$svg <- paste(state$rdata$svg, "</svg>", sep = "\n")
  writeLines(state$rdata$svg, state$rdata$filename)
  state
}


#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Add a circle to the SVG
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
svg_circle <- function(args, state) {
  state$rdata$svg <- paste(
    state$rdata$svg,
    glue::glue('<circle cx="{args$x/72}" cy="{args$y/72}" r="{args$r}" stroke="black" fill="black" />'),
    sep = "\n"
  )
  state
}


#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Add a line to the SVG
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
svg_polyline <- function(args, state) {
  state$rdata$svg <- paste(
    state$rdata$svg,
    glue::glue('<polyline points="{paste(args$x/72, args$y/72, sep=",", collapse = " ")}" stroke="black"  fill = "none" />'),
    sep = "\n"
  )
  state
}


#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Add a polyline to the SVG
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
svg_line <- function(args, state) {
  state$rdata$svg <- paste(
    state$rdata$svg,
    glue::glue('<line x1="{args$x1/72}" y1="{args$y1/72}" x2="{args$x2/72}" y2="{args$y2/72}" stroke="black"  fill = "none" />'),
    sep = "\n"
  )
  state
}

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Add text to the SVG
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
svg_text <- function(args, state) {
  state$rdata$svg <- paste(
    state$rdata$svg,
    glue::glue('<text x="{args$x/72}" y="{args$y/72}" transform="rotate({-args$rot}, {args$x/72}, {args$y/72})" fill="black">{args$str}</text>'),
    sep = "\n"
  )
  state
}

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Call a different function to match each of the device calls we handle.
# Always return the state
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
svg_callback <- function(device_call, args, state) {
  switch(
    device_call,
    "open"         = svg_open      (args, state),
    "close"        = svg_close     (args, state),
    "circle"       = svg_circle    (args, state),
    "line"         = svg_line      (args, state),
    "polyline"     = svg_polyline  (args, state),
    "textUTF8"     = svg_text      (args, state),
    state
  )
}

Example plot

rdevice(svg_callback, filename = "svg/test-draw.svg") 
ggplot(mtcars) + geom_point(aes(mpg, wt))
invisible(dev.off())

View the SVG text output

cat(paste(readLines("svg/test-draw.svg"), collapse = "\n"))
#> <svg height="8" width="10">
#> <polyline points="0.714315068493151,7.20447156512392 9.92389649923896,7.20447156512392" stroke="black"  fill = "none" />
#> <polyline points="0.714315068493151,5.47409614441951 9.92389649923896,5.47409614441951" stroke="black"  fill = "none" />
#> <polyline points="0.714315068493151,3.74372072371509 9.92389649923896,3.74372072371509" stroke="black"  fill = "none" />
#> <polyline points="0.714315068493151,2.01334530301067 9.92389649923896,2.01334530301067" stroke="black"  fill = "none" />
#> <polyline points="0.714315068493151,0.282969882306249 9.92389649923896,0.282969882306249" stroke="black"  fill = "none" />
#> <polyline points="1.88109956310408,7.52035159817352 1.88109956310408,0.0761035007610344" stroke="black"  fill = "none" />
#> <polyline points="3.66244993655588,7.52035159817352 3.66244993655588,0.0761035007610344" stroke="black"  fill = "none" />
#> <polyline points="5.44380031000768,7.52035159817352 5.44380031000768,0.0761035007610344" stroke="black"  fill = "none" />
#> <polyline points="7.22515068345949,7.52035159817352 7.22515068345949,0.0761035007610344" stroke="black"  fill = "none" />
#> <polyline points="9.00650105691129,7.52035159817352 9.00650105691129,0.0761035007610344" stroke="black"  fill = "none" />
#> <polyline points="0.714315068493151,6.33928385477171 9.92389649923896,6.33928385477171" stroke="black"  fill = "none" />
#> <polyline points="0.714315068493151,4.6089084340673 9.92389649923896,4.6089084340673" stroke="black"  fill = "none" />
#> <polyline points="0.714315068493151,2.87853301336288 9.92389649923896,2.87853301336288" stroke="black"  fill = "none" />
#> <polyline points="0.714315068493151,1.14815759265846 9.92389649923896,1.14815759265846" stroke="black"  fill = "none" />
#> <polyline points="0.99042437637818,7.52035159817352 0.99042437637818,0.0761035007610344" stroke="black"  fill = "none" />
#> <polyline points="2.77177474982998,7.52035159817352 2.77177474982998,0.0761035007610344" stroke="black"  fill = "none" />
#> <polyline points="4.55312512328178,7.52035159817352 4.55312512328178,0.0761035007610344" stroke="black"  fill = "none" />
#> <polyline points="6.33447549673359,7.52035159817352 6.33447549673359,0.0761035007610344" stroke="black"  fill = "none" />
#> <polyline points="8.11582587018539,7.52035159817352 8.11582587018539,0.0761035007610344" stroke="black"  fill = "none" />
#> <polyline points="9.89717624363719,7.52035159817352 9.89717624363719,0.0761035007610344" stroke="black"  fill = "none" />
#> <circle cx="4.90939519797214" cy="5.26645109393497" r="1.95479822834646" stroke="black" fill="black" />
#> <circle cx="4.90939519797214" cy="4.82520536165535" r="1.95479822834646" stroke="black" fill="black" />
#> <circle cx="5.55068133241479" cy="5.7855637201463" r="1.95479822834646" stroke="black" fill="black" />
#> <circle cx="5.05190322784829" cy="4.23687771861585" r="1.95479822834646" stroke="black" fill="black" />
#> <circle cx="4.08997402618431" cy="3.84754324895735" r="1.95479822834646" stroke="black" fill="black" />
#> <circle cx="3.8762119813701" cy="3.81293574054326" r="1.95479822834646" stroke="black" fill="black" />
#> <circle cx="2.52238569754673" cy="3.62259444426578" r="1.95479822834646" stroke="black" fill="black" />
#> <circle cx="6.12071345191937" cy="4.28013710413346" r="1.95479822834646" stroke="black" fill="black" />
#> <circle cx="5.55068133241479" cy="4.34935212096163" r="1.95479822834646" stroke="black" fill="black" />
#> <circle cx="4.2681090635295" cy="3.84754324895735" r="1.95479822834646" stroke="black" fill="black" />
#> <circle cx="3.76933095896299" cy="3.84754324895735" r="1.95479822834646" stroke="black" fill="black" />
#> <circle cx="3.27055285439649" cy="2.75740673391357" r="1.95479822834646" stroke="black" fill="black" />
#> <circle cx="3.59119592161781" cy="3.34573437695307" r="1.95479822834646" stroke="black" fill="black" />
#> <circle cx="2.84302876476805" cy="3.25921560591785" r="1.95479822834646" stroke="black" fill="black" />
#> <circle cx="1.13293240625432" cy="0.715563737482354" r="1.95479822834646" stroke="black" fill="black" />
#> <circle cx="1.13293240625432" cy="0.414478414279785" r="1.95479822834646" stroke="black" fill="black" />
#> <circle cx="2.66489372742287" cy="0.551178072515433" r="1.95479822834646" stroke="black" fill="black" />
#> <circle cx="8.97087404944225" cy="5.99320877063083" r="1.95479822834646" stroke="black" fill="black" />
#> <circle cx="8.25833390006153" cy="7.00547839174292" r="1.95479822834646" stroke="black" fill="black" />
#> <circle cx="9.50527916147779" cy="6.62479579918794" r="1.95479822834646" stroke="black" fill="black" />
#> <circle cx="5.08753023531732" cy="5.53465928414416" r="1.95479822834646" stroke="black" fill="black" />
#> <circle cx="2.94990978717516" cy="3.709113215301" r="1.95479822834646" stroke="black" fill="black" />
#> <circle cx="2.84302876476805" cy="3.85619512606087" r="1.95479822834646" stroke="black" fill="black" />
#> <circle cx="2.16611562285637" cy="3.15539308067558" r="1.95479822834646" stroke="black" fill="black" />
#> <circle cx="4.2681090635295" cy="3.14674120357206" r="1.95479822834646" stroke="black" fill="black" />
#> <circle cx="7.15389666852142" cy="6.4517582571175" r="1.95479822834646" stroke="black" fill="black" />
#> <circle cx="6.69074557142395" cy="6.0970312958731" r="1.95479822834646" stroke="black" fill="black" />
#> <circle cx="8.25833390006153" cy="7.18197668465477" r="1.95479822834646" stroke="black" fill="black" />
#> <circle cx="3.05679080958227" cy="4.31474461254755" r="1.95479822834646" stroke="black" fill="black" />
#> <circle cx="4.44624410087468" cy="5.00689478082931" r="1.95479822834646" stroke="black" fill="black" />
#> <circle cx="2.77177474982998" cy="3.62259444426578" r="1.95479822834646" stroke="black" fill="black" />
#> <circle cx="5.05190322784829" cy="4.98959102662227" r="1.95479822834646" stroke="black" fill="black" />
#> <text x="0.279155251141552" y="6.40528385477171" transform="rotate(0, 0.279155251141552, 6.40528385477171)" fill="black">2</text>
#> <text x="0.279155251141552" y="4.6749084340673" transform="rotate(0, 0.279155251141552, 4.6749084340673)" fill="black">3</text>
#> <text x="0.279155251141552" y="2.94453301336288" transform="rotate(0, 0.279155251141552, 2.94453301336288)" fill="black">4</text>
#> <text x="0.279155251141552" y="1.21415759265846" transform="rotate(0, 0.279155251141552, 1.21415759265846)" fill="black">5</text>
#> <polyline points="0.676263318112633,6.33928385477171 0.714315068493151,6.33928385477171" stroke="black"  fill = "none" />
#> <polyline points="0.676263318112633,4.6089084340673 0.714315068493151,4.6089084340673" stroke="black"  fill = "none" />
#> <polyline points="0.676263318112633,2.87853301336288 0.714315068493151,2.87853301336288" stroke="black"  fill = "none" />
#> <polyline points="0.676263318112633,1.14815759265846 0.714315068493151,1.14815759265846" stroke="black"  fill = "none" />
#> <polyline points="0.99042437637818,7.55840334855403 0.99042437637818,7.52035159817351" stroke="black"  fill = "none" />
#> <polyline points="2.77177474982998,7.55840334855403 2.77177474982998,7.52035159817351" stroke="black"  fill = "none" />
#> <polyline points="4.55312512328178,7.55840334855403 4.55312512328178,7.52035159817351" stroke="black"  fill = "none" />
#> <polyline points="6.33447549673359,7.55840334855403 6.33447549673359,7.52035159817351" stroke="black"  fill = "none" />
#> <polyline points="8.11582587018539,7.55840334855403 8.11582587018539,7.52035159817351" stroke="black"  fill = "none" />
#> <polyline points="9.89717624363719,7.55840334855403 9.89717624363719,7.52035159817351" stroke="black"  fill = "none" />
#> <text x="0.745979931933736" y="7.72084474885845" transform="rotate(0, 0.745979931933736, 7.72084474885845)" fill="black">10</text>
#> <text x="2.52733030538554" y="7.72084474885845" transform="rotate(0, 2.52733030538554, 7.72084474885845)" fill="black">15</text>
#> <text x="4.30868067883734" y="7.72084474885845" transform="rotate(0, 4.30868067883734, 7.72084474885845)" fill="black">20</text>
#> <text x="6.09003105228914" y="7.72084474885845" transform="rotate(0, 6.09003105228914, 7.72084474885845)" fill="black">25</text>
#> <text x="7.87138142574094" y="7.72084474885845" transform="rotate(0, 7.87138142574094, 7.72084474885845)" fill="black">30</text>
#> <text x="9.65273179919274" y="7.72084474885845" transform="rotate(0, 9.65273179919274, 7.72084474885845)" fill="black">35</text>
#> <text x="4.93716133942161" y="7.92389649923896" transform="rotate(0, 4.93716133942161, 7.92389649923896)" fill="black">mpg</text>
#> <text x="0.241103500761035" y="4.10378310502283" transform="rotate(-90, 0.241103500761035, 4.10378310502283)" fill="black">wt</text>
#> </svg>

Open the output in an SVG viewer

txt <- readLines("svg/test-draw.svg")
htmltools::HTML(txt)

2345101520253035mpgwt

Next steps

This plot output doesn’t look that great because we cut a lot of corners to get here; this includes:

  • no clipping support
  • no support for different colours for lines, points or filling. If you review the code you’ll see that all line strokes are set to black, and only circles are filled.
  • since strWidth and metricInfo aren’t supported yet, the drawing system really doesn’t know how to position the fonts well, or how to leave space for them near other objects.