R/utils-pnp-letter-both.R

In piecepackr: Board Game Graphics

## Shared "paper" utilities

A5W <- 5 # 5.83"
A5H <- 7.5 # 8.27"
a5_vp <- function() viewport(width = unit(A5W, "in"), height = unit(A5H, "in"))

draw_a5_page <- function(grob, vp) {
	pushViewport(vp)
	grid.draw(grob)
	upViewport()
}

blank_grob <- textGrob("Intentionally left blank")

is_odd <- function(x) as.logical(x %% 2)

gappend <- function(ll, g) {
	ll[[length(ll) + 1]] <- g
	ll
}

gp_title <- gpar(fontsize = 15, fontfamily = "sans", fontface = "bold")
gp_header <- gpar(fontsize = 12, fontfamily = "sans", fontface = "bold")
gp_text <- gpar(fontsize = 9, fontfamily = "sans")

htg <- function(label, x, y, just = "center", ...) {
	textGrob(label, x = inch(x), y = inch(y), just = just, gp = gp_header, ...)
}
tg <- function(label, x, y, just = "center", ...) {
	textGrob(label, x = inch(x), y = inch(y), just = just, gp = gp_text, ...)
}

a5_title_grob <- function(cfg, pieces, quietly, extra_credit = TRUE, bleed = FALSE) {
	# Title
	y_title <- unit(1, "npc") - unit(0.2, "in")
	if (is.null(cfg$title)) {
		if (!quietly) {
			inform("`cfg$title` is `NULL`, omitting title", class = "piecepackr_missing_metadata")
		}
		grob_title <- nullGrob()
	} else {
		grob_title <- textGrob(
			cfg$title,
			y = y_title,
			just = "center",
			gp = gp_title,
			name = "title"
		)
	}

	# Description
	y_description <- y_title - grobHeight(grob_title) - unit(0.2, "in")
	if (is.null(cfg$description)) {
		if (!quietly) {
			inform(
				"`cfg$description` is `NULL`, omitting description",
				class = "piecepackr_missing_metadata"
			)
		}
		grob_description <- nullGrob()
	} else {
		dtext <- paste(strwrap(cfg$description, 72), collapse = "\n")
		grob_description <- textGrob(
			dtext,
			x = 0.1,
			y = y_description,
			just = c(0, 1),
			gp = gp_text,
			name = "description"
		)
	}

	# License
	y_license <- y_description - grobHeight(grob_description) - unit(0.2, "in")
	if (is.null(cfg$spdx_id)) {
		if (!quietly) {
			inform(
				"`cfg$spdx_id` is `NULL`, omitting license",
				class = "piecepackr_missing_metadata"
			)
		}
		grob_license <- grob_lh <- grob_l <- nullGrob()
	} else {
		stopifnot(cfg$spdx_id %in% piecepackr::spdx_license_list$id)
		url <- piecepackr::spdx_license_list[cfg$spdx_id, "url_alt"]
		if (is.na(url)) {
			url <- piecepackr::spdx_license_list[cfg$spdx_id, "url"]
		}
		full_name <- piecepackr::spdx_license_list[cfg$spdx_id, "name"]
		license <- paste(c(paste("\u25cf", full_name), paste("\t", url)), collapse = "\n")
		grob_lh <- textGrob("License", x = 0.1, y = y_license, just = "left", gp = gp_header)
		badge <- piecepackr::spdx_license_list[cfg$spdx_id, "badge"]
		if (is.na(badge)) {
			grob_cc <- nullGrob()
		} else {
			cc_file <- system.file(paste0("extdata/badges/", badge), package = "piecepackr")
			current_dev <- grDevices::dev.cur() # Workaround for {grImport2} v0.2-0 bug
			cc_picture <- grImport2::readPicture(cc_file)
			if (current_dev > 1) {
				grDevices::dev.set(current_dev)
			}
			grob_cc <- grImport2::symbolsGrob(cc_picture, x = 0.50, y = 0.05, size = inch(0.9))
		}
		grob_l <- textGrob(
			license,
			x = 0.1,
			y = y_license - unit(0.2, "in"),
			just = c(0, 1),
			gp = gp_text
		)

		grob_license <- grobTree(grob_lh, grob_l, grob_cc, name = "license")
	}

	# Copyright
	y_copyright <- y_license - grobHeight(grob_lh) - grobHeight(grob_l) - unit(0.3, "in")
	if (is.null(cfg$copyright) && !quietly) {
		if (!quietly) {
			inform(
				"`cfg$copyright` is `NULL`, omitting copyright",
				class = "piecepackr_missing_metadata"
			)
		}
	}
	if (is.null(cfg$copyright) || cfg$copyright == "") {
		grob_copyright <- grob_ch <- grob_c <- nullGrob()
	} else {
		copyright <- paste(cfg$copyright, collapse = "\n")
		grob_ch <- textGrob("Copyright", x = 0.1, y = y_copyright, just = "left", gp = gp_header)
		grob_c <- textGrob(
			copyright,
			x = 0.1,
			y = y_copyright - unit(0.2, "in"),
			just = c(0, 1),
			gp = gp_text
		)
		grob_copyright <- grobTree(grob_ch, grob_c, name = "copyright")
	}

	# Credits
	y_credits <- y_copyright - grobHeight(grob_ch) - grobHeight(grob_c) - unit(0.3, "in")
	if (is.null(cfg$credit) && !quietly) {
		inform(
			"`cfg$credit` is `NULL`, omitting custom credits",
			class = "piecepackr_missing_metadata"
		)
	}
	credits <- c(
		"\u25cf This print-and-play layout was generated by piecepackr.",
		"\thttps://github.com/piecepackr/piecepackr"
	)
	if (extra_credit) {
		if ("piecepack" %in% pieces) {
			credits <- c(
				credits,
				'\u25cf The piecepack was invented by James "Kyle" Droscha. Public Domain.',
				"\thttps://ludism.org/ppwiki/AnatomyOfAPiecepack"
			)
		}
		if (!bleed && "piecepack" %in% pieces) {
			credits <- c(
				credits,
				"\u25cf Pawn saucers were invented by Karol M. Boyle. Public Domain.",
				"\thttps://web.archive.org/web/2018/http://www.piecepack.org/Accessories.html"
			)
		}
		if ("pyramids" %in% pieces) {
			credits <- c(
				credits,
				"\u25cf Piecepack pyramids were invented by Tim Schutz. Public Domain.",
				"\thttps://www.ludism.org/ppwiki/PiecepackPyramids"
			)
		}
		if ("matchsticks" %in% pieces) {
			credits <- c(
				credits,
				"\u25cf Piecepack matchsticks were invented by Dan Burkey. Public Domain.",
				"\thttps://www.ludism.org/ppwiki/PiecepackMatchsticks"
			)
		}
	} else {
		credits <- c(
			credits,
			'\u25cf The piecepack was invented by James "Kyle" Droscha. Public Domain.',
			"\thttps://ludism.org/ppwiki/AnatomyOfAPiecepack"
		)
	}
	credits <- paste(c(credits, cfg$credit), collapse = "\n")
	grob_credits <- gTree(
		name = "credits",
		children = gList(
			textGrob("Credits", x = 0.1, y = y_credits, just = "left", gp = gp_header),
			textGrob(
				credits,
				x = 0.1,
				y = y_credits - unit(0.2, "in"),
				just = c(0, 1),
				gp = gp_text
			)
		)
	)

	grobTree(
		grob_title,
		grob_description,
		grob_license,
		grob_copyright,
		grob_credits,
		name = "title_page",
		vp = a5_vp()
	)
}