add variable font support to glyph rendering

git-svn-id: https://svn.r-project.org/R/trunk@88293 00db46b3-68df-0310-9c12-caf00c1e9a41

Author: murrell

doc/NEWS.Rd

@@ -49,6 +49,21 @@
     }
   }
 
+  \subsection{GRAPHICS}{
+    \itemize{
+      \item The graphics engine version, \code{R_GE_version}, has been
+      bumped to \code{17} and so packages that provide graphics devices
+      should be reinstalled.
+
+      The \code{glyphFont()} function gains a \code{variations}
+      argument, which allows variable font axes to be specified,
+      e.g., \code{c(wght=100)}.
+
+      Only Cairo-based graphics devices (but not \code{cairo_pdf()})
+      support variable font axes so far.
+    }
+  }
+  
   \subsection{INSTALLATION}{
     \itemize{
       \item .

src/include/R_ext/GraphicsEngine.h

@@ -88,13 +88,16 @@ extern "C" {
  * Version 16: For R 4.3.0
  *             Added more advanced typesetting
  *             - glyphs
+ * Version 17: For R 4.6.0
+ *             - variable fonts
  */
 #define R_GE_definitions 13
 #define R_GE_deviceClip  14
 #define R_GE_group       15
 #define R_GE_glyphs      16
+#define R_GE_fontVar     17
 
-#define R_GE_version R_GE_glyphs
+#define R_GE_version R_GE_fontVar
 
 int R_GE_getVersion(void);
 
@@ -662,6 +665,7 @@ int R_GE_maskType(SEXP mask);
 #define R_GE_capability_transformations      10
 #define R_GE_capability_paths                11 
 #define R_GE_capability_glyphs               12 
+#define R_GE_capability_variableFonts        13 
 
 /* Must match order in ../library/grDevices/R/glyph.R */
 #define R_GE_text_style_normal  1
@@ -686,6 +690,10 @@ const char* R_GE_glyphFontFamily(SEXP glyphFont);
 double R_GE_glyphFontWeight(SEXP glyphFont);
 int R_GE_glyphFontStyle(SEXP glyphFont);
 const char* R_GE_glyphFontPSname(SEXP glyphFont);
+int R_GE_glyphFontNumVar(SEXP glyphFont);
+const char* R_GE_glyphFontVarAxis(SEXP glyphFont, int index);
+double R_GE_glyphFontVarValue(SEXP glyphFont, int index);
+const char* R_GE_glyphFontVarFormatted(SEXP glyphFont, int index);
 
 void GEGlyph(int n, int *glyphs, double *x, double *y, 
              SEXP font, double size, 

src/library/grDevices/NAMESPACE

@@ -9,9 +9,9 @@ export(Hershey, adjustcolor, as.graphicsAnnot, as.raster, axisTicks,
        dev.copy, dev.copy2eps, dev.copy2pdf, dev.cur, dev.hold,
        dev.flush, dev.interactive, dev.list, dev.new, dev.next,
        dev.off, dev.prev, dev.print, dev.set, dev.size, dev2bitmap,
-       deviceIsInteractive, embedFonts, embedGlyphs, extendrange, 
+       deviceIsInteractive, embedFonts, embedGlyphs, extendrange,
        getGraphicsEvent, getGraphicsEventEnv,
-       glyphInfo, glyphAnchor, glyphFont, glyphFontList,
+       glyphInfo, glyphAnchor, glyphFont, glyphFontList, glyphFontVariation,
        glyphWidth, glyphHeight, glyphWidthLeft, glyphHeightBottom, glyphJust,
        graphics.off, gray, grey, gray.colors,
        grSoftVersion, grey.colors, heat.colors, hsv, hcl, hcl.colors, hcl.pals,
@@ -71,6 +71,8 @@ S3method("glyphJust", "character")
 S3method("glyphJust", "numeric")
 S3method("glyphJust", "GlyphJust")
 
+S3method("print", "FontVariation")
+
 if(tools:::.OStype() == "windows") {
     export(bringToTop, msgWindow, win.graph, win.metafile, win.print,
            windows, windows.options, windowsFont, windowsFonts)

src/library/grDevices/R/device.R

@@ -358,7 +358,7 @@ dev.capture <- function(native = FALSE) .External(C_devcapture, native)
 
 dev.capabilities <- function(what = NULL)
 {
-    ncap <- 13
+    ncap <- 14
     template <- vector("list", ncap)
     capabilities <- .External(C_devcap, template)
     ## The device may have filled in some capabilities so check it is still
@@ -381,7 +381,8 @@ dev.capabilities <- function(what = NULL)
                   "compositing",
                   "transformations",
                   "paths",
-                  "glyphs")
+                  "glyphs",
+                  "variableFonts")
     z[[1L]] <- c(NA, FALSE, TRUE)[capabilities[[1L]] + 1L]
     z[[2L]] <- c(NA, "no", "fully", "semi")[capabilities[[2L]] + 1L]
     z[[3L]] <- c(NA, "no", "yes", "non-missing")[capabilities[[3L]] + 1L]
@@ -439,6 +440,11 @@ dev.capabilities <- function(what = NULL)
         z[[13]] <- NA
     else 
         z[[13]] <- as.logical(capabilities[[13]])
+    ## VariableFonts
+    if (is.na(capabilities[[14]]))
+        z[[14]] <- NA
+    else 
+        z[[14]] <- as.logical(capabilities[[14]])
 
     if (!is.null(what)) z[charmatch(what, names(z), 0L)] else z
 }

src/library/grDevices/R/glyph.R

@@ -113,9 +113,72 @@ glyphJust.numeric <- function(just, which=NULL, ...) {
 
 ################################################################################
 ## glyph font
+
+standardAxes <- c("wght", "wdth", "ital", "slnt", "opsz")
+standardAxisMin <- c(wght=1, wdth=0, ital=0, slnt=-90, opsz=0)
+standardAxisMax <- c(wght=1000, wdth=Inf, ital=1, slnt=90, opsz=Inf)
+
+checkAxisCase <- function(axis, registered) {
+    if (any(registered) &&
+        (!all(tolower(axis[registered]) == axis[registered]))) {
+        warning("Registered axis names must be lower case")
+    }
+    if (any(!registered) &&
+        (!all(toupper(axis[!registered]) == axis[!registered]))) {
+        warning("Custom axis names must be upper case")
+    }
+}
+
+checkAxisRange <- function(axis, value) {
+    low <- value < standardAxisMin[axis]
+    high <- value > standardAxisMax[axis] 
+    if (any(low) || any(high)) {
+        warning("Axis value(s) out of range: ",
+                paste(paste0(axis[low|high], "=", value[low|high]),
+                      collapse="; "))
+    }
+}
+
+fontVariation <- function(axis, value) {
+    if (!length(axis)) {
+        stop("No axes specified")
+    }
+    if (!is.character(axis) || any(is.na(axis)) || any(nchar(axis) != 4)||
+        any(grepl("[^a-zA-Z]", axis))) {
+        stop("Axis names must 4 ASCII letters long")
+    }
+    if (!is.numeric(value) || any(is.na(value))) {
+        stop("Axis values must be numeric")
+    }
+    registered <- tolower(axis) %in% standardAxes
+    checkAxisCase(axis, registered)
+    if (any(registered)) {
+        checkAxisRange(tolower(axis[registered]), value[registered])
+    }
+    variant <- value
+    names(variant) <- axis
+    attr(variant, "formatted") <- paste(axis, value, sep="=")
+    attr(variant, "registered") <- registered
+    class(variant) <- "FontVariation"
+    variant
+}
+
+glyphFontVariation <- function(...) {
+    values <- c(...)
+    axes <- names(values)
+    fontVariation(axes, values)
+}
+
+print.FontVariation <- function(x, ...) {
+    names <- names(x)
+    attributes(x) <- NULL
+    names(x) <- names
+    print(unclass(x))
+}
+
 glyphFont <- function(file, index,
                       family, weight, style,
-                      PSname=NA) {
+                      PSname=NA, variations=NULL) {
     file <- as.character(file)
     nafile <- is.na(file)
     if (any(nchar(file[!nafile], "bytes") > 500))
@@ -151,17 +214,31 @@ glyphFont <- function(file, index,
     names <- rle(PSname)$lengths
     if (!(all(families == files) && all(files == names)))
         stop("Font information is inconsistent")
-    
+    if (!is.null(variations)) {
+        if (!inherits(variations, "FontVariation")) {
+            variations <- do.call(glyphFontVariation, as.list(variations))
+        }
+    }
+
     font <- list(file=file, index=index,
                  family=family, weight=weight, style=style,
-                 PSname=PSname)
+                 PSname=PSname, variations=variations)
     class(font) <- "RGlyphFont"
     font
 }
 
 print.RGlyphFont <- function(x, ...) {
-    cat(paste0(x$family, " wgt: ", x$weight, " style: ", invertStyle(x$style),
-               "\n  (", x$file, " [", x$index, "])\n"))
+    format <- paste0(x$family, " wgt: ", x$weight,
+                     " style: ", invertStyle(x$style),
+                     "\n  (", x$file, " [", x$index, "]")
+    if (!is.null(x$variations)) {
+        format <- paste0(format,
+                        " [",
+                        paste(paste0(names(x$variations), "=", x$variations),
+                              collapse="; "),
+                        "]")
+    }
+    cat(format, ")\n")
 }
 
 glyphFontList <- function(...) {

src/library/grDevices/man/glyphInfo.Rd

@@ -7,6 +7,7 @@
 \name{glyphInfo}
 \alias{glyphInfo}
 \alias{glyphFont}
+\alias{glyphFontVariation}
 \alias{glyphFontList}
 \alias{glyphAnchor}
 \alias{glyphWidth}
@@ -29,7 +30,8 @@ glyphInfo(id, x, y, font, size, fontList,
           width, height, hAnchor, vAnchor,
           col=NA, rot=0)
 
-glyphFont(file, index, family, weight, style, PSname=NA)
+glyphFont(file, index, family, weight, style, PSname=NA, variations=NULL)
+glyphFontVariation(...)
 glyphFontList(...)
 glyphAnchor(value, label)
 glyphWidth(w, label="width", left="left")
@@ -70,13 +72,19 @@ glyphJust(just, ...)
   \item{style}{Character style of glyphs (\code{"normal"}, \code{"italic"},
     or \code{"oblique"}).}
   \item{PSname}{The PostScript name for each font. Can be \code{NA}.}
+  \item{variations}{Axis coordinate settings for variable fonts.  Either
+    \code{NULL}, or a call to \code{glyphFontVariation()}, or a named vector,
+    or a named list.}
   \item{value, w, h}{A numeric value.}
   \item{label, left, bottom}{A character value.}
   \item{just}{A justification value. Either a character value like
     \code{"left"} or a numeric value like \code{0}.}
   \item{which}{When \code{x} is numeric, a character value identifying
     which width metric the numeric value is relative to.}
-  \item{\dots}{Further arguments passed to other methods.}
+  \item{\dots}{For \code{glyphFontList()}, one or more
+    \code{glyphFont()}s. For \code{glyphFontVar()}, one or more named
+    numeric values (see Details). Otherwise, further arguments passed to
+    other methods.}
 }
 \value{
   The result from \code{glyphInfo()} is an \code{"RGlyphInfo"} object,
@@ -130,6 +138,12 @@ glyphJust(just, ...)
   \code{glyphWidthLeft()} and \code{glyphWidthHeight()} provide
   an API for code that needs to access the relevant anchors for
   width and height metrics.
+
+  \code{glyphFontVariation()} accepts arguments of the form \code{wght=100}.
+  Every argument should be named, each name should be 4 ASCII characters
+  long, each name should be either one of the standard axes
+  (wght, slnt, wdth, ital, opsz), in lowercase, otherwise (if a
+  custom axis) in uppercase.  Every argument value should be numeric.
 }
 \section{Warning}{
   Any glyph with \code{NA} in any of \code{id}, \code{x}, \code{y}, 

src/library/grDevices/src/cairo/cairoBM.c

@@ -553,7 +553,7 @@ BMDeviceDriver(pDevDesc dd, int kind, SEXP filename,
     dd->startfont = 1;
     dd->startgamma = 1;
     dd->displayListOn = FALSE;
-    dd->deviceVersion = R_GE_glyphs;
+    dd->deviceVersion = R_GE_fontVar;
 
     dd->deviceSpecific = (void *) xd;