remove graphics device restrictions

r-lib · Jan 16, 2025 · e36af11 · e36af11
1 parent aa0eb68
commit e36af11
Show file tree

Hide file tree

Showing 13 changed files with 129 additions and 100 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -24,7 +24,7 @@ Imports:
     jpeg,
     png,
     rlang (>= 1.1.0),
-    systemfonts (>= 1.1.0),
+    systemfonts (>= 1.1.0.9000),
     textshaping (>= 0.4.1.9000),
     utils,
     vctrs
@@ -43,5 +43,6 @@ BugReports: https://github.com/r-lib/marquee/issues
 Config/Needs/website: tidyverse/tidytemplate
 VignetteBuilder: knitr
 Config/testthat/edition: 3
-Remotes:
-    r-lib/textshaping
+Remotes: 
+    r-lib/textshaping,
+    r-lib/systemfonts
diff --git a/NEWS.md b/NEWS.md
@@ -1,15 +1,17 @@
 # marquee (development version)
 
-* Fixed a bug in bullet placement that affected tight lists with multiple spans 
+* Fixed a bug in bullet placement that affected tight lists with multiple spans
   (#18)
-* code spans gains a slight horizontal padding to let the background breathe a 
-  bit. Currently padding around spans doesn't affect shaping (i.e. it doesn't 
+* code spans gains a slight horizontal padding to let the background breathe a
+  bit. Currently padding around spans doesn't affect shaping (i.e. it doesn't
   move text further from it's neighbors).
 * Better adherence to margin collapsing rules of CSS. Any background or border
   will now prevent further collapsing
-* Add `force_body_margin` argument to enforce that the body margin is not 
-  influenced by collapsing (allowing you to turn it off completely). This 
+* Add `force_body_margin` argument to enforce that the body margin is not
+  influenced by collapsing (allowing you to turn it off completely). This
   setting is turned on for `geom_marquee()` and `element_marquee()` (#23)
+* Add support for rendering on graphics devices that doesn't support the new
+  `glyphs` capabilities
 
 # marquee 0.1.0
 

diff --git a/R/element_marquee.R b/R/element_marquee.R
@@ -28,7 +28,7 @@
 #'
 #' @export
 #'
-#' @examplesIf utils::packageVersion("base") > "4.3" && rlang::is_installed("ggplot2")
+#' @examplesIf rlang::is_installed("ggplot2")
 #' library(ggplot2)
 #' p <- ggplot(mtcars) +
 #'   geom_point(aes(mpg, disp)) +
@@ -142,7 +142,7 @@ on_load({
 #'
 #' @export
 #'
-#' @examplesIf utils::packageVersion("base") > "4.3" && rlang::is_installed("ggplot2")
+#' @examplesIf rlang::is_installed("ggplot2")
 #' library(ggplot2)
 #' ggplot(mtcars) +
 #'   geom_point(aes(disp, mpg)) +

diff --git a/R/geom_marquee.R b/R/geom_marquee.R
@@ -30,7 +30,7 @@
 #'
 #' @export
 #'
-#' @examplesIf utils::packageVersion("base") > "4.3" && rlang::is_installed("ggplot2")
+#' @examplesIf rlang::is_installed("ggplot2")
 #'
 #' library(ggplot2)
 #' # Standard use

diff --git a/R/grob.R b/R/grob.R
@@ -33,6 +33,16 @@
 #' @return A grob of class `marquee`
 #'
 #' @details
+#' # Rendering
+#' marquee is first and foremost developed with the new 'glyph' rendering
+#' features in 4.3.0 in mind. However, not all graphics devices supports this,
+#' and while some might eventually do, it is quite concievable that some never
+#' will. Because of this, marquee has a fallback where it will render text as a
+#' mix of polygons and rasters (depending on the font in use) if the device
+#' doesn't report 'glyphs' capabilities. The upside is that it works (almost)
+#' everywhere, but the downside is that the fallback is much slower and with
+#' poorer visual quality. Because of this it is advisable to use a modern
+#' graphics device with glyphs support if at all possible.
 #'
 #' # Rendering style
 #' The rendering more or less adheres to the styling provided by
@@ -249,12 +259,6 @@ marquee_grob <- function(text, style = classic_style(), ignore_html = TRUE,
 
 #' @export
 makeContext.marquee_grob <- function(x) {
-  if (grepl("quartz", names(grDevices::dev.cur())) && utils::packageVersion("grDevices") < package_version("4.4.2")) {
-    cli::cli_abort(c(
-      "The graphics device in use contains a bug that crashes R, when used with modern text features",
-      i = "Consider using the graphics devices provided by the ragg package instead"
-    ))
-  }
   # Everything is calculated in bigpts (1 inch == 72 bigpts)
   # We inspect the angle, if it is more vertical we use the vertical direction
   # of the viewport for conversion
@@ -797,8 +801,11 @@ makeContent.marquee_grob <- function(x) {
     # We may end here when creating precalculated grobs
     return(x)
   }
+
+  has_glyphs <- isTRUE(dev.capabilities("glyphs")$glyphs)
+
   # Create the font list of unique fonts
-  if (nrow(x$shape) > 0) {
+  if (has_glyphs && nrow(x$shape) > 0) {
     font_id <- paste0(x$shape$font_path, "&", x$shape$font_index)
     font_match <- match(font_id, unique(font_id))
     unique_font <- !duplicated(font_id)
@@ -815,26 +822,47 @@ makeContent.marquee_grob <- function(x) {
     ## Construct glyph grob
     i <- indices[[grob]]
     if (length(i) > 0) {
-      glyphs <- glyphInfo(
-        id = x$shape$index[i],
-        x = x$shape$x_offset[i],
-        y = x$shape$y_offset[i],
-        font = font_match[i],
-        size = x$shape$font_size[i],
-        fontList = fonts,
-        width = x$widths[grob],
-        height = -x$heights[grob],
-        hAnchor = glyphAnchor(0, "left"),
-        vAnchor = glyphAnchor(0, "bottom"),
-        col = x$shape$col[i]
-      )
-      glyphs <- glyphGrob(
-        glyphs,
-        x = 0,
-        y = 0,
-        hjust = 0,
-        vjust = 0
-      )
+      if (has_glyphs) {
+        glyphs <- glyphInfo(
+          id = x$shape$index[i],
+          x = x$shape$x_offset[i],
+          y = x$shape$y_offset[i],
+          font = font_match[i],
+          size = x$shape$font_size[i],
+          fontList = fonts,
+          width = x$widths[grob],
+          height = -x$heights[grob],
+          hAnchor = glyphAnchor(0, "left"),
+          vAnchor = glyphAnchor(0, "bottom"),
+          col = x$shape$col[i]
+        )
+        glyphs <- glyphGrob(
+          glyphs,
+          x = 0,
+          y = 0,
+          hjust = 0,
+          vjust = 0
+        )
+      } else {
+        glyphs <- systemfonts::glyph_outline(x$shape$index[i], x$shape$font_path[i], x$shape$font_index[i], x$shape$font_size[i])
+        need_bitmap <- i[attr(glyphs, "missing")]
+        glyphs <- pathGrob(
+          x = glyphs$x + x$shape$x_offset[i][glyphs$glyph],
+          y = glyphs$y + x$shape$y_offset[i][glyphs$glyph],
+          id = glyphs$contour,
+          pathId = glyphs$glyph,
+          default.units = "bigpts",
+          gp = gpar(fill = x$shape$col[i][vctrs::vec_unique(glyphs$glyph)], col = NA)
+        )
+        raster_glyphs <- systemfonts::glyph_raster(x$shape$index[need_bitmap], x$shape$font_path[need_bitmap], x$shape$font_index[need_bitmap], x$shape$font_size[need_bitmap], col = x$shape$col[need_bitmap])
+        raster_glyphs <- Map(
+          function(glyph, x, y) systemfonts::glyph_raster_grob(glyph, x, y, interpolate = TRUE),
+          glyph = raster_glyphs,
+          x = x$shape$x_offset[need_bitmap],
+          y = x$shape$y_offset[need_bitmap]
+        )
+        glyphs <- inject(grobTree(glyphs, !!!raster_glyphs))
+      }
     } else {
       glyphs <- NULL
     }

diff --git a/R/guide_marquee.R b/R/guide_marquee.R
@@ -38,7 +38,7 @@
 #'   [`guides()`][ggplot2::guides()] function or used as the `guide` argument in
 #'   a scale.
 #' @export
-#' @examplesIf utils::packageVersion("base") > "4.3" && rlang::is_installed("ggplot2", version = "3.5.0")
+#' @examplesIf rlang::is_installed("ggplot2", version = "3.5.0")
 #' library(ggplot2)
 #' # A standard plot
 #' base <- ggplot(mpg, aes(displ, hwy)) +

diff --git a/R/ink.R b/R/ink.R
@@ -19,7 +19,7 @@
 #'
 #' @export
 #'
-#' @examplesIf utils::packageVersion("base") > "4.3"
+#' @examples
 #' # Plot to illustrate the difference in vertical alignment
 #' library(grid)
 #' grid.newpage()

diff --git a/man/marquee_grob.Rd b/man/marquee_grob.Rd
diff --git a/tests/testthat/test-element_marquee.R b/tests/testthat/test-element_marquee.R
@@ -1,7 +1,5 @@
 test_that("element_marquee() inserts aesthetics into the style", {
 
-  skip_if_not(getRversion() >= "4.3")
-
   elem <- element_marquee("serif", colour = "red", size = 6, margin = ggplot2::margin(1, 1, 1, 1, "bigpts"))
   elem <- element_grob.element_marquee(elem, "test", hjust = "left", vjust = "center", margin_x = TRUE, margin_y = TRUE)
   expect_equal(elem$text$family[1], "serif")

diff --git a/tests/testthat/test-geom_marquee.R b/tests/testthat/test-geom_marquee.R
@@ -1,7 +1,5 @@
 test_that("geom_marquee inserts the aesthetics correctly", {
 
-  skip_if_not(getRversion() >= "4.3")
-
   p <- ggplot2::ggplot(mtcars) +
     geom_marquee(ggplot2::aes(disp, mpg, label = gear), family = "serif", size = 6, color = "red", fill = "blue", size.unit = "Pt")
   p <- ggplot2::ggplotGrob(p)

diff --git a/tests/testthat/test-grob.R b/tests/testthat/test-grob.R
@@ -1,7 +1,5 @@
 test_that("grobs gets correctly constructed", {
 
-  skip_if_not(getRversion() >= "4.3")
-
   grob1 <- marquee_grob(markdown_test, classic_style(lineheight = 1.1))
   expect_s3_class(grob1, "marquee_grob")
   expect_false(inherits(grob1, "marquee_precalculated_grob"))
@@ -43,8 +41,6 @@ test_that("grobs gets correctly constructed", {
 
 test_that("grob looks as it should (sadly too complex to test other way)", {
 
-  skip_if_not(getRversion() >= "4.3")
-
   grob1 <- marquee_grob(markdown_test, classic_style(lineheight = 1.1))
 
   skip_on_os("windows")

diff --git a/tests/testthat/test-guide_marquee.R b/tests/testthat/test-guide_marquee.R
@@ -1,5 +1,4 @@
 skip_if_not_installed("ggplot2", "3.5.0")
-skip_if(utils::packageVersion("base") < "4.3.0")
 
 test_that("guide_marquee can interpolate legend glyphs", {