improve markerGrob (506ec021) · Commits · github_fork / LinkET

NAMESPACE

+5 −0

Original line number	Diff line number	Diff line
		@@ -172,6 +172,10 @@ importFrom(ggplot2,scale_x_discrete)
		importFrom(ggplot2,scale_y_discrete)
		importFrom(ggplot2,theme)
		importFrom(ggplot2,waiver)
		importFrom(grDevices,dev.cur)
		importFrom(grDevices,dev.off)
		importFrom(grDevices,dev.set)
		importFrom(grDevices,dev.size)
		importFrom(grid,gTree)
		importFrom(grid,get.gpar)
		importFrom(grid,gpar)
		@@ -181,6 +185,7 @@ importFrom(grid,is.grob)
		importFrom(grid,is.unit)
		importFrom(grid,makeContent)
		importFrom(grid,polygonGrob)
		importFrom(grid,rasterGrob)
		importFrom(grid,unit)
		importFrom(grid,viewport)
		importFrom(igraph,V)

R/marker.R

+50 −41

Original line number	Diff line number	Diff line
		@@ -206,48 +206,55 @@ markerGrob <- function(marker,
		#' @description This function takes care of updating the marker size based on
		#' device size.
		#' @param x a marker grob object.
		#' @importFrom grid makeContent
		#' @importFrom grid makeContent unit viewport rasterGrob
		#' @importFrom purrr pmap
		#' @importFrom grDevices dev.size dev.cur dev.off dev.set
		#' @author Hou Yun
		#' @rdname makeContent
		#' @export
		makeContent.markerGrob <- function(x) {
		marker <- x$marker
		n <- length(marker)
		width <- grid::unit(marker$width, marker$width_unit)
		height <- grid::unit(marker$height, marker$height_unit)
		width <- unit(marker$width, marker$width_unit)
		height <- 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")
		dim_inch <- dev.size("in")
		dim_pt <- dev.size("px")
		res <- dim_pt[1] / dim_inch[1]
		grobs <- lapply(seq_len(n), function(.n) {
		cur <- grDevices::dev.cur()
		cap <- agg_capture(width = width[.n],
		height = height[.n],

		grobs <- pmap(list(grobs, gp, x$x, x$y, width, height, x$angle, x$hjust, x$vjust),
		function(.grob, .gp, .x, .y, .width, .height, .angle, .hjust, .vjust) {
		cur <- dev.cur()
		cap <- agg_capture(width = .width,
		height = .height,
		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
		.grob$gp <- .gp
		grid.draw(.grob)
		.grob <- rasterGrob(cap(native = TRUE))
		try(dev.off(), silent = TRUE)
		dev.set(cur)
		vp <- viewport(x = .x,
		y = .y,
		width = .width,
		height = .height,
		angle = .angle,
		just = c(.hjust, .vjust),
		default.units = x$default.units)
		.grob$vp <- vp
		.grob
		})
		}

		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) {
		} else {
		grobs <- pmap(list(grobs, gp, x$x, x$y, width, height, x$angle, x$hjust, x$vjust),
		function(.grob, .gp, .x, .y, .width, .height, .angle, .hjust, .vjust) {
		vp <- grid::viewport(x = .x,
		y = .y,
		width = .width,
		@@ -255,9 +262,11 @@ makeContent.markerGrob <- function(x) {
		angle = .angle,
		just = c(.hjust, .vjust),
		default.units = x$default.units)
		.grob$gp <- .gp
		.grob$vp <- vp
		.grob
		})
		}

		grid::setChildren(x, do.call(grid::gList, grobs))
		}
		@@ -463,8 +472,8 @@ as_marker.raster <- function(x, ...) {
		#' @method as_marker formula
		as_marker.formula <- function(x, envir = parent.frame(), ...) {
		agg_capture <- get_function("ragg", "agg_capture")
		dim_inch <- grDevices::dev.size("in")
		cur <- grDevices::dev.cur()
		dim_inch <- dev.size("in")
		cur <- dev.cur()
		cap <- agg_capture(width = dim_inch[1],
		height = dim_inch[2],
		units = "in",
		@@ -474,8 +483,8 @@ as_marker.formula <- function(x, envir = parent.frame(), ...) {
		.fun <- parse(text = as.character(x)[2])
		eval(.fun, envir = envir)
		on.exit({
		grDevices::dev.off()
		grDevices::dev.set(cur)}, add = TRUE)
		dev.off()
		dev.set(cur)}, add = TRUE)
		grob <- grid::rasterGrob(cap(native = TRUE))
		marker(grob = grob, ...)
		}

Admin message