R/utils-pnp-letter-bleed.R

In piecepackr: Board Game Graphics

print_and_play_paper_bleed <- function(cfg, size, pieces, arrangement, quietly, size_bleed) {
	n_suits <- cfg$n_suits
	n_ranks <- cfg$n_ranks

	stopifnot(n_ranks <= 6)
	if ("matchsticks" %in% pieces) {
		abort('"matchsticks" `pieces` not currently supported for `bleed = TRUE`')
	}
	if ("pyramids" %in% pieces) {
		abort('"pyramids" `pieces` not currently supported for `bleed = TRUE`')
	}
	if ("subpack" %in% pieces) {
		abort('"subpack" `pieces` not currently supported for `bleed = TRUE`')
	}

	if (size == "letter") {
		xl <- inch(LETTER_HEIGHT / 2 - A5W / 2 + size_bleed$left)
		xr <- inch(LETTER_HEIGHT / 2 + A5W / 2 + size_bleed$left)
		y <- inch(LETTER_WIDTH / 2 + size_bleed$bottom)
	} else if (size == "A4") {
		xl <- inch(A4_HEIGHT / 2 - A5W / 2 + size_bleed$left)
		xr <- inch(A4_HEIGHT / 2 + A5W / 2 + size_bleed$left)
		y <- inch(A4_WIDTH / 2 + size_bleed$bottom)
	} else {
		# size is "A5"
		xl <- inch(A5W / 2 + size_bleed$left)
		xr <- inch(A5W / 2 + size_bleed$left)
		y <- inch(A5H / 2 + size_bleed$bottom)
	}

	vpl <- viewport(x = xl, y = y, width = inch(A5W), height = inch(A5H))
	vpr <- viewport(x = xr, y = y, width = inch(A5W), height = inch(A5H))
	gl <- list()
	pl <- list()

	## Front Matter
	gl <- gappend(gl, a5_title_grob(cfg, pieces, quietly, bleed = TRUE))
	gl <- gappend(gl, a5_inst_grob_bleed(cfg, pieces, arrangement, size))
	if (arrangement == "double-sided" && size != "A5") {
		gl <- gappend(gl, blank_grob)
		gl <- gappend(gl, blank_grob)
		pl[["Front Matter"]] <- 2
	} else {
		pl[["Front Matter"]] <- 1
	}

	## Piecepack
	if ("piecepack" %in% pieces) {
		n_pages_tiles <- n_suits
		if (is_odd(n_pages_tiles) && arrangement == "double-sided" && size != "A5") {
			n_pages_tiles <- n_pages_tiles + 1
		}
		for (suit in seq(n_pages_tiles)) {
			gl <- gappend(gl, a5_tile_grob(suit, cfg, TRUE, arrangement, size))
			gl <- gappend(gl, a5_tile_grob(suit, cfg, FALSE, arrangement, size))
		}
		pl$Tiles <- n_pages_tiles

		n_pages_coins <- (n_suits - 1) %/% 4 + 1
		for (ii in seq(n_pages_coins)) {
			ss <- seq(4 * ii - 3, 4 * ii)
			gl <- gappend(gl, a5_coin_grob(ss, cfg, TRUE, arrangement, size))
			gl <- gappend(gl, a5_coin_grob(ss, cfg, FALSE, arrangement, size))
		}
		if (is_odd(n_pages_coins) && arrangement == "double-sided" && size != "A5") {
			n_pages_coins <- n_pages_coins + 1
			ss <- 1:4
			gl <- gappend(gl, a5_coin_grob(ss, cfg, TRUE, arrangement, size))
			gl <- gappend(gl, a5_coin_grob(ss, cfg, FALSE, arrangement, size))
		}
		pl$Coins <- n_pages_coins

		n_pages_dice <- (n_suits - 1) %/% 4 + 1
		for (ii in seq(n_pages_dice)) {
			ss <- seq(4 * ii - 3, 4 * ii)
			if (arrangement == "double-sided" && size == "A5") {
				gl <- gappend(gl, a5_die_grob(ss, cfg, TRUE, arrangement))
				gl <- gappend(gl, blank_grob)
				gl <- gappend(gl, a5_pawn_grob(ss, cfg, TRUE, arrangement))
				gl <- gappend(gl, blank_grob)
			} else {
				gl <- gappend(gl, a5_die_grob(ss, cfg, TRUE, arrangement))
				gl <- gappend(gl, a5_pawn_grob(ss, cfg, FALSE, arrangement))
				if (arrangement == "double-sided") {
					gl <- gappend(gl, blank_grob)
					gl <- gappend(gl, blank_grob)
				}
			}
		}
		if (arrangement == "double-sided") {
			n_pages_dice <- 2 * n_pages_dice
		}
		pl$`Dice and Pawns` <- n_pages_dice
	}
	if (size == "A5") {
		pl <- lapply(pl, function(x) 2 * x)
	}
	for (ii in seq(gl)) {
		if (is_odd(ii)) {
			grid.newpage()
			draw_a5_page(gl[[ii]], vpl)
		} else {
			if (size == "A5") {
				grid.newpage()
			}
			draw_a5_page(gl[[ii]], vpr)
		}
	}

	pl
}

a5_inst_grob_bleed <- function(cfg, pieces, arrangement, size) {
	y_inst <- unit(1, "npc") - unit(0.2, "in")
	inst <- c("\u25cf See https://www.ludism.org/ppwiki/MakingPiecepacks for general advice")

	# Settings
	components <- paste(paste0('"', pieces, '"'), collapse = ", ")
	if (TRUE) {
		arrangement <- sprintf('\t\u25cb "%s" arrangement with "bleed" zones', arrangement)
	}
	inst <- c(
		inst,
		"\u25cf This print-and-play layout was generated for:",
		sprintf('\t\u25cb %s components', components),
		arrangement,
		sprintf('\t\u25cb "%s" paper size', size)
	)

	# Tiles
	tile_crop <- c('\t\u25cb Use "crop" marks as guide to where to cut them out')
	if (size == "a5") {
		inst <- c(
			inst,
			'\u25cf For each suit we have a page of tile "faces" then a page of tile "backs"',
			tile_crop,
			'\t\u25cb May place whole sheet on one side and next sheet on the opposite side',
			'\t\t of target material before cutting out'
		)
	} else {
		inst <- c(
			inst,
			'\u25cf We have a page of tiles for each suit: "faces" on left and "backs" on right',
			tile_crop,
			'\t\u25cb Central "gutter" line may help place sheet on both sides of target material',
			'\t\t  Line up "gutter" line on the center of edge of target material, fold,',
			'\t\t  and cut tiles out.',
			'\t\u25cb Alternatively place whole sheet on one side and another on the opposite side'
		)
	}

	# Coins
	coin_crop <- c(
		'\t\u25cb For those lacking circular cutting tools one may use "crop" marks',
		'\t\t as guide to cut out (inferior) square coins',
		'\t\u25cb Otherwise use "crop" marks to help center placement of circular cutting tool'
	)
	if (size == "a5") {
		inst <- c(
			inst,
			"\u25cf We have a page of coin faces then a page of coin backs (per 4 suits)",
			coin_crop
		)
	} else {
		inst <- c(
			inst,
			'\u25cf We have a page of coins (per 4 suits): "backs" on left and "faces" on right',
			coin_crop,
			'\t\u25cb Central "gutter" line may help place sheet on both sides of target material',
			'\t\t  Line up "gutter" line on the center of edge of target material, fold,',
			'\t\t  and cut coins out.',
			'\t\u25cb Alternatively place whole sheet on one side and a copy on the opposite side'
		)
	}

	# Dice and Pawns
	dice_crop <- c(
		'\t\u25cb Depending on size of target dice use inner or outer "crop" marks',
		'\t\t as guide to cut out dice',
		'\t\u25cb Alternatively use "crop" marks to help center placement of circular cutting tool',
		'\t\u25cb Use "crop" marks to cut out pawn "belts"',
		'\t\u25cb Use "crop" marks to cut out pawn "tokens" (depending on shape of token)',
		'\t\t "gutter" line can be used to help place pawn "tokens" on both sides',
		'\t\t  of target material ("gutter" line on center of edge of target material)'
	)
	if (size == "a5") {
		inst <- c(
			inst,
			"\u25cf We have a page of dice faces then a page of pawn belts and pawn tokens (per 4 suits)",
			dice_crop
		)
	} else {
		inst <- c(
			inst,
			'\u25cf We have a page of dice faces, pawn belts, and pawn tokens (per 4 suits):',
			'\t\u25cb Dice faces on left, pawn "belts" on top right, pawn "tokens" on bottom right',
			dice_crop
		)
	}

	inst <- paste(inst, collapse = "\n")

	gTree(
		name = "instructions",
		children = gList(
			# rectGrob(gp=gpar(fill="grey90")),
			textGrob(
				"Instructions",
				x = unit(0.5, "cm"),
				y = y_inst,
				just = "left",
				gp = gp_header
			),
			textGrob(
				inst,
				x = unit(0.5, "cm"),
				y = y_inst - unit(0.2, "in"),
				just = c(0, 1),
				gp = gp_text
			)
		)
	)
}

a5_tile_grob <- function(i_suit, cfg, front, arrangement, size) {
	tile_width <- cfg$get_width("tile_back")
	xtr <- 0.5 * tile_width + 1 / 8 + 1 / 8
	xtl <- xtr + tile_width + 1 / 4

	content_height <- 3 * tile_width + 3 / 4
	ytb <- 0.5 * tile_width + 1 / 8 + (A5H - content_height) / 2
	ytm <- ytb + tile_width + 1 / 4
	ytt <- ytm + tile_width + 1 / 4

	df <- tibble::tibble(
		piece_side = "tile_face",
		x = rep(c(xtr, xtl), 3),
		y = rep(c(ytt, ytm, ytb), each = 2),
		suit = i_suit,
		rank = 1:6
	)

	if (!front) {
		df$piece_side = "tile_back"
		df$x <- A5W - df$x
		# Rotate tile backs to partially hide direction of face if tile back are not fully symmetric
		df$angle <- 90 * ((df$suit + df$rank) %% 4)
	}
	if (!front && size != "A5") {
		vline <- linesGrob(x = 0, gp = gpar(lty = "dashed"))
	} else {
		vline <- nullGrob()
	}

	cm_grob <- pmap_piece(
		df,
		cropmarkGrob,
		cfg = cfg,
		default.units = "in",
		bleed = TRUE,
		draw = FALSE
	)
	ps_grob <- pmap_piece(
		df,
		pieceGrob,
		cfg = cfg,
		default.units = "in",
		bleed = TRUE,
		draw = FALSE
	)

	ch_size <- 1 / 4
	side_x <- if (front) xtr - tile_width / 2 else A5W - xtr + tile_width / 2
	top_y <- ytt + tile_width / 2 + 1 / 4
	bottom_y <- ytb - tile_width / 2 - 1 / 4
	reg_grob <- gList(
		circledSegmentsCrosshairGrob(
			x = inch(side_x),
			y = inch(top_y),
			width = inch(ch_size),
			height = inch(ch_size)
		),
		squaredSegmentsCrosshairGrob(
			x = inch(side_x),
			y = inch(bottom_y),
			width = inch(ch_size),
			height = inch(ch_size)
		)
	)

	gList(cm_grob, ps_grob, vline, reg_grob)
}

a5_coin_grob <- function(suit, cfg, front, arrangement, size) {
	coin_width <- cfg$get_width("coin_back")
	xt1 <- 0.5 * coin_width + 1 / 8 + 1 / 8
	xt2 <- xt1 + coin_width + 1 / 4 + 1 / 8
	xt3 <- xt2 + coin_width + 1 / 4 + 1 / 8
	xt4 <- xt3 + coin_width + 1 / 4 + 1 / 8

	content_height <- 5 * (coin_width + 1 / 4 + 1 / 8) + coin_width + 1 / 4
	yt1 <- 0.5 * coin_width + 1 / 8 + (A5H - content_height) / 2
	yt2 <- yt1 + coin_width + 1 / 4 + 1 / 8
	yt3 <- yt2 + coin_width + 1 / 4 + 1 / 8
	yt4 <- yt3 + coin_width + 1 / 4 + 1 / 8
	yt5 <- yt4 + coin_width + 1 / 4 + 1 / 8
	yt6 <- yt5 + coin_width + 1 / 4 + 1 / 8

	df <- tibble::tibble(
		piece_side = "coin_back",
		x = rep(c(xt1, xt2, xt3, xt4), each = 6),
		y = rep(c(yt1, yt2, yt3, yt4, yt5, yt6), 4),
		suit = rep(suit, each = 6),
		rank = rep(1:6, 4)
	)

	if (!front) {
		df$piece_side = "coin_face"
		df$x <- A5W - df$x
	} else {
		# Rotate coin faces to desired direction
		df$angle <- cfg$coin_arrangement
	}
	if (!front && size != "A5") {
		vline <- linesGrob(x = 0, gp = gpar(lty = "dashed"))
	} else {
		vline <- nullGrob()
	}

	cm_grob <- pmap_piece(
		df,
		cropmarkGrob,
		cfg = cfg,
		default.units = "in",
		bleed = TRUE,
		draw = FALSE
	)
	ps_grob <- pmap_piece(
		df,
		pieceGrob,
		cfg = cfg,
		default.units = "in",
		bleed = TRUE,
		draw = FALSE
	)

	ch_size <- 1 / 4
	side_x <- if (front) xt1 - coin_width / 2 - 1 / 8 else A5W - xt1 + coin_width / 2 + 1 / 8
	top_y <- yt6 + coin_width / 2 + 1 / 4
	bottom_y <- yt1 - coin_width / 2 - 1 / 4
	reg_grob <- gList(
		circledSegmentsCrosshairGrob(
			x = inch(side_x),
			y = inch(top_y),
			width = inch(ch_size),
			height = inch(ch_size)
		),
		squaredSegmentsCrosshairGrob(
			x = inch(side_x),
			y = inch(bottom_y),
			width = inch(ch_size),
			height = inch(ch_size)
		)
	)

	gList(cm_grob, ps_grob, vline, reg_grob)
}

a5_die_grob <- function(suit, cfg, front, arrangement) {
	die_width <- cfg$get_width("die_face")
	xt1 <- 0.5 * 3 / 4 + 1 / 8 + 1 / 8
	xt2 <- xt1 + 3 / 4 + 1 / 4 + 1 / 8
	xt3 <- xt2 + 3 / 4 + 1 / 4 + 1 / 8
	xt4 <- xt3 + 3 / 4 + 1 / 4 + 1 / 8

	content_height <- 5 * (3 / 4 + 1 / 4 + 1 / 8) + 3 / 4 + 1 / 4
	yt1 <- 0.5 * 3 / 4 + 1 / 8 + (A5H - content_height) / 2
	yt2 <- yt1 + 3 / 4 + 1 / 4 + 1 / 8
	yt3 <- yt2 + 3 / 4 + 1 / 4 + 1 / 8
	yt4 <- yt3 + 3 / 4 + 1 / 4 + 1 / 8
	yt5 <- yt4 + 3 / 4 + 1 / 4 + 1 / 8
	yt6 <- yt5 + 3 / 4 + 1 / 4 + 1 / 8

	df <- tibble::tibble(
		piece_side = "die_face",
		x = rep(c(xt1, xt2, xt3, xt4), each = 6),
		y = rep(c(yt1, yt2, yt3, yt4, yt5, yt6), 4),
		suit = rep(suit, each = 6),
		rank = rep(1:6, 4)
	)

	if (!front) {
		df$x <- A5W - df$x
	}

	cm_grob1 <- pmap_piece(
		df,
		cropmarkGrob,
		cfg = cfg,
		default.units = "in",
		width = die_width,
		height = die_width,
		bleed = (3 / 4 - die_width) / 2 + 1 / 8,
		draw = FALSE
	)
	cm_grob2 <- pmap_piece(
		df,
		cropmarkGrob,
		cfg = cfg,
		default.units = "in",
		width = 3 / 4,
		height = 3 / 4,
		bleed = 1 / 8,
		draw = FALSE
	)
	ps_grob <- pmap_piece(
		df,
		pieceGrob,
		cfg = cfg,
		default.units = "in",
		bleed = (3 / 4 - die_width) / 2 + 1 / 8,
		draw = FALSE
	)
	gList(cm_grob1, cm_grob2, ps_grob)
}

a5_pawn_grob <- function(suit, cfg, front, arrangement) {
	belt_width <- cfg$get_width("belt_face")
	pawn_width <- cfg$get_width("pawn_face")
	pawn_height <- cfg$get_height("pawn_face")

	x <- A5W * (1:4 / 4 - 1 / 8)
	yb <- A5H - (0.5 * belt_width + 1 / 8 + 1 / 8)

	ys <- 0.5 * A5H

	df_b <- tibble::tibble(piece_side = "belt_face", x = x, suit = suit, y = yb, angle = 90)

	# Center token group in space below belt, leaving equal margin for registration marks
	avail <- yb - belt_width / 2 - 1 / 8
	ypb <- avail / 2 - pawn_height / 2 - 3 / 8
	ypt <- (ypb + 0.5 * pawn_height + 1 / 8) + 1 / 2 + (1 / 8 + 0.5 * pawn_height) # 1/2" gutter = jumbo domino

	if (!front) {
		df_pb <- tibble::tibble(piece_side = "pawn_back", x = x, suit = suit, y = ypb, angle = 180)
		df_pt <- tibble::tibble(piece_side = "pawn_face", x = x, suit = suit, y = ypt, angle = 0)

		# df_s <- tibble::tibble(piece_side = "saucer_face",
		#                        x = x, suit = suit, y = ys, angle = 0)
		df <- rbind(df_b, df_pb, df_pt)

		df$x <- A5W - df$x
	} else {
		df_pb <- tibble::tibble(piece_side = "pawn_face", x = x, suit = suit, y = ypb, angle = 180)
		df_pt <- tibble::tibble(piece_side = "pawn_back", x = x, suit = suit, y = ypt, angle = 0)

		# df_s <- tibble::tibble(piece_side = "saucer_back",
		#                        x = x, suit = suit, y = ys, angle = 0)
		df <- rbind(df_b, df_pb, df_pt)
	}

	hline <- linesGrob(y = inch(0.5 * (ypb + ypt)), gp = gpar(lty = "dashed"))

	cm_grob <- pmap_piece(
		df,
		cropmarkGrob,
		cfg = cfg,
		default.units = "in",
		bleed = TRUE,
		draw = FALSE
	)
	ps_grob <- pmap_piece(
		df,
		pieceGrob,
		cfg = cfg,
		default.units = "in",
		bleed = TRUE,
		draw = FALSE
	)

	ch_size <- 1 / 4
	left_x <- x[1] - pawn_width / 2
	right_x <- x[length(x)] + pawn_width / 2
	top_y <- ypt + pawn_height / 2 + 1 / 4
	bottom_y <- ypb - pawn_height / 2 - 1 / 4
	reg_grob <- gList(
		circledSegmentsCrosshairGrob(
			x = inch(left_x),
			y = inch(top_y),
			width = inch(ch_size),
			height = inch(ch_size)
		),
		squaredSegmentsCrosshairGrob(
			x = inch(right_x),
			y = inch(top_y),
			width = inch(ch_size),
			height = inch(ch_size)
		),
		circledSegmentsCrosshairGrob(
			x = inch(left_x),
			y = inch(bottom_y),
			width = inch(ch_size),
			height = inch(ch_size)
		),
		squaredSegmentsCrosshairGrob(
			x = inch(right_x),
			y = inch(bottom_y),
			width = inch(ch_size),
			height = inch(ch_size)
		)
	)

	gList(cm_grob, ps_grob, hline, reg_grob)
}