Superscript and subscript in rgl

Question

I want to create labels in an rgl plot that have subscripts and superscripts using text3d.

open3d(windowRect=c(500,500,1000,1000))
text3d(0, 0, 0, expression(CO[2]))

produces an image that looks like this:

And,

open3d(windowRect=c(500,500,1000,1000)) 
text3d(0, 0, 0, bquote("CO"[2]))

Produces

Any way to get subscripts / superscripts in rgl?

Answer 1

Not really. Base graphics has a whole "plotmath" infrastructure to parse those expressions and turn them into plot commands. rgl doesn't make use of that at all.

I don't think the plotmath code is available outside base graphics, so the only possibilities are kind of ugly:

• Display 2D graphics as a bitmap in a 3D scene (see ?show2d or ?sprites3d).

• Write a base graphics driver (or piggyback on an existing one) to grab what comes out of plotmath, and redo it in rgl. This would be useful for other things, but is hard.

Edited to add:

Here's a second attempt at doing it with sprites. It can still be tweaked to be better:

• sprites get resized in the scene, whereas text normally doesn't. (Maybe that's a feature, not a bug.) You'll likely need to play with the cex setting to get what you want.

• there's no support for putting the text in the margin, as you'd want for a label. Take a look at the mtext3d function to do that.

• it now supports multiple elements in text.

• it now has an adj parameter, that should behave like text3d

• it still hasn't had much testing.

Anyway, it's a start. If you think of improvements, please post them.

plotmath3d <- function(x, y = NULL, z = NULL,
               text, 
               cex = par("cex"), adj = par("adj"),
               startsize = 480,
               ...) {
  xyz <- xyz.coords(x, y, z)
  n <- length(xyz$x)
  if (is.vector(text))
    text <- rep(text, length.out = n)
  cex <- rep(cex, length.out = n)
  adj <- c(adj, 0.5, 0.5)[1:2]
  save <- par3d(skipRedraw = TRUE)
  on.exit(par3d(save))
  for (i in seq_len(n)) {
    # The first device is to measure it.  
    f <- tempfile(fileext = ".png")
    png(f, bg = "transparent", width = startsize, height = startsize)
    par(mar = c(0, 0, 0, 0), xaxs = "i", xaxt = "n",  
        yaxs = "i", yaxt = "n",
        usr = c(0, 1, 0, 1))
    plot.new()
    if (is.vector(text))
      thistext <- text[i]
    else
      thistext <- text
    w <- strwidth(thistext, cex = 5, ...)*(2*abs(adj[1] - 0.5) + 1)
    h <- strheight(thistext, cex = 5, ...)*(2*abs(adj[2] - 0.5) + 1)
    dev.off()

    # Now make a smaller bitmap and draw it
    expand <- 1.5
    size <- round(expand*startsize*max(w, h))
    png(f, bg = "transparent", width = size, height = size)
    par(mar = c(0, 0, 0, 0), xaxs = "i", xaxt = "n", 
        yaxs = "i", yaxt = "n",
        usr = c(0, 1, 0, 1))
    plot.new()
    text(0.5, 0.5, thistext, adj = adj, cex = 5, ...)
    dev.off()

    with(xyz, sprites3d(x[i], y[i], z[i], texture = f, textype = "rgba", 
            col = "white", lit = FALSE, radius = cex[i]*size/100))
  }
}