R/utils-pips.R

In piecepackr: Board Game Graphics

#' @importFrom tibble tibble
xya_pips_cards <- function(n_pips) {
	if (n_pips == 0) {
		return(tibble(x = numeric(0), y = numeric(0), angle = numeric(0)))
	}
	if (n_pips > 10) {
		abort(paste0("Don't know pip pattern for ", n_pips, " pips"))
	}
	switch(
		n_pips,
		tibble(x = 0.5, y = 0.5, angle = 0), # 1
		tibble(x = 0.5, y = c(0.2, 0.8), angle = c(180, 0)), # 2
		tibble(x = 0.5, y = c(0.2, 0.5, 0.8), angle = c(180, 0, 0)), # 3
		tibble(
			x = rep(c(0.25, 0.75), 2),
			y = rep(c(0.2, 0.8), each = 2), # 4
			angle = rep(c(180, 0), each = 2)
		),
		tibble(
			x = c(rep(c(0.25, 0.75), 2), 0.5), # 5
			y = c(rep(c(0.2, 0.8), each = 2), 0.5),
			angle = c(rep(180, 2), rep(0, 3))
		),
		tibble(
			x = rep(c(0.25, 0.75), 3),
			y = rep(c(0.2, 0.5, 0.8), each = 2), # 6
			angle = c(rep(180, 2), rep(0, 4))
		),
		tibble(
			x = c(rep(c(0.25, 0.75), 3), 0.5), # 7
			y = c(rep(c(0.2, 0.5, 0.75), each = 2), 0.55),
			angle = c(rep(180, 2), rep(0, 5))
		),
		tibble(
			x = rep(c(0.25, 0.75), 4), # 8
			y = rep(c(0.2, 0.4, 0.6, 0.8), each = 2),
			angle = c(rep(180, 4), rep(0, 4))
		),
		tibble(
			x = c(rep(c(0.25, 0.75), 4), 0.5), # 9
			y = c(rep(c(0.2, 0.4, 0.6, 0.8), each = 2), 0.7),
			angle = c(rep(180, 4), rep(0, 5))
		),
		tibble(
			x = c(0.5, rep(c(0.25, 0.75), 4), 0.5), # 10
			y = c(0.3, rep(c(0.2, 0.4, 0.6, 0.8), each = 2), 0.7),
			angle = c(rep(180, 5), rep(0, 5))
		)
	)
}

xya_pips_dominoes <- function(n_pips, die = FALSE, chinese = FALSE, other_pips = NULL) {
	if (n_pips == 0) {
		return(tibble(x = numeric(0), y = numeric(0), angle = numeric(0)))
	}
	if (die && !chinese) {
		high <- 0.75
	} else if (chinese && die) {
		if (n_pips == 4) {
			high <- 0.65
		} else if (n_pips == 6) {
			high <- 0.75
		} else {
			high <- 0.68
		}
	} else {
		high <- 0.78
	}
	low <- 1 - high
	if (chinese && !die) {
		low <- 0.2
		if (n_pips == 3 && other_pips < 5) {
			high <- 1.0
		} else if (n_pips == 4 && other_pips == 4) {
			high <- 0.75
		} else {
			high <- 0.84
		}
	}
	if (chinese && die && n_pips == 6) {
		left <- 0.36
	} else if (chinese && !die) {
		left <- 0.30
	} else {
		left <- low
	}
	right <- 1 - left
	mid <- 0.5 * (high + low)
	if (n_pips > 18L) {
		abort(paste0("Don't know pip pattern for ", n_pips, " pips"))
	}
	switch(
		n_pips,
		if (chinese && !die) {
			tibble(x = 0.5, y = low, angle = 0)
		} else {
			tibble(x = 0.5, y = mid, angle = 0)
		}, # 1
		if (chinese) {
			if (die) {
				tibble(x = 0.5, y = c(low, high), angle = c(0, 180))
			} else {
				tibble(x = c(left, right), y = low, angle = c(0, 180))
			}
		} else {
			tibble(x = c(left, right), y = c(high, low), angle = c(0, 180))
		}, # 2
		tibble(x = c(left, 0.5, right), y = c(high, mid, low), angle = c(0, 0, 180)), # 3
		if (chinese && !die && other_pips != 4) {
			tibble(
				x = rep(c(left, right), 2), # 4
				y = rep(c(low, mid), each = 2),
				angle = rep(c(180, 0), each = 2)
			)
		} else {
			tibble(
				x = rep(c(left, right), 2), # 4
				y = rep(c(low, high), each = 2),
				angle = rep(c(180, 0), each = 2)
			)
		},
		tibble(
			x = c(rep(c(left, right), 2), 0.5), # 5
			y = c(rep(c(low, high), each = 2), mid),
			angle = c(rep(180, 2), rep(0, 3))
		),
		tibble(
			x = rep(c(left, right), 3),
			y = rep(c(low, mid, high), each = 2), # 6
			angle = c(rep(180, 2), rep(0, 4))
		),
		tibble(
			x = c(rep(c(left, right), 3), 0.5), # 7
			y = c(rep(c(low, 0.5, high), each = 2), 0.50),
			angle = c(rep(180, 2), rep(0, 5))
		),
		tibble(
			x = c(0.5, rep(c(left, right), 3), 0.5), # 8
			y = c(low, rep(c(low, 0.5, high), each = 2), high),
			angle = c(rep(180, 3), rep(0, 5))
		),
		tibble(
			x = c(rep(c(left, 0.5, right), 3)), # 9
			y = c(rep(c(low, 0.5, high), each = 3)),
			angle = c(rep(180, 3), rep(0, 6))
		),
		tibble(
			x = c(0.5, rep(c(0.20, 0.80), 4), 0.5), # 10
			y = c(0.2, rep(c(0.2, 0.4, 0.6, 0.8), each = 2), 0.8),
			angle = c(rep(180, 5), rep(0, 5))
		),
		tibble(
			x = c(0.5, rep(c(0.20, 0.80), 4), 0.5, 0.5), # 11
			y = c(0.2, rep(c(0.2, 0.4, 0.6, 0.8), each = 2), 0.5, 0.8),
			angle = c(rep(180, 5), rep(0, 6))
		),
		tibble(
			x = c(rep(c(0.20, 0.5, 0.80), 4)), # 12
			y = c(rep(c(0.2, 0.4, 0.6, 0.8), each = 3)),
			angle = c(rep(180, 6), rep(0, 6))
		),
		tibble(
			x = c(rep(c(0.2, 0.4, 0.6, 0.8), 3), 0.5), # 13
			y = c(rep(c(0.2, 0.4, 0.6), each = 4), 0.8),
			angle = c(rep(180, 8), rep(0, 5))
		),
		tibble(
			x = c(rep(c(0.2, 0.4, 0.6, 0.8), 3), 0.3, 0.7), # 14
			y = c(rep(c(0.2, 0.4, 0.6), each = 4), 0.8, 0.8),
			angle = c(rep(180, 8), rep(0, 6))
		),
		tibble(
			x = c(rep(c(0.2, 0.4, 0.6, 0.8), 3), 0.3, 0.5, 0.7), # 15
			y = c(rep(c(0.2, 0.4, 0.6), each = 4), 0.8, 0.8, 0.8),
			angle = c(rep(180, 8), rep(0, 7))
		),
		tibble(
			x = c(rep(c(0.2, 0.4, 0.6, 0.8), 4)), # 16
			y = c(rep(c(0.2, 0.4, 0.6, 0.8), each = 4)),
			angle = c(rep(180, 8), rep(0, 8))
		),
		tibble(
			x = c(rep(c(0.140, 0.340, 0.660, 0.860), 4), 0.5), # 17
			y = c(rep(c(0.2, 0.4, 0.6, 0.8), each = 4), 0.5),
			angle = c(rep(180, 8), rep(0, 9))
		),
		tibble(
			x = c(rep(c(0.140, 0.340, 0.660, 0.860), 4), 0.5, 0.5), # 18
			y = c(rep(c(0.2, 0.4, 0.6, 0.8), each = 4), 0.3, 0.7),
			angle = c(rep(180, 8), rep(0, 8), 180, 0)
		)
	)
}

cardGrobFn <- function(
	rank_offset = 0,
	type = "card",
	grob_type = "text",
	has_pips = TRUE,
	fill_stroke = FALSE
) {
	force(type)
	force(rank_offset)
	force(grob_type)
	force(has_pips)
	force(fill_stroke)
	function(piece_side, suit, rank, cfg = pp_cfg()) {
		cfg <- as_pp_cfg(cfg)
		opt <- cfg$get_piece_opt(piece_side, suit, rank)

		gTree(
			opt = opt,
			piece_side = piece_side,
			suit = suit,
			rank = rank,
			cfg = cfg,
			type = type,
			rank_offset = rank_offset,
			grob_type = grob_type,
			fill_stroke = fill_stroke,
			scale = 1,
			border = TRUE,
			has_pips = has_pips,
			cl = c("card_side", "basic_piece_side")
		)
	}
}

#' @export
makeContent.card_side <- function(x) {
	opt <- x$opt

	type <- x$type
	rank_offset <- x$rank_offset
	grob_type <- x$grob_type

	shape <- pp_shape(
		opt$shape,
		opt$shape_t,
		opt$shape_r,
		opt$back,
		width = opt$shape_w,
		height = opt$shape_h
	)

	background_grob <- shape$shape(
		gp = gpar(col = NA, fill = opt$background_color),
		name = "background"
	)
	gp_mat <- gpar(col = NA, lwd = 0, fill = opt$mat_color)
	mat_grob <- shape$mat(opt$mat_width, gp = gp_mat, name = "mat")

	gp_rank <- gpar(
		col = opt$ps_color,
		fontsize = opt$ps_fontsize,
		fontfamily = opt$ps_fontfamily,
		fontface = opt$ps_fontface,
		lineheight = 0.8
	)
	rank_grob <- textGrob(
		label = opt$ps_text,
		gp = gp_rank,
		x = c(0.1, 0.9),
		y = c(0.9, 0.1),
		rot = c(0, 180),
		hjust = 0.5,
		vjust = 0.5,
		name = "rank"
	)
	if (isTRUE(x$fill_stroke)) {
		rank_grob <- as_fill_stroke_grob(rank_grob, fill = opt$ps_color)
	}

	gp_suit <- gpar(
		col = opt$dm_color,
		fontsize = opt$dm_fontsize,
		fontfamily = opt$dm_fontfamily,
		fontface = opt$dm_fontface
	)
	suit_grob <- textGrob(
		label = opt$dm_text,
		gp = gp_suit,
		x = c(0.1, 0.9),
		y = c(0.8, 0.2),
		rot = c(0, 180),
		hjust = 0.5,
		vjust = 0.5,
		name = "suit"
	)
	if (isTRUE(x$fill_stroke)) {
		suit_grob <- as_fill_stroke_grob(suit_grob, fill = opt$dm_color)
	}

	# Pips
	if (x$has_pips) {
		tfn <- pippedGrobFn(
			rank_offset,
			type,
			grob_type,
			border = FALSE,
			mat = FALSE,
			fill_stroke = x$fill_stroke
		)
		pip_grob <- tfn(x$piece_side, x$suit, x$rank, x$cfg)
		pip_grob <- grid::editGrob(
			pip_grob,
			vp = viewport(height = 1.0, width = 0.80, gp = gpar(cex = 1.8)),
			name = "pips"
		)
	} else {
		pip_grob <- nullGrob(name = "pips")
	}

	# Border
	if (x$border) {
		gp_border <- gpar(col = opt$border_color, fill = NA, lex = opt$border_lex)
		border_grob <- shape$shape(gp = gp_border, name = "border")
	} else {
		border_grob <- nullGrob(name = "border")
	}

	gl <- gList(background_grob, pip_grob, rank_grob, suit_grob, mat_grob, border_grob)
	setChildren(x, gl)
}

jokerCardGrobFn <- function(star = TRUE, fill_stroke = FALSE) {
	force(star)
	force(fill_stroke)
	function(piece_side, suit, rank, cfg = pp_cfg()) {
		cfg <- as_pp_cfg(cfg)
		opt <- cfg$get_piece_opt(piece_side, suit, rank)

		gTree(
			opt = opt,
			star = star,
			fill_stroke = fill_stroke,
			scale = 1,
			border = TRUE,
			cl = c("joker_card_side", "basic_piece_side")
		)
	}
}

#' @export
makeContent.joker_card_side <- function(x) {
	opt <- x$opt

	shape <- pp_shape(
		opt$shape,
		opt$shape_t,
		opt$shape_r,
		opt$back,
		width = opt$shape_w,
		height = opt$shape_h
	)

	background_grob <- shape$shape(
		gp = gpar(col = NA, fill = opt$background_color),
		name = "background"
	)
	gp_mat <- gpar(col = NA, lwd = 0, fill = opt$mat_color)
	mat_grob <- shape$mat(opt$mat_width, gp = gp_mat, name = "mat")

	gp_rank <- gpar(
		col = opt$ps_color,
		fontsize = opt$ps_fontsize,
		fontfamily = opt$ps_fontfamily,
		fontface = opt$ps_fontface,
		lineheight = 0.8
	)
	rank_grob <- textGrob(
		label = opt$ps_text,
		gp = gp_rank,
		x = c(0.1, 0.9),
		y = c(0.9, 0.1),
		rot = c(0, 180),
		hjust = 0.5,
		vjust = 0.5,
		name = "rank"
	)
	if (isTRUE(x$fill_stroke)) {
		rank_grob <- as_fill_stroke_grob(rank_grob, fill = opt$ps_color)
	}

	# Joker
	joker_grob <- jokerGrob(opt, x$star, x$fill_stroke)

	# Border
	if (x$border) {
		gp_border <- gpar(col = opt$border_color, fill = NA, lex = opt$border_lex)
		border_grob <- shape$shape(gp = gp_border, name = "border")
	} else {
		border_grob <- nullGrob(name = "border")
	}

	gl <- gList(background_grob, joker_grob, rank_grob, mat_grob, border_grob)
	setChildren(x, gl)
}

jokerGrob <- function(opt, star = TRUE, fill_stroke = FALSE) {
	gp_meeple <- gpar(col = opt$ps_color, lwd = 4)
	vp_meeple <- viewport(height = inch(1.3), width = inch(1.2), y = 0.4)
	meeple_grob <- pp_shape("meeple")$shape(gp = gp_meeple, vp = vp_meeple)
	if (fill_stroke) {
		gp_triangle <- gpar(fill = opt$ps_color, col = opt$border_col, lwd = 1.5)
		gp_circle <- gpar(fill = opt$ps_color, col = opt$border_col, lwd = 1.5)
	} else {
		gp_triangle <- gpar(fill = opt$ps_color, col = NA_character_)
		gp_circle <- gpar(col = opt$ps_color, lwd = 4)
	}
	y_triangle <- unit(0.4, "npc") + inch(0.5 * 1.3) + inch(0.5 * 0.8) + inch(-0.10)
	vp_triangle <- viewport(height = inch(0.8), width = inch(0.45), y = y_triangle)
	triangle_grob <- pp_shape("pyramid")$shape(gp = gp_triangle, vp = vp_triangle)
	y_circle <- y_triangle + inch(0.5 * 0.8) + inch(0.5 * 0.2) + inch(-0.02)
	vp_circle <- viewport(height = inch(0.2), width = inch(0.2), y = y_circle)
	circle_grob <- circleGrob(vp = vp_circle, gp = gp_circle)
	if (star) {
		star_grob <- pp_shape("concave5")$shape(gp = gp_triangle, vp = vp_circle)
	} else {
		star_grob <- NULL
	}
	grobTree(
		meeple_grob,
		triangle_grob,
		circle_grob,
		star_grob,
		vp = viewport(width = 0.8, height = 0.9),
		cl = "joker"
	)
}

faceCardGrobFn <- function(label = "", placement = "high", fill_stroke = FALSE) {
	force(label)
	force(placement)
	force(fill_stroke)
	function(piece_side, suit, rank, cfg = pp_cfg()) {
		cfg <- as_pp_cfg(cfg)
		opt <- cfg$get_piece_opt(piece_side, suit, rank)

		gTree(
			opt = opt,
			label = label,
			placement = placement,
			scale = scale,
			border = TRUE,
			fill_stroke = fill_stroke,
			cl = c("face_card_side", "basic_piece_side")
		)
	}
}

#' @export
makeContent.face_card_side <- function(x) {
	opt <- x$opt
	label <- x$label
	placement <- x$placement

	shape <- pp_shape(
		opt$shape,
		opt$shape_t,
		opt$shape_r,
		opt$back,
		width = opt$shape_w,
		height = opt$shape_h
	)

	background_grob <- shape$shape(
		gp = gpar(col = NA, fill = opt$background_color),
		name = "background"
	)
	gp_mat <- gpar(col = NA, lwd = 0, fill = opt$mat_color)
	mat_grob <- shape$mat(opt$mat_width, gp = gp_mat, name = "mat")

	gp_rank <- gpar(
		col = opt$ps_color,
		fontsize = opt$ps_fontsize,
		fontfamily = opt$ps_fontfamily,
		fontface = opt$ps_fontface,
		lineheight = 0.8
	)
	rank_grob <- textGrob(
		label = opt$ps_text,
		gp = gp_rank,
		x = c(0.1, 0.9),
		y = c(0.9, 0.1),
		rot = c(0, 180),
		hjust = 0.5,
		vjust = 0.5,
		name = "rank"
	)
	if (isTRUE(x$fill_stroke)) {
		rank_grob <- as_fill_stroke_grob(rank_grob, fill = opt$ps_color)
	}

	gp_suit <- gpar(
		col = opt$dm_color,
		fontsize = opt$dm_fontsize,
		fontfamily = opt$dm_fontfamily,
		fontface = opt$dm_fontface
	)
	suit_grob <- textGrob(
		label = opt$dm_text,
		gp = gp_suit,
		x = c(0.1, 0.9),
		y = c(0.8, 0.2),
		rot = c(0, 180),
		hjust = 0.5,
		vjust = 0.5,
		name = "suit"
	)
	if (isTRUE(x$fill_stroke)) {
		suit_grob <- as_fill_stroke_grob(suit_grob, fill = opt$dm_color)
	}

	# Face
	top_grob <- faceGrob(opt, label, placement, fill_stroke = x$fill_stroke)
	top_grob <- grid::editGrob(
		top_grob,
		vp = viewport(y = 0.75, height = 0.5, width = 0.80),
		name = "top"
	)
	bot_grob <- faceGrob(opt, label, placement, fill_stroke = x$fill_stroke)
	bot_grob <- grid::editGrob(
		top_grob,
		vp = viewport(y = 0.25, height = 0.5, width = 0.80, angle = 180),
		name = "bottom"
	)

	# Border
	if (x$border) {
		gp_border <- gpar(col = opt$border_color, fill = NA, lex = opt$border_lex)
		border_grob <- shape$shape(gp = gp_border, name = "border")
	} else {
		border_grob <- nullGrob(name = "border")
	}

	gl <- gList(background_grob, top_grob, bot_grob, rank_grob, suit_grob, mat_grob, border_grob)
	setChildren(x, gl)
}

faceGrob <- function(opt, label = "", placement = "high", fill_stroke = FALSE) {
	if (placement == "high") {
		y <- 0.7
		x_meeple <- 0.5
		y_meeple <- 0.3
		in_meeple <- 1
		cex <- 1.5
	} else {
		y <- 0.25
		x_meeple <- 0.57
		y_meeple <- 0.42
		in_meeple <- 0.6
		cex <- 3.0
	}
	rot <- ifelse(label %in% c("\u046a", "\u050a"), 180, 0)
	gp_label <- gpar(
		col = opt$ps_color,
		fontsize = opt$ps_fontsize,
		fontfamily = opt$ps_fontfamily,
		fontface = opt$ps_fontface,
		lineheight = 0.8,
		cex = cex
	)
	label_grob <- textGrob(
		label = label,
		gp = gp_label,
		x = 0.5,
		y = y,
		hjust = 0.5,
		vjust = 0.5,
		rot = rot,
		name = "label"
	)
	if (isTRUE(fill_stroke)) {
		label_grob <- as_fill_stroke_grob(label_grob, fill = opt$ps_color)
	}
	gp_suit <- gpar(
		col = opt$dm_color,
		fontsize = opt$dm_fontsize,
		fontfamily = opt$dm_fontfamily,
		fontface = opt$dm_fontface,
		cex = in_meeple
	)
	suit_grob <- textGrob(
		label = opt$dm_text,
		gp = gp_suit,
		x = x_meeple,
		y = y_meeple,
		hjust = 0.5,
		vjust = 0.5,
		name = "suit"
	)
	if (isTRUE(fill_stroke)) {
		suit_grob <- as_fill_stroke_grob(suit_grob, fill = opt$dm_color)
	}
	gp_meeple <- gpar(col = opt$ps_color, lwd = 4)
	vp_meeple <- viewport(
		height = inch(in_meeple),
		width = inch(in_meeple),
		x = x_meeple,
		y = y_meeple
	)
	meeple_grob <- pp_shape("meeple")$shape(gp = gp_meeple, vp = vp_meeple)
	grobTree(meeple_grob, label_grob, suit_grob, cl = "face")
}

dominoGrobFn <- function(rank_offset = 0, type = "domino", grob_type = "circle") {
	force(rank_offset)
	force(type)
	force(grob_type)
	function(piece_side, suit, rank, cfg = pp_cfg()) {
		cfg <- as_pp_cfg(cfg)
		opt <- cfg$get_piece_opt(piece_side, suit, rank)

		gTree(
			opt = opt,
			cfg = cfg,
			suit = suit,
			rank = rank,
			type = type,
			rank_offset = rank_offset,
			grob_type = grob_type,
			scale = 1,
			border = TRUE,
			cl = c("domino_side", "basic_piece_side")
		)
	}
}

#' @export
makeContent.domino_side <- function(x) {
	opt <- x$opt
	suit <- x$suit
	rank <- x$rank
	type <- x$type
	rank_offset <- x$rank_offset
	grob_type <- x$grob_type

	shape <- pp_shape(
		opt$shape,
		opt$shape_t,
		opt$shape_r,
		opt$back,
		width = opt$shape_w,
		height = opt$shape_h
	)

	background_grob <- shape$shape(
		gp = gpar(col = NA, fill = opt$background_color),
		name = "background"
	)

	gp_mat <- gpar(col = NA, lwd = 0, fill = opt$mat_color)
	mat_grob <- shape$mat(opt$mat_width, gp = gp_mat, name = "mat")

	# Top (Rank)
	tfn <- pippedGrobFn(
		rank_offset,
		type,
		grob_type,
		border = FALSE,
		mat = FALSE,
		background = !(type == "domino_chinese"),
		other_pips = suit
	)
	top_grob <- tfn("tile_face", rank, rank, x$cfg)
	top_grob <- grid::editGrob(
		top_grob,
		vp = viewport(height = 0.5, y = 0.75, angle = 180),
		name = "top_rank"
	)

	# Bottom (Suit)
	bfn <- pippedGrobFn(
		rank_offset,
		type,
		grob_type,
		border = FALSE,
		mat = FALSE,
		background = !(type == "domino_chinese"),
		other_pips = rank
	)
	bot_grob <- bfn("tile_face", suit, suit, x$cfg)
	bot_grob <- grid::editGrob(
		bot_grob,
		vp = viewport(height = 0.5, y = 0.25),
		name = "bottom_suit"
	)

	gp_gl <- gpar(col = opt$gridline_color, lex = opt$gridline_lex)
	gl_grob <- segmentsGrob(x0 = 0.1, x1 = 0.9, y0 = 0.5, y1 = 0.5, gp = gp_gl, name = "gridlines")

	# Border
	if (x$border) {
		gp_border <- gpar(col = opt$border_color, fill = NA, lex = opt$border_lex)
		border_grob <- shape$shape(gp = gp_border, name = "border")
	} else {
		border_grob <- nullGrob(name = "border")
	}

	gl <- gList(background_grob, top_grob, bot_grob, gl_grob, mat_grob, border_grob)
	setChildren(x, gl)
}

pippedGrobFn <- function(
	rank_offset = 0,
	type = "die",
	grob_type = "circle",
	border = TRUE,
	mat = TRUE,
	background = TRUE,
	other_pips = NULL,
	fill_stroke = FALSE
) {
	force(type)
	force(rank_offset)
	force(grob_type)
	force(border)
	force(mat)
	force(background)
	force(other_pips)
	force(fill_stroke)
	function(piece_side, suit, rank, cfg = pp_cfg()) {
		cfg <- as_pp_cfg(cfg)
		opt <- cfg$get_piece_opt(piece_side, suit, rank)
		gTree(
			opt = opt,
			n_pips = rank + rank_offset,
			type = type,
			grob_type = grob_type,
			border = border,
			mat = mat,
			background = background,
			other_pips = other_pips + rank_offset,
			fill_stroke = fill_stroke,
			name = NULL,
			gp = gpar(),
			vp = NULL,
			cl = "pipped"
		)
	}
}

#' @export
makeContent.pipped <- function(x) {
	opt <- x$opt
	if (x$type == "card") {
		xya <- xya_pips_cards(x$n_pips)
	} else if (x$type == "die") {
		xya <- xya_pips_dominoes(x$n_pips, die = TRUE)
	} else if (x$type == "die_chinese") {
		xya <- xya_pips_dominoes(x$n_pips, die = TRUE, chinese = TRUE)
	} else if (x$type == "domino_chinese") {
		xya <- xya_pips_dominoes(x$n_pips, die = FALSE, chinese = TRUE, other_pips = x$other_pips)
	} else {
		xya <- xya_pips_dominoes(x$n_pips)
	}
	shape <- pp_shape(
		opt$shape,
		opt$shape_t,
		opt$shape_r,
		opt$back,
		width = opt$shape_w,
		height = opt$shape_h
	)

	# Background
	if (x$background) {
		background_grob <- shape$shape(
			gp = gpar(col = NA, fill = opt$background_color),
			name = "background"
		)
	} else {
		background_grob <- NULL
	}

	# Mat
	if (x$mat) {
		gp_mat <- gpar(col = NA, lwd = 0, fill = opt$mat_color)
		mat_grob <- shape$mat(opt$mat_width, gp = gp_mat, name = "mat")
	} else {
		mat_grob <- NULL
	}

	# Pips
	if (nrow(xya) > 0) {
		if (x$grob_type == "circle") {
			if (x$type == "die_chinese" && (x$n_pips == 1 || x$n_pips == 4)) {
				pip_color <- "#D55E00" # or just use "red"?
			} else if (x$type == "domino_chinese" && (x$n_pips == 1 || x$n_pips == 4)) {
				pip_color <- "#D55E00" # or just use "red"?
			} else if (x$type == "domino_chinese" && x$n_pips == 6 && x$other_pips == 6) {
				pip_color <- rep(c(opt$dm_color, "#D55E00"), 3L)
			} else {
				pip_color <- opt$dm_color
			}
			gp_pip <- gpar(col = pip_color, fill = pip_color)
			if (x$type != "card" && x$n_pips > 9) {
				r <- 0.06
			} else if (x$type == "die_chinese") {
				if (x$n_pips == 1) {
					r <- 0.20
				} else if (x$n_pips == 2) {
					r <- 0.10
				} else {
					r <- 0.10
				}
			} else if (x$type == "domino_chinese") {
				r <- 0.16
			} else {
				r <- 0.08
			}
			pip_grob <- circleGrob(x = xya$x, y = xya$y, r = r, gp = gp_pip, name = "pips")
		} else {
			gp_pip <- gpar(
				col = opt$dm_color,
				fontsize = opt$dm_fontsize,
				fontfamily = opt$dm_fontfamily,
				fontface = opt$dm_fontface
			)
			pip_grob <- textGrob(
				opt$dm_text,
				x = xya$x,
				y = xya$y,
				rot = xya$angle,
				gp = gp_pip,
				hjust = 0.5,
				vjust = 0.5,
				name = "pips"
			)
			if (isTRUE(x$fill_stroke)) {
				pip_grob <- as_fill_stroke_grob(pip_grob, fill = opt$dm_color)
			}
		}
	} else {
		pip_grob <- nullGrob(name = "pips")
	}

	# Border
	if (x$border) {
		gp_border <- gpar(col = opt$border_color, fill = NA, lex = opt$border_lex)
		border_grob <- shape$shape(gp = gp_border, name = "border")
	} else {
		border_grob <- NULL
	}

	gl <- gList(background_grob, mat_grob, pip_grob, border_grob)
	setChildren(x, gl)
}