LETTER_WIDTH <- 8.5
LETTER_HEIGHT <- 11
A4_WIDTH <- 8.27
A4_HEIGHT <- 11.69

#' Save piecepack print-and-play (PnP) file
#'
#' Save piecepack print-and-play (PnP) file
#'
#' @param cfg Piecepack configuration list or `pp_cfg` object
#' @param output_filename Filename for print-and-play file
#' @param size PnP output size (currently supports either "letter", "A4", or "A5").
#'             This is the targeted \dQuote{trim} size of the print-and-play file
#'             (`size_bleed` can be used to make the print-and-play file larger than this).
#'             "A5" is in \dQuote{portrait} mode whereas the other sizes are in \dQuote{landscape} mode.
#' @param pieces Character vector of desired PnP pieces.
#'        Supports "piecepack", "matchsticks", "pyramids", "subpack", or "all".
#'        If `NULL` and combination of `size` / `bleed` values supports "matchsticks" and "pyramids"
#'        then defaults to `c("piecepack", "pyramids", "matchsticks")` else just "piecepack".
#' @param arrangement Either "single-sided" or "double-sided".
#' @param quietly Whether to hide messages about missing metadata
#'                in the provided configuration.
#' @param ... Currently ignored.
#' @param bleed If `TRUE` produce a variant print-and-play file with "bleed" zones
#'              and "crop marks" around game pieces.
#'              Currently only supports `pieces = "piecepack"`.
#' @param size_bleed A list with names "top", "right", "bottom", "left"
#'                   containing numeric values indicating the inches "bleed" to add to
#'                   the `size` of the print-and-play layout.
#'                   The default `NULL` means no such bleed added to "letter", "A4", and "A5"
#'                   layouts.
#'                   NB. multiply millimeters by `0.0393700787` to convert to inches.
#'                   We currently don't support an asymmetric left/right bleed combined with
#'                   `arrangement = "double-sided"`.
#' @inheritParams render_piece
#' @examples
#' \donttest{# May take more than 5 seconds on CRAN servers
#' if (capabilities("cairo")) {
#'   cfg <- pp_cfg(list(invert_colors.suited=TRUE))
#'   cfg$description <- 'Piecepack with an "inverted" color scheme.'
#'   cfg$title <- '"Inverted" piecepack'
#'   cfg$copyright <- "\u00a9 2022 Trevor L Davis.  Some Right Reserved."
#'   cfg$spdx_id <- "CC-BY-4.0"
#'   cfg$credit <- ""
#'
#'   file <- tempfile("my_pnp_file", fileext = ".pdf")
#'   file_ds <- tempfile("my_pnp_file_ds", fileext = ".pdf")
#'   file_a4 <- tempfile("my_pnp_file_a4", fileext = ".pdf")
#'   file_a5 <- tempfile("my_pnp_file_a5", fileext = ".pdf")
#'
#'   save_print_and_play(cfg, file)
#'   save_print_and_play(cfg, file_ds, arrangement="double-sided")
#'   save_print_and_play(cfg, file_a4, size="A4", pieces="all")
#'   save_print_and_play(cfg, file_a5, size="A5")
#' }
#' }
#' @export
save_print_and_play <- function(
	cfg = getOption("piecepackr.cfg", pp_cfg()),
	output_filename = "piecepack.pdf",
	size = c("letter", "A4", "A5", "4x6"),
	pieces = NULL,
	arrangement = c("single-sided", "double-sided"),
	dev = NULL,
	dev.args = list(family = cfg$fontfamily, onefile = TRUE, units = "in", bg = "white", res = 300),
	quietly = FALSE,
	...,
	bleed = FALSE,
	size_bleed = NULL
) {
	opt <- options(piecepackr.op_scale = 0)
	on.exit(options(opt), add = TRUE)

	stopifnot(is.null(dev) || is.function(dev))
	size <- match.arg(size)
	if (size == "4x6") {
		warn(
			'`size = "4x6"` is deprecated.',
			class = "deprecatedWarning"
		)
	}
	arrangement <- match.arg(arrangement)
	if (is.null(pieces)) {
		if (size == "4x6" || bleed) {
			pieces <- "piecepack"
		} else {
			pieces <- c("piecepack", "pyramids", "matchsticks")
		}
	}
	if ("all" %in% pieces) {
		pieces <- c("piecepack", "pyramids", "matchsticks", "subpack")
	}
	if (is.null(size_bleed)) {
		if (size == "4x6") {
			size_bleed <- list(top = 1 / 16, right = 3 / 32, bottom = 1 / 16, left = 3 / 32)
		} else {
			size_bleed <- list(top = 0, right = 0, bottom = 0, left = 0)
		}
	}
	stopifnot(
		all(c("top", "right", "bottom", "left") %in% names(size_bleed)),
		all(sapply(size_bleed, is.numeric)),
		arrangement == "single-sided" || size_bleed$left == size_bleed$right
	)

	cfg <- as_pp_cfg(cfg)
	current_dev <- grDevices::dev.cur()
	if (current_dev > 1) {
		on.exit(grDevices::dev.set(current_dev), add = TRUE)
	}
	height <- switch(size, letter = LETTER_WIDTH, A4 = A4_WIDTH, A5 = A4_WIDTH, `4x6` = 4) +
		size_bleed$top +
		size_bleed$bottom
	width <- switch(size, letter = LETTER_HEIGHT, A4 = A4_HEIGHT, A5 = A4_HEIGHT / 2, `4x6` = 6) +
		size_bleed$right +
		size_bleed$left

	if (is.null(dev)) {
		dev <- pp_device_fn(output_filename)
	}

	args <- list(filename = output_filename, width = width, height = height)
	args <- c(args, dev.args)
	args <- args[names(args) %in% names(formals(dev))]
	onefile <- has_onefile(dev, args)
	if (!onefile && !has_c_integer_format(output_filename)) {
		abort(paste(
			"`save_print_and_play()` generates multiple pages.",
			'Either `dev` needs to support `onefile` and `isTRUE(dev.args[["onefile"]])`',
			"or else `output_filename` needs a C integer format in the string."
		))
	}
	do.call(dev, args)

	pl <- switch(
		size,
		`4x6` = print_and_play_4x6(cfg, pieces, quietly, bleed, size_bleed),
		print_and_play_paper(cfg, size, pieces, arrangement, quietly, bleed, size_bleed)
	)

	invisible(grDevices::dev.off())

	if (onefile && tools::file_ext(output_filename) == "pdf") {
		if (requireNamespace("xmpdf", quietly = TRUE)) {
			add_pdf_metadata(output_filename, cfg, pl)
		} else if (!isFALSE(getOption("piecepackr.metadata.inform"))) {
			msg <- c(
				x = "Need the {xmpdf} package to embed pdf metadata",
				i = '`install.packages("xmpdf")`',
				i = "These messages can be disabled via `options(piecepackr.metadata.inform = FALSE)`."
			)
			inform(msg, class = "piecepackr_embed_metadata")
		}
	}
	invisible(NULL)
}

has_onefile <- function(dev, args) {
	hasName(formals(dev), "onefile") && isTRUE(args[["onefile"]])
}
has_c_integer_format <- function(filename) {
	grepl("%[[:digit:]]+d", filename)
}

add_pdf_metadata <- function(output_filename, cfg = pp_cfg(), pl = list()) {
	assert_suggested("xmpdf")

	if (xmpdf::supports_set_docinfo()) {
		docinfo <- xmpdf::docinfo(
			title = cfg$title,
			creator = paste0("piecepackr v", packageDescription("piecepackr")$Version),
			subject = paste(cfg$description, collapse = "\n"),
			keywords = "piecepack"
		)
		xmpdf::set_docinfo(docinfo, output_filename)
	} else if (!isFALSE(getOption("piecepackr.metadata.inform"))) {
		msg <- c(
			x = "Unable to embed pdf documentation info metadata",
			xmpdf::enable_feature_message("set_docinfo"),
			i = "These messages can be disabled via `options(piecepackr.metadata.inform = FALSE)`."
		)
		inform(msg, class = "piecepackr_embed_metadata")
	}

	if (xmpdf::supports_set_bookmarks()) {
		starting_pages <- head(c(1, 1 + cumsum(sapply(pl, identity))), -1)
		bookmarks <- data.frame(title = names(pl), page = starting_pages, stringsAsFactors = FALSE)
		xmpdf::set_bookmarks(bookmarks, output_filename)
	} else if (!isFALSE(getOption("piecepackr.metadata.inform"))) {
		msg <- c(
			x = "Unable to embed pdf bookmarks metadata",
			xmpdf::enable_feature_message("set_bookmarks"),
			i = "These messages can be disabled via `options(piecepackr.metadata.inform = FALSE)`."
		)
		inform(msg, class = "piecepackr_embed_metadata")
	}

	if (xmpdf::supports_set_xmp()) {
		x <- xmpdf::xmp(
			title = cfg$title,
			creator_tool = paste0("piecepackr v", packageDescription("piecepackr")$Version),
			description = paste(cfg$description, collapse = "\n"),
			keywords = "piecepack",
			subject = "piecepack",
			rights = cfg$copyright,
			spdx_id = cfg$spdx_id
		)
		xmpdf::set_xmp(x, output_filename)
	} else if (!isFALSE(getOption("piecepackr.metadata.inform"))) {
		msg <- c(
			x = "Unable to embed pdf XMP metadata",
			xmpdf::enable_feature_message("set_xmp"),
			i = "These messages can be disabled via `options(piecepackr.metadata.inform = FALSE)`."
		)
		inform(msg, class = "piecepackr_embed_metadata")
	}
}

print_and_play_paper <- function(cfg, size, pieces, arrangement, quietly, bleed, size_bleed) {
	if (bleed) {
		print_and_play_paper_bleed(cfg, size, pieces, arrangement, quietly, size_bleed)
	} else {
		print_and_play_paper_compact(cfg, size, pieces, arrangement, quietly, size_bleed)
	}
}
