Rewrite of shape_text backend (#40)

DESCRIPTION

@@ -17,6 +17,7 @@ BugReports: https://github.com/r-lib/textshaping/issues
 Depends: 
     R (>= 3.2.0)
 Imports:
+    lifecycle,
     systemfonts (>= 1.0.0)
 Suggests: 
     covr,
@@ -29,5 +30,6 @@ VignetteBuilder:
     knitr
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.1
 SystemRequirements: freetype2, harfbuzz, fribidi
+Remotes: r-lib/systemfonts

NAMESPACE

@@ -3,6 +3,8 @@
 export(get_font_features)
 export(shape_text)
 export(text_width)
-importFrom(systemfonts,match_font)
+importFrom(lifecycle,deprecated)
+importFrom(systemfonts,font_feature)
+importFrom(systemfonts,match_fonts)
 importFrom(systemfonts,system_fonts)
 useDynLib(textshaping, .registration = TRUE)

NEWS.md

@@ -1,11 +1,7 @@
 # textshaping (development version)
 
-* Fixed height calculation in `shape_text()` to avoid an extra line of height
-* Fixed width calculation in `shape_text()` to ignore width of terminal 
-  line-break characters
-* Added `'justified'` and `'distributed'` options to `align` in `shape_text()`
-  to either expand spaces to fit line width to full width, or distribute all 
-  glyphs to fit line width to full width
+* Full rewrite of `shape_text()` to allow proper font-fallback, bidi text
+  support, support for font-features, spacers, new align settings, etc.
 
 # textshaping 0.3.7
 

R/cpp11.R

@@ -4,8 +4,8 @@ get_face_features_c <- function(path, index) {
   .Call(`_textshaping_get_face_features_c`, path, index)
 }
 
-get_string_shape_c <- function(string, id, path, index, size, res, lineheight, align, hjust, vjust, width, tracking, indent, hanging, space_before, space_after) {
-  .Call(`_textshaping_get_string_shape_c`, string, id, path, index, size, res, lineheight, align, hjust, vjust, width, tracking, indent, hanging, space_before, space_after)
+get_string_shape_c <- function(string, id, path, index, features, size, res, lineheight, align, hjust, vjust, width, tracking, indent, hanging, space_before, space_after) {
+  .Call(`_textshaping_get_string_shape_c`, string, id, path, index, features, size, res, lineheight, align, hjust, vjust, width, tracking, indent, hanging, space_before, space_after)
 }
 
 get_line_width_c <- function(string, path, index, size, res, include_bearing) {

R/font_features.R

@@ -9,7 +9,7 @@
 #' @return A list with an element for each of the input fonts containing the
 #' supported feature tags for that font.
 #'
-#' @importFrom systemfonts match_font
+#' @importFrom systemfonts match_fonts
 #' @export
 #'
 #' @examples
@@ -24,18 +24,13 @@ get_font_features <- function(family = '', italic = FALSE, bold = FALSE,
                               path = NULL, index = 0) {
   if (is.null(path)) {
     full_length <- max(length(family), length(italic), length(bold))
-    if (full_length == 1) {
-      loc <- match_font(family, italic, bold)
-      path <- loc$path
-      index <- loc$index
-    } else {
-      family <- rep_len(family, full_length)
-      italic <- rep_len(italic, full_length)
-      bold <- rep_len(bold, full_length)
-      loc <- Map(match_font, family = family, italic = italic, bold = bold)
-      path <- vapply(loc, `[[`, character(1L), 1, USE.NAMES = FALSE)
-      index <- vapply(loc, `[[`, integer(1L), 2, USE.NAMES = FALSE)
-    }
+    fonts <- match_fonts(
+      rep_len(family, full_length),
+      rep_len(italic, full_length),
+      ifelse(rep_len(bold, full_length), "bold", "normal")
+    )
+    path <- fonts$path
+    index <- fonts$index
   } else {
     full_length <- max(length(path), length(index))
     path <- rep_len(path, full_length)

R/shape_text.R

@@ -12,12 +12,17 @@
 #' @param strings A character vector of strings to shape
 #' @param id A vector grouping the strings together. If strings share an id the
 #' shaping will continue between strings
-#' @inheritParams systemfonts::font_info
+#' @inheritParams systemfonts::match_fonts
+#' @param features A [systemfonts::font_feature()] object or a list of them,
+#' giving the OpenType font features to set
+#' @param size The size in points to use for the font
+#' @param res The resolution to use when doing the shaping. Should optimally
+#' match the resolution used when rendering the glyphs.
 #' @param lineheight A multiplier for the lineheight
 #' @param align Within text box alignment, either `'left'`, `'center'`, `'right'`,
-#' `'justified'`, or `'distributed'`
+#' `'justified-left'`, `'justified-right'`, `'justified-center'`, or `'distributed'`
 #' @param hjust,vjust The justification of the textbox surrounding the text
-#' @param width The requested with of the string in inches. Setting this to
+#' @param max_width The requested with of the string in inches. Setting this to
 #' something other than `NA` will turn on word wrapping.
 #' @param tracking Tracking of the glyphs (space adjustment) measured in 1/1000
 #' em.
@@ -61,6 +66,7 @@
 #' }
 #'
 #' @export
+#' @importFrom systemfonts font_feature match_fonts
 #'
 #' @examples
 #' string <- "This is a long string\nLook; It spans multiple lines\nand all"
@@ -78,10 +84,11 @@
 #' shape_text(string, id = c(1, 1, 1), size = c(12, 24, 12))
 #'
 shape_text <- function(strings, id = NULL, family = '', italic = FALSE,
-                       bold = FALSE, size = 12, res = 72, lineheight = 1,
-                       align = 'left', hjust = 0, vjust = 0, width = NA,
-                       tracking = 0, indent = 0, hanging = 0, space_before = 0,
-                       space_after = 0, path = NULL, index = 0) {
+                       weight = 'normal', width = 'normal', features = font_feature(),
+                       size = 12, res = 72, lineheight = 1, align = 'left',
+                       hjust = 0, vjust = 0, max_width = NA, tracking = 0,
+                       indent = 0, hanging = 0, space_before = 0, space_after = 0,
+                       path = NULL, index = 0, bold = deprecated()) {
   n_strings = length(strings)
   if (is.null(id)) id <- seq_len(n_strings)
   id <- rep_len(id, n_strings)
@@ -93,62 +100,72 @@ shape_text <- function(strings, id = NULL, family = '', italic = FALSE,
   id <- id[ido]
   strings <- as.character(strings)[ido]
 
+  if (lifecycle::is_present(bold)) {
+    lifecycle::deprecate_soft("0.4.0", "shape_text(bold)", "shape_text(weight='bold')")
+    weight <- ifelse(bold, "bold", "normal")
+  }
+
+  if (inherits(features, 'font_feature')) features <- list(features)
+  features <- rep_len(features, n_strings)
+
   if (is.null(path)) {
-    if (all(c(length(family), length(italic), length(bold)) == 1)) {
-      loc <- systemfonts::match_font(family, italic, bold)
-      path <- loc$path
-      index <- loc$index
-    } else {
-      family <- rep_len(family, n_strings)
-      italic <- rep_len(italic, n_strings)
-      bold <- rep_len(bold, n_strings)
-      loc <- Map(systemfonts::match_font, family = family, italic = italic, bold = bold)
-      path <- vapply(loc, `[[`, character(1L), 1, USE.NAMES = FALSE)[ido]
-      index <- vapply(loc, `[[`, integer(1L), 2, USE.NAMES = FALSE)[ido]
-    }
+    family <- rep_len(family, n_strings)
+    italic <- rep_len(italic, n_strings)
+    weight <- rep_len(weight, n_strings)
+    width <- rep_len(width, n_strings)
+    loc <- match_fonts(family, italic, weight, width)
+    path <- loc$path[ido]
+    index <- loc$index[ido]
+    features <- Map(c, loc$features, features)[ido]
   } else {
-    if (!all(c(length(path), length(index)) == 1)) {
-      path <- rep_len(path, n_strings)[ido]
-      index <- rep_len(index, n_strings)[ido]
-    }
+    path <- rep_len(path, n_strings)[ido]
+    index <- rep_len(index, n_strings)[ido]
+    features <- features[ido]
   }
-  if (length(size) != 1) size <- rep_len(size, n_strings)[ido]
-  if (length(res) != 1) res <- rep_len(res, n_strings)[ido]
-  if (length(lineheight) != 1) lineheight <- rep_len(lineheight, n_strings)[ido]
-  align <- match.arg(align, c('left', 'center', 'right', 'justified', 'distributed'), TRUE)
-  align <- match(align, c('left', 'center', 'right', 'justified', 'distributed'))
-  if (length(align) != 1) align <- rep_len(align, n_strings)[ido]
-  if (length(hjust) != 1) hjust <- rep_len(hjust, n_strings)[ido]
-  if (length(vjust) != 1) vjust <- rep_len(vjust, n_strings)[ido]
-  if (length(width) != 1) width <- rep_len(width, n_strings)[ido]
-  width[is.na(width)] <- -1
-  if (length(tracking) != 1) tracking <- rep_len(tracking, n_strings)[ido]
-  if (length(indent) != 1) indent <- rep_len(indent, n_strings)[ido]
-  if (length(hanging) != 1) hanging <- rep_len(hanging, n_strings)[ido]
-  if (length(space_before) != 1) space_before <- rep_len(space_before, n_strings)[ido]
-  if (length(space_after) != 1) space_after <- rep_len(space_after, n_strings)[ido]
+  size <- rep_len(size, n_strings)[ido]
+  res <- rep_len(res, n_strings)[ido]
+  lineheight <- rep_len(lineheight, n_strings)[ido]
+  align <- match.arg(align, c('left', 'center', 'right', 'justified-left', 'justified-center', 'justified-right', 'distributed'), TRUE)
+  align <- match(align, c('left', 'center', 'right', 'justified-left', 'justified-center', 'justified-right', 'distributed'))
+  align <- rep_len(align, n_strings)[ido]
+  hjust <- rep_len(hjust, n_strings)[ido]
+  vjust <- rep_len(vjust, n_strings)[ido]
+  max_width <- rep_len(max_width, n_strings)[ido]
+  max_width[is.na(max_width)] <- -1
+  tracking <- rep_len(tracking, n_strings)[ido]
+  indent <- rep_len(indent, n_strings)[ido]
+  hanging <- rep_len(hanging, n_strings)[ido]
+  space_before <- rep_len(space_before, n_strings)[ido]
+  space_after <- rep_len(space_after, n_strings)[ido]
 
-  width <- width * res
+  max_width <- max_width * res
+  tracking <- tracking * res
   indent <- indent * res
   hanging <- hanging * res
+  space_before <- space_before * res / 72
+  space_after <- space_after * res / 72
+
 
   if (!all(file.exists(path))) stop("path must point to a valid file", call. = FALSE)
   shape <- get_string_shape_c(
-    strings, id, path, as.integer(index), as.numeric(size), as.numeric(res),
-    as.numeric(lineheight), as.integer(align) - 1L, as.numeric(hjust),
-    as.numeric(vjust), as.numeric(width), as.numeric(tracking),
+    strings, id, path, as.integer(index), features, as.numeric(size),
+    as.numeric(res), as.numeric(lineheight), as.integer(align) - 1L,
+    as.numeric(hjust), as.numeric(vjust), as.numeric(max_width), as.numeric(tracking),
     as.numeric(indent), as.numeric(hanging), as.numeric(space_before),
     as.numeric(space_after)
   )
   if (nrow(shape$shape) == 0) return(shape)
 
   shape$metrics$string <- vapply(split(strings, id), paste, character(1), collapse = '')
-  shape$shape$string_id <- ido[shape$shape$string_id]
+  shape$metrics[-1] <- lapply(shape$metrics[-1], function(x) x * 72 / res[!duplicated(id)])
+
+  shape$shape$string_id <- ido[(cumsum(c(0, rle(id)$lengths)) + 1)[shape$shape$metric_id] + shape$shape$string_id - 1]
   shape$shape <- shape$shape[order(shape$shape$string_id), , drop = FALSE]
-  #shape$shape$glyph <- intToUtf8(shape$shape$glyph, multiple = TRUE)
-  shape$shape$x_offset <- shape$shape$x_offset * (72 / res)
-  shape$shape$y_offset <- shape$shape$y_offset * (72 / res)
-  shape$shape$x_midpoint <- shape$shape$x_midpoint * (72 / res)
+  shape$shape$x_offset <- shape$shape$x_offset * (72 / res[shape$shape$string_id])
+  shape$shape$y_offset <- shape$shape$y_offset * (72 / res[shape$shape$string_id])
+  shape$shape$advance <- shape$shape$advance * (72 / res[shape$shape$string_id])
+  shape$shape$ascender <- shape$shape$ascender * (72 / res[shape$shape$string_id])
+  shape$shape$descender <- shape$shape$descender * (72 / res[shape$shape$string_id])
   shape
 }
 #' Calculate the width of a string, ignoring new-lines
@@ -167,6 +184,7 @@ shape_text <- function(strings, id = NULL, family = '', italic = FALSE,
 #' provided `res` value to convert it into absolute values.
 #'
 #' @export
+#' @importFrom systemfonts match_fonts
 #'
 #' @examples
 #' strings <- c('A short string', 'A very very looong string')
@@ -177,18 +195,13 @@ text_width <- function(strings, family = '', italic = FALSE, bold = FALSE,
                        index = 0) {
   n_strings <- length(strings)
   if (is.null(path)) {
-    if (all(c(length(family), length(italic), length(bold)) == 1)) {
-      loc <- systemfonts::match_font(family, italic, bold)
-      path <- loc$path
-      index <- loc$index
-    } else {
-      family <- rep_len(family, n_strings)
-      italic <- rep_len(italic, n_strings)
-      bold <- rep_len(bold, n_strings)
-      loc <- Map(systemfonts::match_font, family = family, italic = italic, bold = bold)
-      path <- vapply(loc, `[[`, character(1L), 1, USE.NAMES = FALSE)
-      index <- vapply(loc, `[[`, integer(1L), 2, USE.NAMES = FALSE)
-    }
+    fonts <- match_fonts(
+      rep_len(family, n_strings),
+      rep_len(italic, n_strings),
+      ifelse(rep_len(bold, n_strings), "bold", "normal")
+    )
+    path <- fonts$path
+    index <- fonts$index
   } else {
     if (!all(c(length(path), length(index)) == 1)) {
       path <- rep_len(path, n_strings)

R/textshaping-package.R

@@ -4,7 +4,8 @@
 # The following block is used by usethis to automatically manage
 # roxygen namespace tags. Modify with care!
 ## usethis namespace: start
-#' @useDynLib textshaping, .registration = TRUE
+#' @importFrom lifecycle deprecated
 #' @importFrom systemfonts system_fonts
+#' @useDynLib textshaping, .registration = TRUE
 ## usethis namespace: end
 NULL