R/utils-op-grobs.R

In piecepackr: Board Game Graphics

op_xy <- function(x, y, z, op_angle = 45, op_scale = 0) {
	x <- x + op_scale * z * cos(to_radians(op_angle))
	y <- y + op_scale * z * sin(to_radians(op_angle))
	list(x = x, y = y)
}

## Two-sided token
basicTokenGrob <- function(
	piece_side,
	suit,
	rank,
	cfg = pp_cfg(),
	x = unit(0.5, "npc"),
	y = unit(0.5, "npc"),
	z = unit(0, "npc"),
	angle = 0,
	type = "normal",
	width = NA,
	height = NA,
	depth = NA,
	op_scale = 0,
	op_angle = 45
) {
	side <- get_side(piece_side)

	if (side %in% c("face", "back")) {
		grob <- cfg$get_grob(piece_side, suit, rank, type)
		xy_p <- op_xy(x, y, z + 0.5 * depth, op_angle, op_scale)
		cvp <- viewport(xy_p$x, xy_p$y, width, height, angle = angle)
		grob <- grid::editGrob(grob, name = "piece_side", vp = cvp)

		edge <- basicTokenEdge(
			piece_side,
			suit,
			rank,
			cfg,
			x,
			y,
			z,
			angle,
			width,
			height,
			depth,
			op_scale,
			op_angle
		)
		edge <- grid::editGrob(edge, name = "other_faces")

		gl <- gList(edge, grob)

		gTree(scale = 1, type = type, children = gl, cl = "basic_projected_token")
	} else {
		generalTokenGrob(
			piece_side,
			suit,
			rank,
			cfg,
			x,
			y,
			z,
			angle,
			type,
			width,
			height,
			depth,
			op_scale,
			op_angle
		)
	}
}

#' @export
makeContent.basic_projected_token <- function(x) {
	gp <- gpar(cex = x$scale, lex = x$scale)
	x$children$other_faces <- update_gp(x$children$other_faces, gp)

	if (hasName(x$children$piece_side, "scale")) {
		x$children$piece_side$scale <- x$scale
	} else if (x$type == "normal") {
		x$children$piece_side <- update_gp(x$children$piece_side, gp)
	}

	x
}

#' @export
grobCoords.basic_projected_token <- function(x, closed, ...) {
	if (is.null(x$children$other_faces$coords_xyl)) {
		NextMethod()
	} else {
		xylists_to_grobcoords(x$children$other_faces$coords_xyl, x$name, closed)
	}
}

## Token edge-side grobs
basicTokenEdge <- function(
	piece_side,
	suit,
	rank,
	cfg = pp_cfg(),
	x = unit(0.5, "npc"),
	y = unit(0.5, "npc"),
	z = unit(0, "npc"),
	angle = 0,
	width = NA,
	height = NA,
	depth = NA,
	op_scale = 0,
	op_angle = 45
) {
	cfg <- as_pp_cfg(cfg)
	opt <- cfg$get_piece_opt(piece_side, suit, rank)
	piece <- get_piece(piece_side)
	side <- ifelse(opt$back, "back", "face") #### allow limited 3D rotation #281

	x <- convertX(x, "in", valueOnly = TRUE)
	y <- convertY(y, "in", valueOnly = TRUE)
	z <- convertX(z, "in", valueOnly = TRUE)
	width <- convertX(width, "in", valueOnly = TRUE)
	height <- convertY(height, "in", valueOnly = TRUE)
	depth <- convertX(depth, "in", valueOnly = TRUE)

	shape <- pp_shape(
		opt$shape,
		opt$shape_t,
		opt$shape_r,
		opt$back,
		width = opt$shape_w,
		height = opt$shape_h
	)
	whd <- get_scaling_factors(side, width, height, depth)
	pc <- as_coord3d(x, y, z)
	R <- side_R(side) %*% AA_to_R(angle, axis_x = 0, axis_y = 0)
	token <- Token2S$new(shape, whd, pc, R)

	gl <- gList()
	# opposite side
	#### Could use transformation grob (flipped)
	opp_side <- ifelse(opt$back, "face", "back")
	opp_piece_side <- paste0(piece, "_", opp_side)
	opp_opt <- cfg$get_piece_opt(opp_piece_side, suit, rank)
	gp_opp <- gpar(
		col = opp_opt$border_color,
		fill = opp_opt$background_color,
		lex = opp_opt$border_lex
	)
	xyz_opp <- if (opt$back) token$xyz_face else token$xyz_back
	xy_opp <- as_coord2d(xyz_opp, alpha = degrees(op_angle), scale = op_scale)

	grob_opposite <- polygonGrob(
		x = xy_opp$x,
		y = xy_opp$y,
		default.units = "in",
		gp = gp_opp,
		name = "opposite_piece_side"
	)

	# edges
	edges <- token$op_edges(op_angle)
	for (i in seq_along(edges)) {
		name <- paste0("edge", i)
		gl[[i]] <- edges[[i]]$op_grob(op_angle, op_scale, name = name)
	}
	gp_edge <- gpar(col = opt$border_color, fill = opt$edge_color, lex = opt$border_lex)
	grob_edge <- gTree(children = gl, gp = gp_edge, name = "token_edges")

	# pre-compute grobCoords
	if (shape$convex) {
		coords_xyl <- as.list(convex_hull2d(as_coord2d(
			token$xyz,
			alpha = degrees(op_angle),
			scale = op_scale
		)))
	} else {
		coords_xyl <- NULL
	}

	gTree(coords_xyl = coords_xyl, children = gList(grob_opposite, grob_edge))
}

generalTokenGrob <- function(
	piece_side,
	suit,
	rank,
	cfg = pp_cfg(),
	x = unit(0.5, "npc"),
	y = unit(0.5, "npc"),
	z = unit(0, "npc"),
	angle = 0,
	type = "normal",
	width = NA,
	height = NA,
	depth = NA,
	op_scale = 0,
	op_angle = 45
) {
	cfg <- as_pp_cfg(cfg)
	piece <- get_piece(piece_side)
	side <- get_side(piece_side)
	opt <- cfg$get_piece_opt(paste0(piece, "_face"), suit, rank)
	shape <- pp_shape(
		opt$shape,
		opt$shape_t,
		opt$shape_r,
		opt$back,
		width = opt$shape_w,
		height = opt$shape_h
	)

	x <- convertX(x, "in", valueOnly = TRUE)
	y <- convertY(y, "in", valueOnly = TRUE)
	z <- convertX(z, "in", valueOnly = TRUE)
	width <- convertX(width, "in", valueOnly = TRUE)
	height <- convertY(height, "in", valueOnly = TRUE)
	depth <- convertX(depth, "in", valueOnly = TRUE)

	#### Generalize axis_x, axis_y #281
	axis_x <- 0
	axis_y <- 0

	# geometric vertices
	whd <- get_scaling_factors(side, width, height, depth)
	pc <- as_coord3d(x, y, z)
	R <- side_R(side) %*% AA_to_R(angle, axis_x, axis_y)
	token <- Token2S$new(shape, whd, pc, R)

	gl <- gList()
	edges <- token$op_edges(op_angle)
	for (i in seq_along(edges)) {
		name <- paste0("edge", i)
		gl[[i]] <- edges[[i]]$op_grob(op_angle, op_scale, name = name)
	}
	gp_edge <- gpar(col = opt$border_color, fill = opt$edge_color, lex = opt$border_lex)
	grob_edge <- gTree(children = gl, gp = gp_edge, name = "token_edges")

	side_visible <- token$visible_side(op_angle)
	piece_side <- paste0(piece, "_", side_visible)
	xy_vp <- token$op_xy_vp(op_angle, op_scale, side_visible)
	xy_polygon <- as_coord2d(
		token$xyz_side(side_visible),
		alpha = degrees(op_angle),
		scale = op_scale
	)
	ps_grob <- at_ps_grob(piece_side, suit, rank, cfg, xy_vp, xy_polygon)

	gl <- gList(grob_edge, ps_grob)

	# pre-compute grobCoords
	if (shape$convex) {
		coords_xyl <- as.list(convex_hull2d(as_coord2d(
			token$xyz,
			alpha = degrees(op_angle),
			scale = op_scale
		)))
	} else {
		coords_xyl <- NULL
	}

	gTree(
		scale = 1,
		type = type,
		coords_xyl = coords_xyl,
		children = gl,
		cl = "general_projected_token"
	)
}

#' @export
makeContent.general_projected_token <- function(x) {
	gp <- gpar(cex = x$scale, lex = x$scale)
	x$children$token_edges <- update_gp(x$children$token_edges, gp)
	x$children$piece_side$scale <- x$scale
	x
}

#' @export
grobCoords.general_projected_token <- function(x, closed, ...) {
	if (is.null(x$coords_xyl)) {
		NextMethod()
	} else {
		xylists_to_grobcoords(x$coords_xyl, x$name, closed)
	}
}

## Die
basicDieGrob <- function(
	piece_side,
	suit,
	rank,
	cfg = pp_cfg(),
	x = unit(0.5, "npc"),
	y = unit(0.5, "npc"),
	z = unit(0, "npc"),
	angle = 0,
	type = "normal",
	width = NA,
	height = NA,
	depth = NA,
	op_scale = 0,
	op_angle = 45
) {
	grob <- cfg$get_grob(piece_side, suit, rank, type)
	xy_p <- op_xy(x, y, z + 0.5 * depth, op_angle, op_scale)
	cvp <- viewport(xy_p$x, xy_p$y, width, height, angle = angle)
	grob <- grid::editGrob(grob, name = "top_face", vp = cvp)

	x <- convertX(x, "in", valueOnly = TRUE)
	y <- convertY(y, "in", valueOnly = TRUE)
	z <- convertX(z, "in", valueOnly = TRUE)
	width <- convertX(width, "in", valueOnly = TRUE)
	height <- convertY(height, "in", valueOnly = TRUE)
	depth <- convertX(depth, "in", valueOnly = TRUE)

	#### allow limited 3D rotation #281
	axis_x <- 0
	axis_y <- 0

	edge <- basicDieEdge(
		piece_side,
		suit,
		rank,
		cfg,
		x,
		y,
		z,
		angle,
		axis_x,
		axis_y,
		width,
		height,
		depth,
		op_scale,
		op_angle
	)
	edge <- grid::editGrob(edge, name = "other_faces")

	gl <- gList(edge, grob)

	# pre-compute grobCoords
	coords_xyl <- die_grobcoords_xyl(
		suit,
		rank,
		cfg,
		x,
		y,
		z,
		angle,
		axis_x,
		axis_y,
		width,
		height,
		depth,
		op_scale,
		op_angle
	)

	gTree(
		scale = 1,
		type = type,
		coords_xyl = coords_xyl,
		children = gl,
		cl = c("basic_projected_die", "coords_xyl")
	)
}

#' @export
grobCoords.coords_xyl <- function(x, closed, ...) {
	xylists_to_grobcoords(x$coords_xyl, x$name, closed)
}

#' @export
makeContent.basic_projected_die <- function(x) {
	gp <- gpar(cex = x$scale, lex = x$scale)
	for (i in seq_along(x$children$other_faces$children)) {
		if (hasName(x$children$other_faces$children[[i]], "scale")) {
			x$children$other_faces$children[[i]]$scale <- x$scale
		} else {
			x$children$other_faces$children[[i]] <- update_gp(
				x$children$other_faces$children[[i]],
				gp
			)
		}
	}
	if (hasName(x$children$top_face, "scale")) {
		x$children$top_face$scale <- x$scale
	} else if (x$type == "normal") {
		x$children$top_face <- update_gp(x$children$top_face, gp)
	}
	x
}

die_grobcoords_xyl <- function(
	suit,
	rank,
	cfg,
	x,
	y,
	z,
	angle,
	axis_x,
	axis_y,
	width,
	height,
	depth,
	op_scale,
	op_angle
) {
	opt <- cfg$get_piece_opt("die_face", suit, rank)
	if (opt$shape == "roundrect") {
		xyz <- rounded_die_xyz(
			suit,
			rank,
			cfg,
			x,
			y,
			z,
			angle,
			axis_x,
			axis_y,
			width,
			height,
			depth
		)
	} else {
		xyz <- die_xyz(suit, rank, cfg, x, y, z, angle, axis_x, axis_y, width, height, depth)
	}
	as.list(convex_hull2d(as_coord2d(xyz, alpha = degrees(op_angle), scale = op_scale)))
}

die_face_polygon_3d <- function(f_xyz, shape_r, width, height) {
	npc <- pp_shape("roundrect", radius = shape_r, width = width, height = height)$npc_coords
	# affine_settings expects corners as: upper-left, lower-left, lower-right, upper-right
	ul <- f_xyz[1L]
	ll <- f_xyz[2L]
	lr <- f_xyz[3L]
	as_coord3d(
		ll$x + npc$x * (lr$x - ll$x) + npc$y * (ul$x - ll$x),
		ll$y + npc$x * (lr$y - ll$y) + npc$y * (ul$y - ll$y),
		ll$z + npc$x * (lr$z - ll$z) + npc$y * (ul$z - ll$z)
	)
}

die_roundrect_hull_grob <- function(
	suit,
	rank,
	cfg,
	opt,
	x,
	y,
	z,
	angle,
	axis_x,
	axis_y,
	width,
	height,
	depth,
	op_angle,
	op_scale
) {
	xyz <- rounded_die_xyz(suit, rank, cfg, x, y, z, angle, axis_x, axis_y, width, height, depth)
	hull <- convex_hull2d(as_coord2d(xyz, alpha = degrees(op_angle), scale = op_scale))
	gp <- gpar(col = opt$border_color, fill = opt$edge_color, lex = opt$border_lex)
	polygonGrob(x = hull$x, y = hull$y, default.units = "in", gp = gp, name = "convex_hull")
}

basicDieEdge <- function(
	piece_side,
	suit,
	rank,
	cfg = pp_cfg(),
	x = unit(0.5, "npc"),
	y = unit(0.5, "npc"),
	z = unit(0, "npc"),
	angle = 0,
	axis_x = 0,
	axis_y = 0,
	width = NA,
	height = NA,
	depth = NA,
	op_scale = 0,
	op_angle = 45
) {
	cfg <- as_pp_cfg(cfg)
	opt <- cfg$get_piece_opt(piece_side, suit, rank)

	lf <- get_die_faces(suit, rank, cfg, x, y, z, angle, axis_x, axis_y, width, height, depth)

	indices_visible <- visible_die_faces(lf, op_angle)

	if (opt$shape == "roundrect") {
		hull_grob <- die_roundrect_hull_grob(
			suit,
			rank,
			cfg,
			opt,
			x,
			y,
			z,
			angle,
			axis_x,
			axis_y,
			width,
			height,
			depth,
			op_angle,
			op_scale
		)
		gl <- gList(hull_grob)
	} else {
		gl <- gList()
	}

	for (i in indices_visible) {
		xy <- as_coord2d(lf$f_xyz[[i]], alpha = degrees(op_angle), scale = op_scale)
		rank <- lf$die_face_info$rank[i]
		name <- paste0("die_side", i)
		if (opt$shape == "roundrect") {
			pts3d <- die_face_polygon_3d(lf$f_xyz[[i]], opt$shape_r, width, height)
			xy_polygon <- as_coord2d(pts3d, alpha = degrees(op_angle), scale = op_scale)
		} else {
			xy_polygon <- xy
		}
		gl[[length(gl) + 1L]] <- at_ps_grob(
			piece_side,
			suit,
			rank,
			cfg,
			xy,
			xy_polygon,
			name = name
		)
	}

	gTree(children = gl, name = "die_sides", cl = "basic_projected_die_edge")
}

basicEllipsoidFn <- function(shading = FALSE) {
	force(shading)
	function(
		piece_side,
		suit,
		rank,
		cfg = pp_cfg(),
		x = unit(0.5, "npc"),
		y = unit(0.5, "npc"),
		z = unit(0, "npc"),
		angle = 0,
		type = "normal",
		width = NA,
		height = NA,
		depth = NA,
		op_scale = 0,
		op_angle = 45
	) {
		cfg <- as_pp_cfg(cfg)
		opt <- cfg$get_piece_opt(piece_side, suit, rank)

		x <- convertX(x, "in", valueOnly = TRUE)
		y <- convertY(y, "in", valueOnly = TRUE)
		z <- convertX(z, "in", valueOnly = TRUE)
		width <- convertX(width, "in", valueOnly = TRUE)
		height <- convertY(height, "in", valueOnly = TRUE)
		depth <- convertX(depth, "in", valueOnly = TRUE)

		xyz <- ellipse_xyz()$scale(width, height, depth)$translate(x, y, z)
		xy <- as_coord2d(xyz, alpha = degrees(op_angle), scale = op_scale)
		xyh <- convex_hull2d(xy)

		gp_gf <- gpar(col = NA, fill = opt$background_color, lwd = 0)
		gf <- polygonGrob(
			x = xyh$x,
			y = xyh$y,
			default.units = "in",
			gp = gp_gf,
			name = "background"
		)

		gp_gb <- gpar(col = opt$border_color, fill = NA, lex = opt$border_lex)
		gb <- polygonGrob(x = xyh$x, y = xyh$y, default.units = "in", gp = gp_gb, name = "border")

		if (shading && getRversion() >= "4.1") {
			# Get top of ellipsoid in npc units for gradient fill
			idm <- which.max(xyz$z)
			cx <- (xy$x[idm] - range(xyh)$x[1L]) / diff(range(xyh)$x)
			cy <- (xy$y[idm] - range(xyh)$y[1L]) / diff(range(xyh)$y)
			rgr <- radialGradient(
				c(update_alpha_col(opt$background_color, 0.500), "#00000080"),
				r1 = 0.1,
				cx1 = cx,
				cx2 = cx,
				cy1 = cy,
				cy2 = cy
			)
			gp_gr <- gpar(col = opt$border_color, fill = rgr)
			gr <- polygonGrob(
				x = xyh$x,
				y = xyh$y,
				default.units = "in",
				gp = gp_gr,
				name = "shading"
			)
		} else {
			gr <- nullGrob(name = "shading")
		}

		gl <- gList(gf, gr, gb)

		coords_xyl <- as.list(xyh)

		gTree(
			scale = 1,
			type = type,
			coords_xyl = coords_xyl,
			shading = shading,
			children = gl,
			cl = c("projected_ellipsoid", "coords_xyl")
		)
	}
}

#' @export
makeContent.projected_ellipsoid <- function(x) {
	if (x$shading && !has_radial_gradients()) {
		rgr_inform()
	}
	x
}

## Pyramid Top
basicPyramidTop <- function(
	piece_side,
	suit,
	rank,
	cfg = pp_cfg(),
	x = unit(0.5, "npc"),
	y = unit(0.5, "npc"),
	z = unit(0, "npc"),
	angle = 0,
	type = "normal",
	width = NA,
	height = NA,
	depth = NA,
	op_scale = 0,
	op_angle = 45
) {
	cfg <- as_pp_cfg(cfg)

	x <- convertX(x, "in", valueOnly = TRUE)
	y <- convertY(y, "in", valueOnly = TRUE)
	z <- convertX(z, "in", valueOnly = TRUE)
	width <- convertX(width, "in", valueOnly = TRUE)
	height <- convertY(height, "in", valueOnly = TRUE)
	depth <- convertX(depth, "in", valueOnly = TRUE)
	xy_b <- npc_to_in(as_coord2d(rect_xy), x, y, width, height, angle)
	p <- as_polygon2d(xy_b)
	edge_types <- paste0("pyramid_", c("left", "back", "right", "face"))
	order <- painter_order(p, alpha = degrees(op_angle))
	df <- tibble(index = 1:4, edge = edge_types)[order, ]
	gl <- gList()
	for (i in 1:4) {
		opt <- cfg$get_piece_opt(df$edge[i], suit, rank)
		gp <- gpar(col = opt$border_color, lex = opt$border_lex, fill = opt$background_color)
		edge <- p$edges[df$index[i]]

		ex <- c(x, edge$p1$x, edge$p2$x)
		ey <- c(y, edge$p1$y, edge$p2$y)
		ez <- c(z + 0.5 * depth, z - 0.5 * depth, z - 0.5 * depth)
		xyz_polygon <- as_coord3d(x = ex, y = ey, z = ez)
		xy_polygon <- as_coord2d(xyz_polygon, alpha = degrees(op_angle), scale = op_scale)
		xy_vp <- xy_vp_ps(xyz_polygon, op_scale, op_angle)

		piece_side <- df$edge[i]
		gl[[i]] <- at_ps_grob(piece_side, suit, rank, cfg, xy_vp, xy_polygon, name = piece_side)
	}

	#### allow limited 3D rotation #281
	axis_x <- 0
	axis_y <- 0
	# pre-compute grobCoords
	coords_xyl <- pt_grobcoords_xyl(
		x,
		y,
		z,
		angle,
		axis_x,
		axis_y,
		width,
		height,
		depth,
		op_scale,
		op_angle
	)

	gTree(
		scale = 1,
		type = type,
		coords_xyl = coords_xyl,
		children = gl,
		cl = c("projected_pyramid_top", "coords_xyl")
	)
}

pt_grobcoords_xyl <- function(
	x,
	y,
	z,
	angle,
	axis_x,
	axis_y,
	width,
	height,
	depth,
	op_scale,
	op_angle
) {
	xyz <- pt_xyz(x, y, z, angle, axis_x, axis_y, width, height, depth)
	as.list(convex_hull2d(as_coord2d(xyz, alpha = degrees(op_angle), scale = op_scale)))
}

#' @export
makeContent.projected_pyramid_top <- function(x) {
	gp <- gpar(cex = x$scale, lex = x$scale)
	for (i in 1:4) {
		if (hasName(x$children[[i]], "scale")) {
			x$children[[i]]$scale <- x$scale
		} else if (x$type == "normal") {
			x$children[[i]] <- update_gp(x$children[[i]], gp)
		}
	}
	x
}

## Pyramid side
basicPyramidSide <- function(
	piece_side,
	suit,
	rank,
	cfg = pp_cfg(),
	x = unit(0.5, "npc"),
	y = unit(0.5, "npc"),
	z = unit(0, "npc"),
	angle = 0,
	type = "normal",
	width = NA,
	height = NA,
	depth = NA,
	op_scale = 0,
	op_angle = 45
) {
	cfg <- as_pp_cfg(cfg)

	x <- convertX(x, "in", valueOnly = TRUE)
	y <- convertY(y, "in", valueOnly = TRUE)
	z <- convertX(z, "in", valueOnly = TRUE)
	width <- convertX(width, "in", valueOnly = TRUE)
	height <- convertY(height, "in", valueOnly = TRUE)
	depth <- convertX(depth, "in", valueOnly = TRUE)

	xy_b <- npc_to_in(as_coord2d(pyramid_xy), x, y, width, height, angle)
	p <- as_polygon2d(xy_b)
	xy_tip <- xy_b[1]

	theta <- 2 * asin(0.5 * width / height)
	yt <- 1 - cos(theta)
	xy_t <- npc_to_in(as_coord2d(x = 0:1, y = yt), x, y, width, height, angle)

	gl <- gList()

	## opposite edge
	opposite_edge <- switch(
		piece_side,
		"pyramid_face" = "pyramid_back",
		"pyramid_back" = "pyramid_face",
		"pyramid_left" = "pyramid_right",
		"pyramid_right" = "pyramid_left"
	)
	xyz_polygon <- as_coord3d(x = xy_b$x[c(1, 3:2)], y = xy_b$y[c(1, 3:2)], z = z - 0.5 * depth)
	xy_polygon <- as_coord2d(xyz_polygon, alpha = degrees(op_angle), scale = op_scale)
	xy_vp <- xy_vp_ps(xyz_polygon, op_scale, op_angle)
	gl[[1]] <- at_ps_grob(opposite_edge, suit, rank, cfg, xy_vp, xy_polygon, name = opposite_edge)

	## side edges
	edge_types <- paste0(
		"pyramid_",
		switch(
			piece_side,
			"pyramid_face" = c("right", "bottom", "left"),
			"pyramid_left" = c("face", "bottom", "back"),
			"pyramid_back" = c("left", "bottom", "right"),
			"pyramid_right" = c("back", "bottom", "face")
		)
	)

	order <- painter_order(p, alpha = degrees(op_angle))
	df <- tibble(index = 1:3, edge = edge_types)[order, ]
	gli <- 2

	for (i in 1:3) {
		edge_ps <- df$edge[i]
		index <- df$index[i]
		if (edge_ps == "pyramid_bottom") {
			next
		}
		opt <- cfg$get_piece_opt(edge_ps, suit, rank)
		gp <- gpar(col = opt$border_color, lex = opt$border_lex, fill = opt$background_color)
		edge <- p$edges[index]
		if (index == 1) {
			# right side viewed top (left side viewed on side)
			ex <- c(edge$p1$x, edge$p2$x, xy_t$x[1])
			ey <- c(edge$p1$y, edge$p2$y, xy_t$y[1])
			ez <- c(z - 0.5 * depth, z - 0.5 * depth, z + 0.5 * depth)
		} else {
			# left side viewed top (right side viewed on side)
			ex <- c(edge$p2$x, xy_t$x[2], edge$p1$x)
			ey <- c(edge$p2$y, xy_t$y[2], edge$p1$y)
			ez <- c(z - 0.5 * depth, z + 0.5 * depth, z - 0.5 * depth)
		}
		xyz_polygon <- as_coord3d(x = ex, y = ey, z = ez)
		xy_polygon <- as_coord2d(xyz_polygon, alpha = degrees(op_angle), scale = op_scale)
		xy_vp <- xy_vp_ps(xyz_polygon, op_scale, op_angle)
		gl[[gli]] <- at_ps_grob(edge_ps, suit, rank, cfg, xy_vp, xy_polygon, name = edge_ps)
		gli <- gli + 1
	}

	## edge facing up
	x_f <- c(xy_tip$x, xy_t$x)
	y_f <- c(xy_tip$y, xy_t$y)
	z_f <- c(z - 0.5 * depth, z + 0.5 * depth, z + 0.5 * depth)
	opt <- cfg$get_piece_opt(piece_side, suit, rank)
	gp <- gpar(col = opt$border_color, lex = opt$border_lex, fill = opt$background_color)
	xyz_polygon <- as_coord3d(x = x_f, y = y_f, z = z_f)
	xy_polygon <- as_coord2d(xyz_polygon, alpha = degrees(op_angle), scale = op_scale)
	xy_vp <- xy_vp_ps(xyz_polygon, op_scale, op_angle)
	gl[[4]] <- at_ps_grob(piece_side, suit, rank, cfg, xy_vp, xy_polygon, name = piece_side)

	#### allow limited 3D rotation #281
	axis_x <- 0
	axis_y <- 0
	# pre-compute grobCoords
	coords_xyl <- ps_grobcoords_xyl(
		x,
		y,
		z,
		angle,
		axis_x,
		axis_y,
		width,
		height,
		depth,
		op_scale,
		op_angle
	)

	gTree(
		scale = 1,
		type = type,
		coords_xyl = coords_xyl,
		children = gl,
		cl = c("projected_pyramid_side", "coords_xyl")
	)
}

ps_grobcoords_xyl <- function(
	x,
	y,
	z,
	angle,
	axis_x,
	axis_y,
	width,
	height,
	depth,
	op_scale,
	op_angle
) {
	xyz <- ps_xyz(x, y, z, angle, axis_x, axis_y, width, height, depth)
	as.list(convex_hull2d(as_coord2d(xyz, alpha = degrees(op_angle), scale = op_scale)))
}

#' @export
makeContent.projected_pyramid_side <- function(x) {
	gp <- gpar(cex = x$scale, lex = x$scale)
	for (i in 1:4) {
		if (hasName(x$children[[i]], "scale")) {
			x$children[[i]]$scale <- x$scale
		} else if (x$type == "normal") {
			x$children[[i]] <- update_gp(x$children[[i]], gp)
		}
	}
	x
}

# compute `xy_vp` for pyramid sides
xy_vp_ps <- function(xyz_polygon, op_scale, op_angle) {
	p_midbottom <- mean(xyz_polygon[2:3])
	p_diff <- xyz_polygon[1] - p_midbottom
	p_ul <- xyz_polygon[2] + p_diff
	p_ur <- xyz_polygon[3] + p_diff

	x <- c(p_ul$x, xyz_polygon$x[2:3], p_ur$x)
	y <- c(p_ul$y, xyz_polygon$y[2:3], p_ur$y)
	z <- c(p_ul$z, xyz_polygon$z[2:3], p_ur$z)

	as_coord2d(as_coord3d(x, y, z), alpha = degrees(op_angle), scale = op_scale)
}

#### `grobCoords()`
basicHoledBoardFn <- function(nrows = 4L, ncols = 4L, margin = 0) {
	# nolint
	force(nrows)
	force(ncols)
	force(margin)
	function(
		piece_side,
		suit,
		rank,
		cfg = pp_cfg(),
		x = unit(0.5, "npc"),
		y = unit(0.5, "npc"),
		z = unit(0, "npc"),
		angle = 0,
		type = "normal",
		width = NA,
		height = NA,
		depth = NA,
		op_scale = 0,
		op_angle = 45
	) {
		side <- get_side(piece_side)
		stopifnot(side %in% c("face", "back"))

		# Top side
		grob <- cfg$get_grob(piece_side, suit, rank, type)
		xy_p <- op_xy(x, y, z + 0.5 * depth, op_angle, op_scale)
		cvp <- viewport(xy_p$x, xy_p$y, width, height, angle = angle)
		grob <- grid::editGrob(grob, name = "piece_side", vp = cvp)

		# Opposite side
		xy_op <- op_xy(x, y, z - 0.5 * depth, op_angle, op_scale)
		cv_op <- viewport(xy_op$x, xy_op$y, width, height, angle = angle)
		grob_op <- grid::editGrob(grob, name = "opposite_piece_side", vp = cv_op)

		# Edges
		cfg <- as_pp_cfg(cfg)
		opt <- cfg$get_piece_opt(piece_side, suit, rank)
		piece <- get_piece(piece_side)
		side <- ifelse(opt$back, "back", "face") #### allow limited 3D rotation #281

		x <- convertX(x, "in", valueOnly = TRUE)
		y <- convertY(y, "in", valueOnly = TRUE)
		z <- convertX(z, "in", valueOnly = TRUE)
		width <- convertX(width, "in", valueOnly = TRUE)
		height <- convertY(height, "in", valueOnly = TRUE)
		depth <- convertX(depth, "in", valueOnly = TRUE)

		# Exterior edges
		shape <- pp_shape(
			opt$shape,
			opt$shape_t,
			opt$shape_r,
			opt$back,
			width = opt$shape_w,
			height = opt$shape_h
		)
		whd <- get_scaling_factors(side, width, height, depth)
		pc <- as_coord3d(x, y, z)
		R <- side_R(side) %*% AA_to_R(angle, axis_x = 0, axis_y = 0)
		token <- Token2S$new(shape, whd, pc, R)

		gl <- gList()
		edges <- token$op_edges(op_angle)
		for (i in seq_along(edges)) {
			name <- paste0("outside_edge", i)
			gl[[i]] <- edges[[i]]$op_grob(op_angle, op_scale, name = name)
		}

		# Interior hole edges
		xc <- rep(seq.int(ncols) - 0.5 + margin, times = nrows) / (ncols + 2 * margin) # npc
		yc <- rep(seq.int(nrows) - 0.5 + margin, each = ncols) / (nrows + 2 * margin) # npc
		r <- RADIUS_BOARD_HOLES / (min(nrows, ncols) + 2 * margin) # snpc
		# Convert npc units to inches, rotate by `angle`, and translate to `x` and `y`
		stopifnot(width == height) # snpc `r` may not work for non-square holed boards
		xc <- width * (xc - 0.5)
		yc <- height * (yc - 0.5)
		wc <- 2 * width * r
		tc <- to_t(xc, yc)
		rc <- to_r(xc, yc)
		xc <- to_x(tc + angle, rc) + x
		yc <- to_y(tc + angle, rc) + y

		shape_circle <- pp_shape("circle")
		lc <- purrr::pmap(list(xc = xc, yc = yc), function(xc, yc) {
			whd <- get_scaling_factors(side, wc, wc, depth)
			pc <- as_coord3d(xc, yc, z)
			token <- Token2S$new(shape_circle, whd, pc)
		})

		for (i in seq_along(lc)) {
			edges <- lc[[i]]$op_edges(op_angle)
			for (j in seq_along(edges)) {
				name <- str_glue("hole{i}_edge{j}")
				gl[[length(gl) + 1L]] <- edges[[j]]$op_grob(op_angle, op_scale, name = name)
			}
		}

		gp_edge <- gpar(col = opt$border_color, fill = opt$edge_color, lex = opt$border_lex)
		grob_edge <- gTree(children = gl, gp = gp_edge, name = "token_edges")

		gl <- gList(grob_op, grob_edge, grob)
		gTree(scale = 1, type = type, children = gl, cl = "projected_holed_board")
	}
}

#' @export
makeContent.projected_holed_board <- makeContent.basic_projected_token