Example code of text on path

text_curved.R

library(grid)
library(scales)
library(textshaping)

label <- "Here be some text on a path"

# Setup some curve
t <- seq(10, 0, by = -0.05)
curve <- data.frame(
  x = t * cos(t), y = t * sin(t)
)
x <- rescale(curve$x, from = c(min(curve$x, curve$y) - 1, 
                               max(curve$y, curve$x)) + 1)
y <- rescale(curve$y, from = c(min(curve$x, curve$y) - 1, 
                               max(curve$x, curve$y)) + 1)

# Make use of the `grid::makeContent()` trick to get units in plot space rather
# than units in data-space
makeContent.textpathGrob <- function(x) {
  # Get device dots per inch
  dpi <- convertUnit(unit(1, "inch"), "pt", valueOnly = TRUE)

  # Convert to absolute units
  curve_x   <- convertX(x$x, "inch", valueOnly = TRUE)
  curve_y   <- convertY(x$y, "inch", valueOnly = TRUE)
  curve_len <- sum(sqrt(diff(curve_x)^2 + diff(curve_y)^2))

  # Calculate angles
  angle <- atan2(diff(curve_y, 2), diff(curve_x, 2))
  angle <- angle[c(1, seq_along(angle), length(angle))]

  # Measure text shape
  gp <- x$gp
  shape <- shape_text(x$label, res = dpi, size = gp$fontsize, family = gp$fontfamily)
  metrics <- shape$metrics
  shape   <- shape$shape

  # Convert dimensions to inches
  height <- metrics$height - metrics$top_bearing - metrics$bottom_bearing
  height <- height / dpi * (-0.5 + x$vjust)
  width  <- metrics$width  / dpi * 0.5
  mid    <- (shape$x_offset + shape$x_midpoint) / dpi

  # Calculate offset
  off_x <- height * cos(angle + pi / 2) + curve_x
  off_y <- height * sin(angle + pi / 2) + curve_y
  dist  <- c(0, cumsum(sqrt(diff(off_x)^2 + diff(off_y)^2)))
  hjust <- rescale(x$hjust, to = c(width, max(dist) - width),
                   from = c(0, 1)) - width

  # Grab letters and calculate positions
  letters <- unlist(strsplit(x$label, split = character(0)), FALSE, FALSE)
  pos_x   <- approx(dist, off_x, mid + hjust)$y
  pos_y   <- approx(dist, off_y, mid + hjust)$y
  pos_ang <- approx(dist, angle, mid + hjust)$y

  # Output grob
  textGrob(
    label = letters,
    x = unit(pos_x, "inch"), y = unit(pos_y, "inch"),
    rot = pos_ang * 180 / pi, hjust = 0.5, vjust = 0.5,
    gp = x$gp
  )
}

textpathGrob <- function(
  label,
  x = unit(0.5, "npc"), y = unit(0.5, "npc"),
  just = "centre", hjust = NULL, vjust = NULL,
  default.units = "npc", name = NULL,
  gp = gpar(), vp = NULL
) {
  if (!is.unit(x))
    x <- unit(x, default.units)
  if (!is.unit(y))
    y <- unit(y, default.units)

  hjust <- resolveHJust(just, hjust)
  vjust <- resolveVJust(just, vjust)

  # Replace absent fontsize / fontfamily
  gp_default <- get.gpar()
  if (is.null(gp$fontsize)) {
    gp$fontsize <- gp_default$fontsize
  }
  if (is.null(gp$fontfamily)) {
    gp$fontfamily <- gp_default$fontfamily
  }

  grob(
    label = label,
    x = x, y = y,
    hjust = hjust, vjust = vjust,
    name = name, gp = gp, vp = vp,
    cl = "textpathGrob"
  )
}


# Curve
pth <- polylineGrob(
  x = x, y = y
)

# Text on curve
grb <- textpathGrob(
  x = x, y = y,
  label = label,
  vjust = 1, hjust = 0.5
)


grid.newpage(); grid.draw(pth); grid.draw(grb)

Narrow aspect ratio:

Wide aspect ratio: