#' Draw crosshairs with grid
#'
#' `grid.crosshair()` draws crosshairs at the corners of a rectangular area.
#' `crosshairGrob()` is its grid grob counterpart.
#' They are intended for use in adding crosshairs at the corners of
#' game pieces in print-and-play layouts.
#' One can also use the lower level
#' `circledSegmentsCrosshairGrob()`, `segmentsCrosshairGrob()`, `squaredSegmentsCrosshairGrob()`, and `squaresCrosshairGrob()`
#' (which can be drawn with [grid::grid.draw()])
#' to add individual crosshairs to specified (x,y) locations (e.g. for use as registration marks).
#' @inheritParams pieceGrob
#' @param ch_width Width/height of `ch_grob`'s viewport.
#' @param ch_grob Crosshair grob.  Will be drawn in each corner of the piece in a viewport with `ch_width` width and `ch_width` height.
#'                `segmentsCrosshairGrob()` simply wraps [grid::segmentsGrob()].
#'                `circledSegmentsCrosshairGrob()` wraps [grid::segmentsGrob()] and [grid::circleGrob()].
#'                `squaredSegmentsCrosshairGrob()` wraps [grid::segmentsGrob()] and [grid::rectGrob()].
#'                `squaresCrosshairGrob()` wraps [grid::rectGrob()] and alternates
#'                 black/white squares for visibility on both light and dark backgrounds.
#' @return A grid grob.
#' @examples
#' if (requireNamespace("grid", quietly = TRUE) &&
#'     piecepackr:::device_supports_unicode()) {
#'   cfg <- pp_cfg(list(border_color = NA))
#'   grid::grid.newpage()
#'   df <- data.frame(piece_side = "tile_face", suit = 2, rank = 2,
#'                    x = 2, y = 2, angle = 0,
#'                    stringsAsFactors = FALSE)
#'   pmap_piece(df, grid.piece, cfg = cfg, default.units = "in")
#'   pmap_piece(df, grid.crosshair, cfg = cfg, default.units = "in")
#' }
#' if (requireNamespace("grid", quietly = TRUE) &&
#'     piecepackr:::device_supports_unicode()) {
#'   grid::grid.newpage()
#'   pmap_piece(df, grid.piece, cfg = cfg, default.units = "in")
#'   pmap_piece(df, grid.crosshair, cfg = cfg, default.units = "in",
#'              ch_grob = segmentsCrosshairGrob())
#' }
#' if (requireNamespace("grid", quietly = TRUE)) {
#'   grid::grid.newpage()
#'   fns <- list(squaresCrosshairGrob, segmentsCrosshairGrob,
#'               circledSegmentsCrosshairGrob, squaredSegmentsCrosshairGrob)
#'   labels <- c("squaresCrosshairGrob()", "segmentsCrosshairGrob()",
#'               "circledSegmentsCrosshairGrob()", "squaredSegmentsCrosshairGrob()")
#'   xs <- c(0.25, 0.75, 0.25, 0.75)
#'   ys <- c(0.70, 0.70, 0.30, 0.30)
#'   label_ys <- c(0.55, 0.55, 0.15, 0.15)
#'   for (i in seq_along(fns)) {
#'     grid::grid.draw(fns[[i]](x = grid::unit(xs[i], "npc"),
#'                              y = grid::unit(ys[i], "npc"),
#'                              width = grid::unit(0.15, "npc"),
#'                              height = grid::unit(0.15, "npc")))
#'     grid::grid.text(labels[i], x = xs[i], y = label_ys[i], gp = grid::gpar(cex = 0.7))
#'   }
#' }
#' @name grid.crosshair
NULL

#' @rdname grid.crosshair
#' @export
crosshairGrob <- function(
	...,
	piece_side = "tile_back",
	suit = NA,
	rank = NA,
	cfg = getOption("piecepackr.cfg", pp_cfg()),
	x = unit(0.5, "npc"),
	y = unit(0.5, "npc"),
	angle = 0,
	width = NA,
	height = NA,
	scale = 1,
	default.units = "npc",
	envir = getOption("piecepackr.envir"),
	name = NULL,
	gp = gpar(),
	vp = NULL,
	ch_width = unit(1 / 6, "in"),
	ch_grob = squaresCrosshairGrob()
) {
	if (is.na(width) || is.na(height)) {
		cfg <- get_cfg(cfg, envir)
		rank <- impute_rank(piece_side, rank, cfg)
		suit <- impute_suit(piece_side, suit, cfg)
		if (is.na(width)) {
			width <- inch(cfg$get_width(piece_side, suit, rank))
		}
		if (is.na(height)) height <- inch(cfg$get_height(piece_side, suit, rank))
	}

	if (is_angle(angle)) {
		angle <- as.double(angle, "degrees")
	}

	if (!is.unit(x)) {
		x <- unit(x, default.units)
	}
	if (!is.unit(y)) {
		y <- unit(y, default.units)
	}
	if (!is.unit(width)) {
		width <- unit(width, default.units)
	}
	if (!is.unit(height)) {
		height <- unit(height, default.units)
	}
	if (!is.unit(ch_width)) {
		ch_width <- unit(ch_width, default.units)
	}

	width <- scale * width
	height <- scale * height

	gTree(
		piece_side = piece_side,
		suit = suit,
		rank = rank,
		cfg = cfg,
		x = x,
		y = y,
		angle = angle,
		width = width,
		height = height,
		default.units = default.units,
		envir = envir,
		scale = scale,
		ch_width = ch_width,
		ch_grob = ch_grob,
		name = name,
		gp = gp,
		vp = vp,
		cl = "pp_crosshair"
	)
}

#' @export
makeContent.pp_crosshair <- function(x) {
	nn <- max(lengths(list(
		x$piece_side,
		x$suit,
		x$rank,
		x$x,
		x$y,
		x$angle,
		x$width,
		x$height,
		x$scale,
		x$bleed,
		x$ch_width
	)))
	piece_side <- rep(x$piece_side, length.out = nn)
	suit <- rep(x$suit, length.out = nn)
	rank <- rep(x$rank, length.out = nn)
	xc <- rep(x$x, length.out = nn)
	yc <- rep(x$y, length.out = nn)
	angle <- rep(x$angle, length.out = nn)

	width <- rep(x$width, length.out = nn)
	height <- rep(x$height, length.out = nn)

	scale <- rep(x$scale, length.out = nn)

	cfg <- get_cfg(x$cfg, x$envir)
	cfg <- rep(c(cfg), length.out = nn)

	ch_width <- rep(x$ch_width, length.out = nn)

	gl <- gList()
	for (i in seq(nn)) {
		name <- paste0(".", i)
		gl[[i]] <- crosshairGrobHelper(
			piece_side[i],
			suit[i],
			rank[i],
			cfg[[i]],
			xc[i],
			yc[i],
			angle[i],
			width[i],
			height[i],
			x$default.units,
			scale[i],
			name,
			ch_width[i],
			x$ch_grob
		)
	}
	setChildren(x, gl)
}

crosshairGrobHelper <- function(
	piece_side = "tile_back",
	suit = NA,
	rank = NA,
	cfg = pp_cfg(),
	x = unit(0.5, "npc"),
	y = unit(0.5, "npc"),
	angle = 0,
	width = NA,
	height = NA,
	default.units = "npc",
	scale = 1,
	name = "",
	ch_width = unit(0.25, "mm"),
	ch_grob = unit(0.125, "in")
) {
	if (is.na(width) || is.na(height)) {
		cfg <- as_pp_cfg(cfg)
		rank <- impute_rank(piece_side, rank, cfg)
		suit <- impute_suit(piece_side, suit, cfg)
		if (is.na(width)) {
			width <- inch(cfg$get_width(piece_side, suit, rank))
		}
		if (is.na(height)) height <- inch(cfg$get_height(piece_side, suit, rank))
	}

	if (is.na(angle)) {
		angle <- 0
	} else {
		angle <- angle %% 360
	}

	if (!is.unit(x)) {
		x <- unit(x, default.units)
	}
	if (!is.unit(y)) {
		y <- unit(y, default.units)
	}
	if (!is.unit(width)) {
		width <- unit(width, default.units)
	}
	if (!is.unit(height)) {
		height <- unit(height, default.units)
	}
	if (!is.unit(ch_width)) {
		ch_width <- unit(ch_width, default.units)
	}

	width <- scale * width
	height <- scale * height

	vp_piece <- viewport(x = x, y = y, angle = angle, width = width, height = height)

	vp_ll <- viewport(x = 0, y = 0, width = ch_width, height = ch_width)
	vp_ul <- viewport(x = 0, y = 1, width = ch_width, height = ch_width)
	vp_lr <- viewport(x = 1, y = 0, width = ch_width, height = ch_width)
	vp_ur <- viewport(x = 1, y = 1, width = ch_width, height = ch_width)

	ch_ll <- grobTree(ch_grob, name = "crosshair_ll", vp = vp_ll)
	ch_ul <- grobTree(ch_grob, name = "crosshair_ul", vp = vp_ul)
	ch_lr <- grobTree(ch_grob, name = "crosshair_lr", vp = vp_lr)
	ch_ur <- grobTree(ch_grob, name = "crosshair_ur", vp = vp_ur)

	name <- paste0("crosshair", name)

	grobTree(ch_ll, ch_ul, ch_lr, ch_ur, vp = vp_piece, name = name)
}

#' @rdname grid.crosshair
#' @param ... `crosshairGrob()` ignores; `grid.crosshair()` passes to `crosshairGrob()`.
#' @export
grid.crosshair <- function(..., draw = TRUE) {
	grob <- crosshairGrob(...)
	if (draw) {
		grid.draw(grob)
		invisible(grob)
	} else {
		grob
	}
}

#' @rdname grid.crosshair
#' @export
segmentsCrosshairGrob <- function(
	...,
	x = unit(0.5, "npc"),
	y = unit(0.5, "npc"),
	width = unit(1, "snpc"),
	height = unit(1, "snpc"),
	default.units = "npc",
	name = NULL,
	gp = gpar(),
	vp = NULL
) {
	col <- gp$col %||% gp$fill %||% "black"
	lwd <- gp$lwd %||% 1
	lty <- gp$lty %||% "solid"

	gp <- gpar(col = col, lwd = lwd, lty = lty)

	nn <- max(lengths(list(x, y, width, height)))
	x <- rep(x, length.out = nn)
	y <- rep(y, length.out = nn)
	width <- rep(width, length.out = nn)
	height <- rep(height, length.out = nn)
	if (!is.unit(x)) {
		x <- unit(x, default.units)
	}
	if (!is.unit(y)) {
		y <- unit(y, default.units)
	}
	if (!is.unit(width)) {
		width <- unit(width, default.units)
	}
	if (!is.unit(height)) {
		height <- unit(height, default.units)
	}

	gl <- gList()
	for (i in seq(nn)) {
		vpi <- viewport(x = x[i], y = y[i], width = width[i], height = height[i])
		gl[[i]] <- grobTree(
			segmentsGrob(x0 = 0.5, x1 = 0.5, y0 = 0, y1 = 1, default.units = "snpc"),
			segmentsGrob(x0 = 0, x1 = 1, y0 = 0.5, y1 = 0.5, default.units = "snpc"),
			name = paste0("crosshair.", i),
			vp = vpi
		)
	}
	gTree(name = name, gp = gp, vp = vp, children = gl, cl = "pp_segments_crosshair")
}

#' @rdname grid.crosshair
#' @export
circledSegmentsCrosshairGrob <- function(
	...,
	x = unit(0.5, "npc"),
	y = unit(0.5, "npc"),
	width = unit(1, "snpc"),
	height = unit(1, "snpc"),
	default.units = "npc",
	name = NULL,
	gp = gpar(),
	vp = NULL
) {
	col <- gp$col %||% gp$fill %||% "black"
	lwd <- gp$lwd %||% 1
	lty <- gp$lty %||% "solid"

	gp <- gpar(col = col, lwd = lwd, lty = lty)

	nn <- max(lengths(list(x, y, width, height)))
	x <- rep(x, length.out = nn)
	y <- rep(y, length.out = nn)
	width <- rep(width, length.out = nn)
	height <- rep(height, length.out = nn)
	if (!is.unit(x)) {
		x <- unit(x, default.units)
	}
	if (!is.unit(y)) {
		y <- unit(y, default.units)
	}
	if (!is.unit(width)) {
		width <- unit(width, default.units)
	}
	if (!is.unit(height)) {
		height <- unit(height, default.units)
	}

	gl <- gList()
	for (i in seq(nn)) {
		vpi <- viewport(x = x[i], y = y[i], width = width[i], height = height[i])
		gl[[i]] <- grobTree(
			segmentsGrob(x0 = 0.5, x1 = 0.5, y0 = 0, y1 = 1, default.units = "snpc"),
			segmentsGrob(x0 = 0, x1 = 1, y0 = 0.5, y1 = 0.5, default.units = "snpc"),
			circleGrob(r = unit(0.25, "snpc"), gp = gpar(fill = NA)),
			name = paste0("crosshair.", i),
			vp = vpi
		)
	}
	gTree(name = name, gp = gp, vp = vp, children = gl, cl = "pp_circled_segments_crosshair")
}

#' @rdname grid.crosshair
#' @export
squaredSegmentsCrosshairGrob <- function(
	...,
	x = unit(0.5, "npc"),
	y = unit(0.5, "npc"),
	width = unit(1, "snpc"),
	height = unit(1, "snpc"),
	default.units = "npc",
	name = NULL,
	gp = gpar(),
	vp = NULL
) {
	col <- gp$col %||% gp$fill %||% "black"
	lwd <- gp$lwd %||% 1
	lty <- gp$lty %||% "solid"

	gp <- gpar(col = col, lwd = lwd, lty = lty)

	nn <- max(lengths(list(x, y, width, height)))
	x <- rep(x, length.out = nn)
	y <- rep(y, length.out = nn)
	width <- rep(width, length.out = nn)
	height <- rep(height, length.out = nn)
	if (!is.unit(x)) {
		x <- unit(x, default.units)
	}
	if (!is.unit(y)) {
		y <- unit(y, default.units)
	}
	if (!is.unit(width)) {
		width <- unit(width, default.units)
	}
	if (!is.unit(height)) {
		height <- unit(height, default.units)
	}

	gl <- gList()
	for (i in seq(nn)) {
		vpi <- viewport(x = x[i], y = y[i], width = width[i], height = height[i])
		gl[[i]] <- grobTree(
			segmentsGrob(x0 = 0.5, x1 = 0.5, y0 = 0, y1 = 1, default.units = "snpc"),
			segmentsGrob(x0 = 0, x1 = 1, y0 = 0.5, y1 = 0.5, default.units = "snpc"),
			rectGrob(width = unit(0.5, "snpc"), height = unit(0.5, "snpc"), gp = gpar(fill = NA)),
			name = paste0("crosshair.", i),
			vp = vpi
		)
	}
	gTree(name = name, gp = gp, vp = vp, children = gl, cl = "pp_squared_segments_crosshair")
}

#' @rdname grid.crosshair
#' @export
squaresCrosshairGrob <- function(
	...,
	x = unit(0.5, "npc"),
	y = unit(0.5, "npc"),
	width = unit(1, "snpc"),
	height = unit(1, "snpc"),
	default.units = "npc",
	name = NULL,
	gp = gpar(),
	vp = NULL
) {
	fill <- gp$fill %||% gp$col %||% c("black", "white")
	if (length(fill) == 1L) {
		fill <- c(fill, opposite_col(fill))
	}

	gp1 <- gpar(col = NA, fill = fill[1L])
	gp2 <- gpar(col = NA, fill = fill[2L])

	nn <- max(lengths(list(x, y, width, height)))
	x <- rep(x, length.out = nn)
	y <- rep(y, length.out = nn)
	width <- rep(width, length.out = nn)
	height <- rep(height, length.out = nn)
	if (!is.unit(x)) {
		x <- unit(x, default.units)
	}
	if (!is.unit(y)) {
		y <- unit(y, default.units)
	}
	if (!is.unit(width)) {
		width <- unit(width, default.units)
	}
	if (!is.unit(height)) {
		height <- unit(height, default.units)
	}

	gl <- gList()
	for (i in seq(nn)) {
		vpi <- viewport(x = x[i], y = y[i], width = width[i], height = height[i])
		gl[[i]] <- grobTree(
			rectGrob(
				x = c(0.1, 0.3, 0.5, 0.5, 0.5, 0.5, 0.5, 0.7, 0.9),
				y = c(0.5, 0.5, 0.1, 0.3, 0.5, 0.7, 0.9, 0.5, 0.5),
				width = 0.1,
				height = 0.1,
				gp = gp1,
				default.units = "snpc"
			),
			rectGrob(
				x = c(0.2, 0.4, 0.5, 0.5, 0.5, 0.5, 0.6, 0.8),
				y = c(0.5, 0.5, 0.2, 0.4, 0.6, 0.8, 0.5, 0.5),
				width = 0.1,
				height = 0.1,
				gp = gp2,
				default.units = "snpc"
			),
			name = paste0("crosshair.", i),
			vp = vpi
		)
	}
	gTree(name = name, gp = gp, vp = vp, children = gl, cl = "pp_squares_crosshair")
}

# Opposite color in RGB space
opposite_col <- function(col) {
	stopifnot(length(col) == 1L)
	x <- grDevices::col2rgb(col)
	grDevices::rgb(255 - x[[1, 1]], 255 - x[[2, 1]], 255 - x[[3, 1]], maxColorValue = 255)
}
