|
24 | 24 | #' @param style If "Unicode" (default) only use glyphs in Unicode proper. |
25 | 25 | #' If "Game Bit Duo" use glyphs in Private Use Area of "Game Bit Duo" font. |
26 | 26 | #' If "Game Bit Mono" use glyphs in Private Use Area of "Game Bit Mono" font. |
| 27 | +#' @param xbreaks,ybreaks Subset (of integers) to provide axis labels for if `annotate` is `TRUE`. |
| 28 | +#' If `NULL` infer a reasonable choice. |
27 | 29 | #' @return Character vector for text diagram. |
28 | 30 | #' @seealso [cat_piece()] for printing to the terminal. |
29 | 31 | #' See <https://github.com/trevorld/game-bit-font> for more information about the \dQuote{Game Bit} family of fonts. |
30 | 32 | #' @export |
31 | 33 | str_piece <- function(df, color = NULL, reorient = "none", annotate = FALSE, ..., |
32 | | - annotation_scale = NULL, style = c("Unicode", "Game Bit Mono", "Game Bit Duo")) { |
| 34 | + annotation_scale = NULL, |
| 35 | + style = c("Unicode", "Game Bit Mono", "Game Bit Duo"), |
| 36 | + xbreaks = NULL, ybreaks = NULL) { |
33 | 37 | str_piece_helper(df, ..., color = color, reorient = reorient, annotate = annotate, ..., |
34 | | - annotation_scale = annotation_scale, style = style) |
| 38 | + annotation_scale = annotation_scale, style = style, |
| 39 | + xbreaks = xbreaks, ybreaks = ybreaks) |
35 | 40 | } |
36 | 41 | str_piece_helper <- function(df, color = NULL, reorient = "none", annotate = FALSE, ..., |
37 | 42 | xoffset = NULL, yoffset = NULL, |
38 | | - annotation_scale = NULL, style = "Unicode") { |
| 43 | + annotation_scale = NULL, |
| 44 | + style = "Unicode", xbreaks = NULL, ybreaks = NULL) { |
39 | 45 | annotation_scale <- annotation_scale %||% attr(df, "scale_factor") %||% 1 |
40 | 46 | if (nrow(df) == 0) { |
41 | 47 | return(character(0)) |
@@ -63,7 +69,7 @@ str_piece_helper <- function(df, color = NULL, reorient = "none", annotate = FAL |
63 | 69 | cfg <- as.character(df[rr, "cfg"]) |
64 | 70 | cm <- add_piece(cm, ps, suit, rank, x, y, angle, cfg, reorient, style) |
65 | 71 | } |
66 | | - cm <- annotate_text(cm, nc, nr, offset$x, offset$y, annotate, annotation_scale) |
| 72 | + cm <- annotate_text(cm, nc, nr, offset$x, offset$y, annotate, annotation_scale, xbreaks, ybreaks) |
67 | 73 | cm <- color_text(cm, color) |
68 | 74 | text <- rev(apply(cm$char, 1, function(x) paste(x, collapse = ""))) |
69 | 75 | text <- paste(text, collapse = "\n") |
@@ -280,24 +286,45 @@ col_cli <- function(col = c("black", "blue", "cyan", "green", "magenta", "red", |
280 | 286 | get(paste0("col_", col), envir = getNamespace("cli")) |
281 | 287 | } |
282 | 288 |
|
283 | | -annotate_text <- function(cm, nc, nr, xoffset, yoffset, annotate, annotation_scale) { |
| 289 | +annotate_text <- function(cm, nc, nr, xoffset, yoffset, annotate, annotation_scale, |
| 290 | + xbreaks, ybreaks) { |
284 | 291 | if (isFALSE(annotate) || annotate == "none") return(cm) |
285 | 292 | step <- 2 * annotation_scale |
286 | | - x <- seq(1 + step + 2 * xoffset, nc, by = step) |
| 293 | + |
| 294 | + if (is.null(xbreaks)) { |
| 295 | + x <- seq(1 + step + 2 * xoffset, nc, by = step) |
| 296 | + } else { |
| 297 | + xbreaks <- as.integer(xbreaks) |
| 298 | + x <- seq(1 + step + 2 * xoffset, by = step, length.out = max(xbreaks)) |
| 299 | + } |
287 | 300 | if (annotate == "cartesian") { |
288 | 301 | x <- utils::head(x, 9) |
289 | 302 | xt <- as.character(seq_along(x)) |
290 | | - cm$char[1, x] <- xt |
291 | 303 | } else { |
292 | 304 | if (length(x) > 26) x <- x[1:26] |
293 | | - cm$char[1, x] <- letters[seq_along(x)] |
| 305 | + xt <- letters[seq_along(x)] |
| 306 | + } |
| 307 | + if (!is.null(xbreaks)) { |
| 308 | + x <- x[xbreaks] |
| 309 | + xt <- xt[xbreaks] |
| 310 | + } |
| 311 | + cm$char[1, x] <- xt |
| 312 | + |
| 313 | + if (is.null(ybreaks)) { |
| 314 | + y <- seq(1 + step + 2 * yoffset, nr, by= step) |
| 315 | + } else { |
| 316 | + ybreaks <- as.integer(ybreaks) |
| 317 | + y <- seq(1 + step + 2 * yoffset, by= step, length.out = max(ybreaks)) |
294 | 318 | } |
295 | | - y <- seq(1 + step + 2 * yoffset, nr, by= step) |
296 | 319 | yt <- as.character(seq_along(y)) |
297 | 320 | if (length(yt) > 9) { |
298 | 321 | yt <- stringr::str_pad(yt, 2, "right") |
299 | 322 | cm$char[y[-seq(9)], 2L] <- substr(yt[-seq(9)], 2, 2) |
300 | 323 | } |
| 324 | + if (!is.null(ybreaks)) { |
| 325 | + y <- y[ybreaks] |
| 326 | + yt <- yt[ybreaks] |
| 327 | + } |
301 | 328 | cm$char[y, 1L] <- substr(yt, 1L, 1L) |
302 | 329 | cm |
303 | 330 | } |
|
0 commit comments