rasterize grobs before plot (49af381f) · Commits · github_fork / LinkET

R/geom-shaping.R

+5 −1

Original line number	Diff line number	Diff line
		@@ -35,6 +35,7 @@ draw_key_marker <- function(data, params, size) {
		#' @inheritParams ggplot2::layer
		#' @inheritParams ggplot2::geom_polygon
		#' @param width_unit,height_unit units of width or height.
		#' @param rasterize logical, whether to convert raster image before drawing.
		#' @section Aesthetics:
		#' \code{geom_shaping()} understands the following aesthetics (required aesthetics are in bold):
		#' \itemize{
		@@ -68,11 +69,13 @@ geom_shaping <- function(mapping = NULL,
		...,
		width_unit = "native",
		height_unit = width_unit,
		rasterize = FALSE,
		na.rm = FALSE,
		show.legend = NA,
		inherit.aes = TRUE) {
		params <- rename(list(width_unit = width_unit,
		height_unit = height_unit,
		rasterize = rasterize,
		na.rm = na.rm,
		...), "shaping" = "marker")
		if ("shaping" %in% names(params)) {
		@@ -103,7 +106,7 @@ Geomshaping <- ggproto(
		required_aes = c("x", "y"),

		draw_panel = function(self, data, panel_params, coord, shaping = NULL,
		width_unit = NULL, height_unit = NULL) {
		width_unit = NULL, height_unit = NULL, rasterize = FALSE) {
		if (empty(data)) {
		return(nullGrob())
		}
		@@ -153,6 +156,7 @@ Geomshaping <- ggproto(
		angle = data$angle,
		hjust = data$hjust,
		vjust = data$vjust,
		rasterize = rasterize,
		default.units = "native",
		gp = gpar(col = scales::alpha(data$colour, data$alpha),
		fill = scales::alpha(data$fill, data$alpha),

R/marker.R

+44 −22

Original line number	Diff line number	Diff line
		@@ -169,6 +169,7 @@ markerGrob <- function(marker,
		angle = 0,
		hjust = 0.5,
		vjust = 0.5,
		rasterize = FALSE,
		default.units = "npc",
		gp = gpar(),
		name = NULL,
		@@ -193,6 +194,7 @@ markerGrob <- function(marker,
		angle = angle,
		hjust = hjust,
		vjust = vjust,
		rasterize = rasterize,
		default.units = default.units,
		gp = gp,
		name = name,
		@@ -209,25 +211,52 @@ markerGrob <- function(marker,
		#' @rdname makeContent
		#' @export
		makeContent.markerGrob <- function(x) {
		n <- length(x$marker)
		marker <- x$marker
		width <- grid::unit(x$marker$width, x$marker$width_unit)
		height <- grid::unit(x$marker$height, x$marker$height_unit)
		width <- grid::convertWidth(width, "cm")
		height <- grid::convertHeight(height, "cm")

		n <- length(marker)
		width <- grid::unit(marker$width, marker$width_unit)
		height <- grid::unit(marker$height, marker$height_unit)
		width <- grid::convertWidth(width, "in")
		height <- grid::convertHeight(height, "in")
		grobs <- marker$grob
		gp <- split_gpar(x$gp, n)

		grobs <- purrr::map2(grobs, gp, function(.grob, .gp) {
		.grob$gp <- .gp
		.grob
		})

		if (isTRUE(x$rasterize)) {
		agg_capture <- get_function("ragg", "agg_capture")
		dim_inch <- grDevices::dev.size("in")
		dim_pt <- grDevices::dev.size("px")
		res <- dim_pt[1] / dim_inch[1]
		grobs <- lapply(seq_len(n), function(.n) {
		vp <- grid::viewport(x = x$x[.n],
		y = x$y[.n],
		width = width[.n],
		cur <- grDevices::dev.cur()
		cap <- agg_capture(width = width[.n],
		height = height[.n],
		angle = x$angle[.n],
		just = c(x$hjust[.n], x$vjust[.n]),
		default.units = x$default.units)
		units = "in",
		background = NA,
		res = res,
		scaling = 1 )
		grid.draw(grobs[[.n]])
		grob <- grid::rasterGrob(cap(native = TRUE))
		try(grDevices::dev.off(), silent = TRUE)
		grDevices::dev.set(cur)
		grob
		})
		}

		modify_grob(marker$grob[[.n]], vp = vp, gp = gp[[.n]])
		grobs <- purrr::pmap(list(grobs, x$x, x$y, width, height, x$angle, x$hjust, x$vjust),
		function(.grob, .x, .y, .width, .height, .angle, .hjust, .vjust) {
		vp <- grid::viewport(x = .x,
		y = .y,
		width = .width,
		height = .height,
		angle = .angle,
		just = c(.hjust, .vjust),
		default.units = x$default.units)
		.grob$vp <- vp
		.grob
		})

		grid::setChildren(x, do.call(grid::gList, grobs))
		@@ -286,13 +315,6 @@ modify_gpar <- function(gp1, gp2) {
		gp
		}

		#' @noRd
		modify_grob <- function(grob, vp = NULL, gp = gpar()) {
		grob$vp <- vp
		grob$gp <- modify_gpar(gp, grob$gp)
		grob
		}

		#' @noRd
		ellipseGrob <- function(r = 0, nstep = 100) {
		tt <- seq(0, 2 * pi, length = nstep)

man/geom_shaping.Rd

+3 −0

Original line number	Diff line number	Diff line
		@@ -14,6 +14,7 @@ geom_shaping(
		...,
		width_unit = "native",
		height_unit = width_unit,
		rasterize = FALSE,
		na.rm = FALSE,
		show.legend = NA,
		inherit.aes = TRUE
		@@ -53,6 +54,8 @@ to the paired geom/stat.}

		\item{width_unit, height_unit}{units of width or height.}

		\item{rasterize}{logical, whether to convert raster image before drawing.}

		\item{na.rm}{If \code{FALSE}, the default, missing values are removed with
		a warning. If \code{TRUE}, missing values are silently removed.}

Admin message