From bf4a71af46befb7d039d953c34e78c2bbe399f31 Mon Sep 17 00:00:00 2001 From: "Trevor L. Davis" Date: Sun, 5 Apr 2026 23:56:22 -0700 Subject: [PATCH 1/4] refactor: Rename *.r to *.R and raw-data/ to data-raw/ --- .Rbuildignore | 2 +- DESCRIPTION | 4 ++-- NEWS.md | 5 +++++ R/{cat_piece.r => cat_piece.R} | 0 R/{range.r => range.R} | 0 R/{str_piece.r => str_piece.R} | 0 R/{zzz.r => zzz.R} | 0 raw-data/sysdata.r => data-raw/sysdata.R | 0 man/cat_piece.Rd | 2 +- man/str_piece.Rd | 2 +- tests/{testthat.r => testthat.R} | 0 tests/testthat/{test_cat_piece.r => test_cat_piece.R} | 0 tests/testthat/{test_game_bit_duo.r => test_game_bit_duo.R} | 0 .../testthat/{test_game_bit_mono.r => test_game_bit_mono.R} | 0 tests/testthat/{test_html.r => test_html.R} | 0 tests/testthat/{test_range.r => test_range.R} | 0 tests/testthat/{test_zzz.r => test_zzz.R} | 0 17 files changed, 10 insertions(+), 5 deletions(-) rename R/{cat_piece.r => cat_piece.R} (100%) rename R/{range.r => range.R} (100%) rename R/{str_piece.r => str_piece.R} (100%) rename R/{zzz.r => zzz.R} (100%) rename raw-data/sysdata.r => data-raw/sysdata.R (100%) rename tests/{testthat.r => testthat.R} (100%) rename tests/testthat/{test_cat_piece.r => test_cat_piece.R} (100%) rename tests/testthat/{test_game_bit_duo.r => test_game_bit_duo.R} (100%) rename tests/testthat/{test_game_bit_mono.r => test_game_bit_mono.R} (100%) rename tests/testthat/{test_html.r => test_html.R} (100%) rename tests/testthat/{test_range.r => test_range.R} (100%) rename tests/testthat/{test_zzz.r => test_zzz.R} (100%) diff --git a/.Rbuildignore b/.Rbuildignore index 4abca8d..0ddb4ab 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -8,7 +8,7 @@ rule_ideas.rst html others ^pkgdown$ -raw-data +data-raw tmp .*.epub .*.gif diff --git a/DESCRIPTION b/DESCRIPTION index c715ae3..1c295fd 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,7 +2,7 @@ Encoding: UTF-8 Package: ppcli Type: Package Title: Plaintext Board Game Visualizations -Version: 0.2.1 +Version: 0.2.2-1 Authors@R: c(person("Trevor L.", "Davis", role=c("aut", "cre"), email="trevor.l.davis@gmail.com", comment = c(ORCID = "0000-0001-6341-4639"))) @@ -27,5 +27,5 @@ Suggests: withr Remotes: piecepackr/ppdf Roxygen: list(markdown = TRUE) -RoxygenNote: 7.3.1 +RoxygenNote: 7.3.3 Config/testthat/edition: 3 diff --git a/NEWS.md b/NEWS.md index d89933a..4458812 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,8 @@ +ppcli 0.2.2 (development) +========================= + +* No user-facing changes. + ppcli 0.2.1 =========== diff --git a/R/cat_piece.r b/R/cat_piece.R similarity index 100% rename from R/cat_piece.r rename to R/cat_piece.R diff --git a/R/range.r b/R/range.R similarity index 100% rename from R/range.r rename to R/range.R diff --git a/R/str_piece.r b/R/str_piece.R similarity index 100% rename from R/str_piece.r rename to R/str_piece.R diff --git a/R/zzz.r b/R/zzz.R similarity index 100% rename from R/zzz.r rename to R/zzz.R diff --git a/raw-data/sysdata.r b/data-raw/sysdata.R similarity index 100% rename from raw-data/sysdata.r rename to data-raw/sysdata.R diff --git a/man/cat_piece.Rd b/man/cat_piece.Rd index 747be72..e7d82cd 100644 --- a/man/cat_piece.Rd +++ b/man/cat_piece.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/cat_piece.r +% Please edit documentation in R/cat_piece.R \name{cat_piece} \alias{cat_piece} \title{Prints plaintext piecepack diagrams} diff --git a/man/str_piece.Rd b/man/str_piece.Rd index 352fe06..9e99e22 100644 --- a/man/str_piece.Rd +++ b/man/str_piece.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/str_piece.r +% Please edit documentation in R/str_piece.R \name{str_piece} \alias{str_piece} \title{Generate plaintext piecepack diagrams} diff --git a/tests/testthat.r b/tests/testthat.R similarity index 100% rename from tests/testthat.r rename to tests/testthat.R diff --git a/tests/testthat/test_cat_piece.r b/tests/testthat/test_cat_piece.R similarity index 100% rename from tests/testthat/test_cat_piece.r rename to tests/testthat/test_cat_piece.R diff --git a/tests/testthat/test_game_bit_duo.r b/tests/testthat/test_game_bit_duo.R similarity index 100% rename from tests/testthat/test_game_bit_duo.r rename to tests/testthat/test_game_bit_duo.R diff --git a/tests/testthat/test_game_bit_mono.r b/tests/testthat/test_game_bit_mono.R similarity index 100% rename from tests/testthat/test_game_bit_mono.r rename to tests/testthat/test_game_bit_mono.R diff --git a/tests/testthat/test_html.r b/tests/testthat/test_html.R similarity index 100% rename from tests/testthat/test_html.r rename to tests/testthat/test_html.R diff --git a/tests/testthat/test_range.r b/tests/testthat/test_range.R similarity index 100% rename from tests/testthat/test_range.r rename to tests/testthat/test_range.R diff --git a/tests/testthat/test_zzz.r b/tests/testthat/test_zzz.R similarity index 100% rename from tests/testthat/test_zzz.r rename to tests/testthat/test_zzz.R From 666675db5767f0600ab17a136110e5fe93811bb1 Mon Sep 17 00:00:00 2001 From: "Trevor L. Davis" Date: Sun, 5 Apr 2026 23:57:57 -0700 Subject: [PATCH 2/4] chore: `tldtools::use_tld_air()` --- .Rbuildignore | 4 ++++ .air.toml | 6 ++++++ .editorconfig | 11 +++++++++++ .github/workflows/air-check.yaml | 21 +++++++++++++++++++++ .pre-commit-config.yaml | 8 ++++++++ 5 files changed, 50 insertions(+) create mode 100644 .air.toml create mode 100644 .editorconfig create mode 100644 .github/workflows/air-check.yaml create mode 100644 .pre-commit-config.yaml diff --git a/.Rbuildignore b/.Rbuildignore index 0ddb4ab..81139b8 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -18,6 +18,10 @@ tmp ^.lintr$ ^_pkgdown.yml$ ^.travis.yml$ +^\.air.toml$ +^\.editorconfig$ +^\.git$ ^\.github$ +^\.pre-commit-config.yaml$ ^Dockerfile$ ^\.dockerignore$ diff --git a/.air.toml b/.air.toml new file mode 100644 index 0000000..18b38e5 --- /dev/null +++ b/.air.toml @@ -0,0 +1,6 @@ +[format] +indent-style = "tab" +indent-width = 4 +line-ending = "lf" +line-width = 100 +skip = ["tribble"] diff --git a/.editorconfig b/.editorconfig new file mode 100644 index 0000000..a684a86 --- /dev/null +++ b/.editorconfig @@ -0,0 +1,11 @@ +# https://editorconfig.org/ +root = true + +[*] +charset = utf-8 +end_of_line = lf +insert_final_newline = true +trim_trailing_whitespace = true + +[*.{r,R}] +indent_style = tab diff --git a/.github/workflows/air-check.yaml b/.github/workflows/air-check.yaml new file mode 100644 index 0000000..b73d1f5 --- /dev/null +++ b/.github/workflows/air-check.yaml @@ -0,0 +1,21 @@ +on: + push: + branches: [main, master] + pull_request: + +name: format-check + +permissions: read-all + +jobs: + format-check: + name: format-check + runs-on: ubuntu-latest + steps: + - uses: actions/checkout@v4 + + - name: Install + uses: posit-dev/setup-air@v1 + + - name: Check + run: air format . --check diff --git a/.pre-commit-config.yaml b/.pre-commit-config.yaml new file mode 100644 index 0000000..13806d5 --- /dev/null +++ b/.pre-commit-config.yaml @@ -0,0 +1,8 @@ +repos: + - repo: local + hooks: + - id: air + name: Format R code with air + entry: air format + language: system + files: \.R$|\.r$ From 9d2b8774ec38192b955f6a2f8bf786af73982b4c Mon Sep 17 00:00:00 2001 From: "Trevor L. Davis" Date: Sun, 5 Apr 2026 23:58:15 -0700 Subject: [PATCH 3/4] style: Run `air format .` --- R/cat_piece.R | 37 +- R/range.R | 119 +- R/str_piece.R | 1869 +++++++++++++++------------ R/zzz.R | 21 +- data-raw/sysdata.R | 386 +++--- tests/testthat/test_cat_piece.R | 643 +++++---- tests/testthat/test_game_bit_duo.R | 6 +- tests/testthat/test_game_bit_mono.R | 30 +- tests/testthat/test_html.R | 8 +- tests/testthat/test_range.R | 28 +- 10 files changed, 1800 insertions(+), 1347 deletions(-) diff --git a/R/cat_piece.R b/R/cat_piece.R index bdc59e1..4b38ff4 100644 --- a/R/cat_piece.R +++ b/R/cat_piece.R @@ -27,14 +27,31 @@ #' cat_piece(df) #' cat_piece(df, annotate = TRUE) #' @export -cat_piece <- function(df, color = NULL, reorient = "none", annotate = FALSE, ..., - file = "", annotation_scale = NULL, - style = c("Unicode", "Game Bit Mono", "Game Bit Duo"), - xbreaks = NULL, ybreaks = NULL) { - color <- color %||% (is.null(file) || file == "") - s <- str_piece(df, color = color, reorient = reorient, annotate = annotate, - annotation_scale = annotation_scale, style = style, - xbreaks = xbreaks, ybreaks = ybreaks) - if (!is.null(file)) cat(s, ..., file = file) - invisible(s) +cat_piece <- function( + df, + color = NULL, + reorient = "none", + annotate = FALSE, + ..., + file = "", + annotation_scale = NULL, + style = c("Unicode", "Game Bit Mono", "Game Bit Duo"), + xbreaks = NULL, + ybreaks = NULL +) { + color <- color %||% (is.null(file) || file == "") + s <- str_piece( + df, + color = color, + reorient = reorient, + annotate = annotate, + annotation_scale = annotation_scale, + style = style, + xbreaks = xbreaks, + ybreaks = ybreaks + ) + if (!is.null(file)) { + cat(s, ..., file = file) + } + invisible(s) } diff --git a/R/range.R b/R/range.R index b91d71d..f2ebaa5 100644 --- a/R/range.R +++ b/R/range.R @@ -1,68 +1,75 @@ range_heuristic <- function(df) { - if (nrow(df) == 0) return(list(xmin = NA_real_, xmax = NA_real_, ymin = NA_real_, ymax = NA_real_)) - if (!isTRUE(attr(df, "was_cleaned"))) df <- clean_df(df) + if (nrow(df) == 0) { + return(list(xmin = NA_real_, xmax = NA_real_, ymin = NA_real_, ymax = NA_real_)) + } + if (!isTRUE(attr(df, "was_cleaned"))) { + df <- clean_df(df) + } - # piecepack - is_tile <- grepl("tile", df$piece_side) - xleft <- ifelse(is_tile, df$x-1, df$x-0.5) - xright <- ifelse(is_tile, df$x+1, df$x+0.5) - ybot <- ifelse(is_tile, df$y-1, df$y-0.5) - ytop <- ifelse(is_tile, df$y+1, df$y+0.5) + # piecepack + is_tile <- grepl("tile", df$piece_side) + xleft <- ifelse(is_tile, df$x - 1, df$x - 0.5) + xright <- ifelse(is_tile, df$x + 1, df$x + 0.5) + ybot <- ifelse(is_tile, df$y - 1, df$y - 0.5) + ytop <- ifelse(is_tile, df$y + 1, df$y + 0.5) - # subpack - is_subpack <- is_tile & df$cfg == "subpack" - xleft <- ifelse(is_subpack, df$x-0.5, xleft) - xright <- ifelse(is_subpack, df$x+0.5, xright) - ybot <- ifelse(is_subpack, df$y-0.5, ybot) - ytop <- ifelse(is_subpack, df$y+0.5, ytop) + # subpack + is_subpack <- is_tile & df$cfg == "subpack" + xleft <- ifelse(is_subpack, df$x - 0.5, xleft) + xright <- ifelse(is_subpack, df$x + 0.5, xright) + ybot <- ifelse(is_subpack, df$y - 0.5, ybot) + ytop <- ifelse(is_subpack, df$y + 0.5, ytop) - # dominoes - is_dominoes_horizontal <- is_tile & grepl("dominoes", df$cfg) & (df$angle == 90 | df$angle == 270) - ybot <- ifelse(is_dominoes_horizontal, df$y-0.5, ybot) - ytop <- ifelse(is_dominoes_horizontal, df$y+0.5, ytop) - is_dominoes_vertical <- is_tile & grepl("dominoes", df$cfg) & (df$angle == 0 | df$angle == 180) - xleft <- ifelse(is_dominoes_vertical, df$x-0.5, xleft) - xright <- ifelse(is_dominoes_vertical, df$x+0.5, xright) + # dominoes + is_dominoes_horizontal <- is_tile & + grepl("dominoes", df$cfg) & + (df$angle == 90 | df$angle == 270) + ybot <- ifelse(is_dominoes_horizontal, df$y - 0.5, ybot) + ytop <- ifelse(is_dominoes_horizontal, df$y + 0.5, ytop) + is_dominoes_vertical <- is_tile & grepl("dominoes", df$cfg) & (df$angle == 0 | df$angle == 180) + xleft <- ifelse(is_dominoes_vertical, df$x - 0.5, xleft) + xright <- ifelse(is_dominoes_vertical, df$x + 0.5, xright) - # boards - is_board <- grepl("board", df$piece_side) - xleft <- ifelse(is_board, df$x-0.5*df$rank, xleft) - xright <- ifelse(is_board, df$x+0.5*df$rank, xright) - ybot <- ifelse(is_board, df$y-0.5*df$rank, ybot) - ytop <- ifelse(is_board, df$y+0.5*df$rank, ytop) + # boards + is_board <- grepl("board", df$piece_side) + xleft <- ifelse(is_board, df$x - 0.5 * df$rank, xleft) + xright <- ifelse(is_board, df$x + 0.5 * df$rank, xright) + ybot <- ifelse(is_board, df$y - 0.5 * df$rank, ybot) + ytop <- ifelse(is_board, df$y + 0.5 * df$rank, ytop) - is_board2 <- is_board & grepl("2", df$cfg) - xleft <- ifelse(is_board2, df$x-df$rank, xleft) - xright <- ifelse(is_board2, df$x+df$rank, xright) - ybot <- ifelse(is_board2, df$y-df$rank, ybot) - ytop <- ifelse(is_board2, df$y+df$rank, ytop) + is_board2 <- is_board & grepl("2", df$cfg) + xleft <- ifelse(is_board2, df$x - df$rank, xleft) + xright <- ifelse(is_board2, df$x + df$rank, xright) + ybot <- ifelse(is_board2, df$y - df$rank, ybot) + ytop <- ifelse(is_board2, df$y + df$rank, ytop) - morris_offset <- c(3, 1, 1, 1, 2, 2, 3, 3, 3, 3, 3, 3)[df$rank] - is_morris_board <- is_board & df$cfg == "morris" - xleft <- ifelse(is_morris_board, df$x-morris_offset, xleft) - xright <- ifelse(is_morris_board, df$x+morris_offset, xright) - ybot <- ifelse(is_morris_board, df$y-morris_offset, ybot) - ytop <- ifelse(is_morris_board, df$y+morris_offset, ytop) + morris_offset <- c(3, 1, 1, 1, 2, 2, 3, 3, 3, 3, 3, 3)[df$rank] + is_morris_board <- is_board & df$cfg == "morris" + xleft <- ifelse(is_morris_board, df$x - morris_offset, xleft) + xright <- ifelse(is_morris_board, df$x + morris_offset, xright) + ybot <- ifelse(is_morris_board, df$y - morris_offset, ybot) + ytop <- ifelse(is_morris_board, df$y + morris_offset, ytop) - # matchsticks - m_offset <- pmax(floor(df$rank / 2) - 1, 0) / 2 # 1:6 -> 0, 0, 0, 0.5, 0.5, 1 - is_matchsticks_horizontal <- grepl("matchstick", df$piece_side) & - (df$angle == 90 | df$angle == 270) - xleft <- ifelse(is_matchsticks_horizontal, df$x - m_offset, xleft) - xright <- ifelse(is_matchsticks_horizontal, df$x + m_offset, xright) + # matchsticks + m_offset <- pmax(floor(df$rank / 2) - 1, 0) / 2 # 1:6 -> 0, 0, 0, 0.5, 0.5, 1 + is_matchsticks_horizontal <- grepl("matchstick", df$piece_side) & + (df$angle == 90 | df$angle == 270) + xleft <- ifelse(is_matchsticks_horizontal, df$x - m_offset, xleft) + xright <- ifelse(is_matchsticks_horizontal, df$x + m_offset, xright) - is_matchsticks_vertical <- grepl("matchstick", df$piece_side) & - (df$angle == 0 | df$angle == 180) - ybot <- ifelse(is_matchsticks_vertical, df$y - m_offset, ybot) - ytop <- ifelse(is_matchsticks_vertical, df$y + m_offset, ytop) + is_matchsticks_vertical <- grepl("matchstick", df$piece_side) & + (df$angle == 0 | df$angle == 180) + ybot <- ifelse(is_matchsticks_vertical, df$y - m_offset, ybot) + ytop <- ifelse(is_matchsticks_vertical, df$y + m_offset, ytop) - m_offset_d <- floor(df$rank / 4) # 1:6 -> 0, 0, 0, 1, 1, 1 - is_matchsticks_diagonal <- grepl("matchstick", df$piece_side) & - !is_matchsticks_horizontal & !is_matchsticks_vertical - xleft <- ifelse(is_matchsticks_diagonal, df$x - m_offset_d, xleft) - xright <- ifelse(is_matchsticks_diagonal, df$x + m_offset_d, xright) - ybot <- ifelse(is_matchsticks_diagonal, df$y - m_offset_d, ybot) - ytop <- ifelse(is_matchsticks_diagonal, df$y + m_offset_d, ytop) + m_offset_d <- floor(df$rank / 4) # 1:6 -> 0, 0, 0, 1, 1, 1 + is_matchsticks_diagonal <- grepl("matchstick", df$piece_side) & + !is_matchsticks_horizontal & + !is_matchsticks_vertical + xleft <- ifelse(is_matchsticks_diagonal, df$x - m_offset_d, xleft) + xright <- ifelse(is_matchsticks_diagonal, df$x + m_offset_d, xright) + ybot <- ifelse(is_matchsticks_diagonal, df$y - m_offset_d, ybot) + ytop <- ifelse(is_matchsticks_diagonal, df$y + m_offset_d, ytop) - list(xmin = min(xleft), xmax = max(xright), ymin = min(ybot), ymax = max(ytop)) + list(xmin = min(xleft), xmax = max(xright), ymin = min(ybot), ymax = max(ytop)) } diff --git a/R/str_piece.R b/R/str_piece.R index cdd4790..3cc37d9 100644 --- a/R/str_piece.R +++ b/R/str_piece.R @@ -45,214 +45,290 @@ #' is.character(s) #' cat(s, sep = "\n") #' @export -str_piece <- function(df, color = NULL, reorient = "none", annotate = FALSE, ..., - annotation_scale = NULL, - style = c("Unicode", "Game Bit Mono", "Game Bit Duo"), - xbreaks = NULL, ybreaks = NULL) { - str_piece_helper(df, ..., color = color, reorient = reorient, annotate = annotate, ..., - annotation_scale = annotation_scale, style = style, - xbreaks = xbreaks, ybreaks = ybreaks) -} -str_piece_helper <- function(df, color = NULL, reorient = "none", annotate = FALSE, ..., - xoffset = NULL, yoffset = NULL, - annotation_scale = NULL, - style = "Unicode", xbreaks = NULL, ybreaks = NULL) { - annotation_scale <- annotation_scale %||% attr(df, "scale_factor") %||% 1 - color <- color %||% FALSE - if (nrow(df) == 0) { - return(character(0)) - } - style <- get_style(style = style[1]) - df <- clean_df(df) - if (isTRUE(reorient) || reorient == "all") df$angle <- 0 - - lr <- range_heuristic(df) - offset <- get_df_offsets(df, lr, xoffset, yoffset, annotate) - df$x <- df$x + offset$x - df$y <- df$y + offset$y - nc <- 2 * (lr$xmax + offset$x) + 1 - nr <- 2 * (lr$ymax + offset$y) + 1 - cm <- list(char = matrix(style$space, nrow = nr, ncol = nc), - fg = matrix("black", nrow = nr, ncol = nc)) - - for (rr in seq(nrow(df))) { - ps <- as.character(df[rr, "piece_side"]) - suit <- as.numeric(df[rr, "suit"]) - rank <- as.numeric(df[rr, "rank"]) - x <- 2*as.numeric(df[rr, "x"])+1 - y <- 2*as.numeric(df[rr, "y"])+1 - angle <- as.numeric(df[rr, "angle"]) - cfg <- as.character(df[rr, "cfg"]) - cm <- add_piece(cm, ps, suit, rank, x, y, angle, cfg, reorient, style) - } - cm <- annotate_text(cm, nc, nr, offset$x, offset$y, annotate, annotation_scale, xbreaks, ybreaks) - cm <- color_text(cm, color) - text <- rev(apply(cm$char, 1, function(x) paste(x, collapse = ""))) - text <- paste(text, collapse = "\n") - if (color == "html") { - assert_suggested("fansi") - text <- fansi::sgr_to_html(text) - # text <- cli::ansi_html(text) - } - paste0(text, "\n") +str_piece <- function( + df, + color = NULL, + reorient = "none", + annotate = FALSE, + ..., + annotation_scale = NULL, + style = c("Unicode", "Game Bit Mono", "Game Bit Duo"), + xbreaks = NULL, + ybreaks = NULL +) { + str_piece_helper( + df, + ..., + color = color, + reorient = reorient, + annotate = annotate, + ..., + annotation_scale = annotation_scale, + style = style, + xbreaks = xbreaks, + ybreaks = ybreaks + ) +} +str_piece_helper <- function( + df, + color = NULL, + reorient = "none", + annotate = FALSE, + ..., + xoffset = NULL, + yoffset = NULL, + annotation_scale = NULL, + style = "Unicode", + xbreaks = NULL, + ybreaks = NULL +) { + annotation_scale <- annotation_scale %||% attr(df, "scale_factor") %||% 1 + color <- color %||% FALSE + if (nrow(df) == 0) { + return(character(0)) + } + style <- get_style(style = style[1]) + df <- clean_df(df) + if (isTRUE(reorient) || reorient == "all") { + df$angle <- 0 + } + + lr <- range_heuristic(df) + offset <- get_df_offsets(df, lr, xoffset, yoffset, annotate) + df$x <- df$x + offset$x + df$y <- df$y + offset$y + nc <- 2 * (lr$xmax + offset$x) + 1 + nr <- 2 * (lr$ymax + offset$y) + 1 + cm <- list( + char = matrix(style$space, nrow = nr, ncol = nc), + fg = matrix("black", nrow = nr, ncol = nc) + ) + + for (rr in seq(nrow(df))) { + ps <- as.character(df[rr, "piece_side"]) + suit <- as.numeric(df[rr, "suit"]) + rank <- as.numeric(df[rr, "rank"]) + x <- 2 * as.numeric(df[rr, "x"]) + 1 + y <- 2 * as.numeric(df[rr, "y"]) + 1 + angle <- as.numeric(df[rr, "angle"]) + cfg <- as.character(df[rr, "cfg"]) + cm <- add_piece(cm, ps, suit, rank, x, y, angle, cfg, reorient, style) + } + cm <- annotate_text( + cm, + nc, + nr, + offset$x, + offset$y, + annotate, + annotation_scale, + xbreaks, + ybreaks + ) + cm <- color_text(cm, color) + text <- rev(apply(cm$char, 1, function(x) paste(x, collapse = ""))) + text <- paste(text, collapse = "\n") + if (color == "html") { + assert_suggested("fansi") + text <- fansi::sgr_to_html(text) + # text <- cli::ansi_html(text) + } + paste0(text, "\n") } get_style <- function(style = "Unicode") { - style <- tolower(style) - style <- gsub("-", "", style) - style <- gsub(" ", "", style) - style <- match.arg(style, c("unicode", "gamebitduo", "gamebitmono")) - - if (style == "gamebitduo") { - space <- " " #### - } else { - space <- " " - } - - list(rotate = get_style_rotate(style), - rs = get_style_rs(style), - rs_big = get_style_rs(style, big = TRUE), - ss = get_style_ss(style), - ss_big = get_style_ss(style, big = TRUE), - fg = get_style_fg(style), - combining = get_style_combining(style), - space = space, - has_pua_box_drawing = style != "unicode" - ) + style <- tolower(style) + style <- gsub("-", "", style) + style <- gsub(" ", "", style) + style <- match.arg(style, c("unicode", "gamebitduo", "gamebitmono")) + + if (style == "gamebitduo") { + space <- " " #### + } else { + space <- " " + } + + list( + rotate = get_style_rotate(style), + rs = get_style_rs(style), + rs_big = get_style_rs(style, big = TRUE), + ss = get_style_ss(style), + ss_big = get_style_ss(style, big = TRUE), + fg = get_style_fg(style), + combining = get_style_combining(style), + space = space, + has_pua_box_drawing = style != "unicode" + ) } get_style_combining <- function(style) { - if (style == "unicode") - coin <- "\u20dd" - else - coin <- "\U000FCE50" - - if (style == "unicode") - pawn <- "\u20df" - else - pawn <- "\U000FCDE0" - - die_suits <- rep("\u20de", 6) - if (style == "unicode") { - piecepack_suits <- die_suits - french_suits_black <- die_suits - french_suits_white <- die_suits - } else { - piecepack_suits <- intToUtf8(utf8ToInt("\U000FCE00") + 0:3, multiple = TRUE) - french_suits_black <- intToUtf8(utf8ToInt("\U000FCE20") + 0:3, multiple = TRUE) - french_suits_white <- intToUtf8(utf8ToInt("\U000FCE30") + 0:3, multiple = TRUE) - } - die <- list(piecepack = piecepack_suits, - playing_cards_expansion = french_suits_black, - dual_piecepacks_expansion = french_suits_white, - subpack = piecepack_suits, - dice = die_suits, - dice_fudge = die_suits, - dice_numeral = die_suits) - - list(coin = coin, die = die, pawn = pawn) + if (style == "unicode") { + coin <- "\u20dd" + } else { + coin <- "\U000FCE50" + } + + if (style == "unicode") { + pawn <- "\u20df" + } else { + pawn <- "\U000FCDE0" + } + + die_suits <- rep("\u20de", 6) + if (style == "unicode") { + piecepack_suits <- die_suits + french_suits_black <- die_suits + french_suits_white <- die_suits + } else { + piecepack_suits <- intToUtf8(utf8ToInt("\U000FCE00") + 0:3, multiple = TRUE) + french_suits_black <- intToUtf8(utf8ToInt("\U000FCE20") + 0:3, multiple = TRUE) + french_suits_white <- intToUtf8(utf8ToInt("\U000FCE30") + 0:3, multiple = TRUE) + } + die <- list( + piecepack = piecepack_suits, + playing_cards_expansion = french_suits_black, + dual_piecepacks_expansion = french_suits_white, + subpack = piecepack_suits, + dice = die_suits, + dice_fudge = die_suits, + dice_numeral = die_suits + ) + + list(coin = coin, die = die, pawn = pawn) } get_style_rs <- function(style, big = FALSE) { + if (style == "unicode") { + dominoes_ranks <- c(" ", "\u00b7", "\u280c", "\u22f0", "\u2237", "\u2059", "\u283f") + } else { + dominoes_ranks <- c( + "\U000FCA00", + "\U000FCA01", + "\U000FCA02", + "\U000FCA03", + "\U000FCA04", + "\U000FCA05", + "\U000FCA06", + "\U000FCA07", + "\U000FCA08", + "\U000FCA09", + "\U000FCA0A", + "\U000FCA0B", + "\U000FCA0C", + "\U000FCA0D", + "\U000FCA0E", + "\U000FCA0F", + "\U000FCA10", + "\U000FCA11", + "\U000FCA12" + ) + } + + if (style == "unicode") { + piecepack_ranks <- c("n", "a", "2", "3", "4", "5") + } else { + if (big) { + piecepack_ranks <- intToUtf8(utf8ToInt("\U000FCB50") + 0:11, multiple = TRUE) + } else { + piecepack_ranks <- intToUtf8(utf8ToInt("\U000FCC50") + 0:11, multiple = TRUE) + } + } + if (style == "unicode") { + dice_fudge <- c("\u2212", " ", "+", "+", " ", "\u2212") + } else { + dice_fudge <- c("\uff0d", "\U000FCA00", "\uff0b", "\uff0b", "\U000FCA00", "\uff0d") + } - if (style == "unicode") { - dominoes_ranks <- c(" ", "\u00b7", "\u280c", "\u22f0", "\u2237", "\u2059", "\u283f") - } else { - dominoes_ranks <- c("\U000FCA00", "\U000FCA01", "\U000FCA02", "\U000FCA03", "\U000FCA04", - "\U000FCA05", "\U000FCA06", "\U000FCA07", "\U000FCA08", "\U000FCA09", - "\U000FCA0A", "\U000FCA0B", "\U000FCA0C", "\U000FCA0D", "\U000FCA0E", - "\U000FCA0F", "\U000FCA10", "\U000FCA11", "\U000FCA12") - } - - if (style == "unicode") { - piecepack_ranks <- c("n", "a", "2", "3", "4", "5") - } else { - if (big) - piecepack_ranks <- intToUtf8(utf8ToInt("\U000FCB50") + 0:11, multiple = TRUE) - else - piecepack_ranks <- intToUtf8(utf8ToInt("\U000FCC50") + 0:11, multiple = TRUE) - } - if (style == "unicode") - dice_fudge <- c("\u2212", " ", "+", "+", " ", "\u2212") - else - dice_fudge <- c("\uff0d", "\U000FCA00", "\uff0b", "\uff0b", "\U000FCA00", "\uff0d") - - rs <- list(piecepack = piecepack_ranks, - playing_cards_expansion = piecepack_ranks, - dual_piecepacks_expansion = piecepack_ranks, - subpack = piecepack_ranks, - checkers1 = c(rep_len("\u26c3", 5L), "\u26c1"), - checkers2 = c(rep_len("\u26c3", 5L), "\u26c1"), - chess1 = c("\u265f", "\u265e", "\u265d", "\u265c", "\u265b", "\u265a"), - chess2 = c("\u265f", "\u265e", "\u265d", "\u265c", "\u265b", "\u265a"), - dice = dominoes_ranks[-1], - dice_fudge = dice_fudge, - dice_numeral = as.character(1:6), - dominoes = dominoes_ranks, - dominoes_black = dominoes_ranks, - dominoes_blue = dominoes_ranks, - dominoes_green = dominoes_ranks, - dominoes_red = dominoes_ranks, - dominoes_white = dominoes_ranks, - dominoes_yellow = dominoes_ranks, - icehouse_pieces = rep(" ", 6L), - alquerque = rep_len("\u25cf", 6L), - go = rep_len("\u25cf", 6L), - marbles = rep_len("\u25cf", 9L), - morris = rep_len("\u25cf", 9L), - reversi = c(rep_len("\u26c3", 5L), "\u26c1")) - rs + rs <- list( + piecepack = piecepack_ranks, + playing_cards_expansion = piecepack_ranks, + dual_piecepacks_expansion = piecepack_ranks, + subpack = piecepack_ranks, + checkers1 = c(rep_len("\u26c3", 5L), "\u26c1"), + checkers2 = c(rep_len("\u26c3", 5L), "\u26c1"), + chess1 = c("\u265f", "\u265e", "\u265d", "\u265c", "\u265b", "\u265a"), + chess2 = c("\u265f", "\u265e", "\u265d", "\u265c", "\u265b", "\u265a"), + dice = dominoes_ranks[-1], + dice_fudge = dice_fudge, + dice_numeral = as.character(1:6), + dominoes = dominoes_ranks, + dominoes_black = dominoes_ranks, + dominoes_blue = dominoes_ranks, + dominoes_green = dominoes_ranks, + dominoes_red = dominoes_ranks, + dominoes_white = dominoes_ranks, + dominoes_yellow = dominoes_ranks, + icehouse_pieces = rep(" ", 6L), + alquerque = rep_len("\u25cf", 6L), + go = rep_len("\u25cf", 6L), + marbles = rep_len("\u25cf", 9L), + morris = rep_len("\u25cf", 9L), + reversi = c(rep_len("\u26c3", 5L), "\u26c1") + ) + rs } get_style_ss <- function(style, big = FALSE) { - # nolint start - # Use Half-circle for Moons? \u25d0 - # Use Arrows for Arms? - # nolint end - if (style == "unicode") { - dominoes_ranks <- c(" ", "\u00b7", "\u280c", "\u22f0", "\u2237", "\u2059", "\u283f") - piecepack_suits <- c("\u2600", "\u263e", "\u265b", "\u2e38") - french_suits_black <- c("\u2665", "\u2660", "\u2663", "\u2666") - french_suits_white <- c("\u2661", "\u2664", "\u2667", "\u2662") - } else { - dominoes_ranks <- c("\U000FCA00", "\U000FCA01", "\U000FCA02", "\U000FCA03", "\U000FCA04", - "\U000FCA05", "\U000FCA06", "\U000FCA07", "\U000FCA08", "\U000FCA09") - if (big) { - piecepack_suits <- intToUtf8(utf8ToInt("\U000FCB00") + 0:3, multiple = TRUE) - french_suits_black <- intToUtf8(utf8ToInt("\U000FCB20") + 0:3, multiple = TRUE) - french_suits_white <- intToUtf8(utf8ToInt("\U000FCB30") + 0:3, multiple = TRUE) - } else { - piecepack_suits <- intToUtf8(utf8ToInt("\U000FCC00") + 0:3, multiple = TRUE) - french_suits_black <- intToUtf8(utf8ToInt("\U000FCC20") + 0:3, multiple = TRUE) - french_suits_white <- intToUtf8(utf8ToInt("\U000FCC30") + 0:3, multiple = TRUE) - } - } - - ss <- list(piecepack = piecepack_suits, - playing_cards_expansion = french_suits_black, - dual_piecepacks_expansion = french_suits_white, - subpack = piecepack_suits, - checkers1 = c(rep_len("\u26c2", 5L), "\u26c0", rep_len("\u26c2", 2L)), - checkers2 = c(rep_len("\u26c2", 5L), "\u26c0", rep_len("\u26c2", 2L)), - chess1 = "", - chess2 = "", - dice = rep_len(" ", 8L), - dice_fudge = rep_len(" ", 8L), - dice_numeral = rep_len(" ", 8L), - dominoes = dominoes_ranks, - dominoes_black = dominoes_ranks, - dominoes_blue = dominoes_ranks, - dominoes_green = dominoes_ranks, - dominoes_red = dominoes_ranks, - dominoes_white = dominoes_ranks, - dominoes_yellow = dominoes_ranks, - icehouse_pieces = c(rep_len("\u25b2", 5L), "\u25b3", rep_len("\u25b2", 2L)), - alquerque = c(rep_len("\u25cf", 5L), "\u25cb", rep_len("\u25cf", 2L)), - go = c(rep_len("\u25cf", 5L), "\u25cb", rep_len("\u25cf", 2L)), - marbles = c(rep_len("\u25cf", 5L), "\u25cb", rep_len("\u25cf", 2L)), - morris = c(rep_len("\u25cf", 5L), "\u25cb", rep_len("\u25cf", 2L)), - reversi = c(rep_len("\u26c3", 5L), "\u26c1", rep_len("\u26c3", 2L))) - ss + # nolint start + # Use Half-circle for Moons? \u25d0 + # Use Arrows for Arms? + # nolint end + if (style == "unicode") { + dominoes_ranks <- c(" ", "\u00b7", "\u280c", "\u22f0", "\u2237", "\u2059", "\u283f") + piecepack_suits <- c("\u2600", "\u263e", "\u265b", "\u2e38") + french_suits_black <- c("\u2665", "\u2660", "\u2663", "\u2666") + french_suits_white <- c("\u2661", "\u2664", "\u2667", "\u2662") + } else { + dominoes_ranks <- c( + "\U000FCA00", + "\U000FCA01", + "\U000FCA02", + "\U000FCA03", + "\U000FCA04", + "\U000FCA05", + "\U000FCA06", + "\U000FCA07", + "\U000FCA08", + "\U000FCA09" + ) + if (big) { + piecepack_suits <- intToUtf8(utf8ToInt("\U000FCB00") + 0:3, multiple = TRUE) + french_suits_black <- intToUtf8(utf8ToInt("\U000FCB20") + 0:3, multiple = TRUE) + french_suits_white <- intToUtf8(utf8ToInt("\U000FCB30") + 0:3, multiple = TRUE) + } else { + piecepack_suits <- intToUtf8(utf8ToInt("\U000FCC00") + 0:3, multiple = TRUE) + french_suits_black <- intToUtf8(utf8ToInt("\U000FCC20") + 0:3, multiple = TRUE) + french_suits_white <- intToUtf8(utf8ToInt("\U000FCC30") + 0:3, multiple = TRUE) + } + } + + ss <- list( + piecepack = piecepack_suits, + playing_cards_expansion = french_suits_black, + dual_piecepacks_expansion = french_suits_white, + subpack = piecepack_suits, + checkers1 = c(rep_len("\u26c2", 5L), "\u26c0", rep_len("\u26c2", 2L)), + checkers2 = c(rep_len("\u26c2", 5L), "\u26c0", rep_len("\u26c2", 2L)), + chess1 = "", + chess2 = "", + dice = rep_len(" ", 8L), + dice_fudge = rep_len(" ", 8L), + dice_numeral = rep_len(" ", 8L), + dominoes = dominoes_ranks, + dominoes_black = dominoes_ranks, + dominoes_blue = dominoes_ranks, + dominoes_green = dominoes_ranks, + dominoes_red = dominoes_ranks, + dominoes_white = dominoes_ranks, + dominoes_yellow = dominoes_ranks, + icehouse_pieces = c(rep_len("\u25b2", 5L), "\u25b3", rep_len("\u25b2", 2L)), + alquerque = c(rep_len("\u25cf", 5L), "\u25cb", rep_len("\u25cf", 2L)), + go = c(rep_len("\u25cf", 5L), "\u25cb", rep_len("\u25cf", 2L)), + marbles = c(rep_len("\u25cf", 5L), "\u25cb", rep_len("\u25cf", 2L)), + morris = c(rep_len("\u25cf", 5L), "\u25cb", rep_len("\u25cf", 2L)), + reversi = c(rep_len("\u26c3", 5L), "\u26c1", rep_len("\u26c3", 2L)) + ) + ss } # We usually use non-solid version of glyph for "white" hence "black" is appropriate @@ -263,716 +339,861 @@ dice_colors <- suit_colors dice_colors[2] <- "br_black" get_style_fg <- function(style) { - fg <- list(piecepack = suit_colors, - dual_piecepacks_expansion = suit_colors, - playing_cards_expansion = suit_colors[c(1L, 2L, 2L, 1L)], - subpack = suit_colors, - chess1 = suit_colors, - chess2 = suit_colors, - checkers1 = suit_colors, - checkers2 = suit_colors, - dice = dice_colors, - dice_fudge = dice_colors, - dice_numeral = dice_colors, - dominoes = rep_len("black", 7L), - dominoes_black = rep_len(dice_colors[2L], 7L), - dominoes_blue = rep_len(dice_colors[4L], 7L), - dominoes_green = rep_len(dice_colors[3L], 7L), - dominoes_red = rep_len(dice_colors[1L], 7L), - dominoes_white = rep_len(dice_colors[6L], 7L), - dominoes_yellow = rep_len(dice_colors[5L], 7L), - icehouse_pieces = dice_colors, - alquerque = suit_colors, - go = suit_colors, - marbles = suit_colors, - morris = suit_colors, - reversi = suit_colors) - fg + fg <- list( + piecepack = suit_colors, + dual_piecepacks_expansion = suit_colors, + playing_cards_expansion = suit_colors[c(1L, 2L, 2L, 1L)], + subpack = suit_colors, + chess1 = suit_colors, + chess2 = suit_colors, + checkers1 = suit_colors, + checkers2 = suit_colors, + dice = dice_colors, + dice_fudge = dice_colors, + dice_numeral = dice_colors, + dominoes = rep_len("black", 7L), + dominoes_black = rep_len(dice_colors[2L], 7L), + dominoes_blue = rep_len(dice_colors[4L], 7L), + dominoes_green = rep_len(dice_colors[3L], 7L), + dominoes_red = rep_len(dice_colors[1L], 7L), + dominoes_white = rep_len(dice_colors[6L], 7L), + dominoes_yellow = rep_len(dice_colors[5L], 7L), + icehouse_pieces = dice_colors, + alquerque = suit_colors, + go = suit_colors, + marbles = suit_colors, + morris = suit_colors, + reversi = suit_colors + ) + fg } color_text <- function(cm, color) { - if (color == "html") # always colorize if we'll be converting to html - rlang::local_options(cli.num_colors = 256L) - if (!isFALSE(color)) { - for (rr in seq.int(nrow(cm$char))) { - for (cc in seq.int(ncol(cm$char))) { - fg <- col_cli(cm$fg[rr, cc]) - colorize <- cli::combine_ansi_styles(fg, cli::bg_br_white) - cm$char[rr, cc] <- colorize(cm$char[rr, cc]) - } - } - } - cm -} - -col_cli <- function(col = c("black", "blue", "cyan", "green", "magenta", "red", "white", "yellow", - "grey", "silver", "none", - "br_black", "br_blue", "br_cyan", "br_green", "br_red", "br_white", "br_yellow")) { - col <- match.arg(col) - get(paste0("col_", col), envir = getNamespace("cli")) -} - -annotate_text <- function(cm, nc, nr, xoffset, yoffset, annotate, annotation_scale, - xbreaks, ybreaks) { - if (isFALSE(annotate) || annotate == "none") return(cm) - step <- 2 * annotation_scale - - if (is.null(xbreaks)) { - x <- seq(1 + step + 2 * xoffset, nc, by = step) - } else { - xbreaks <- as.integer(xbreaks) - x <- seq(1 + step + 2 * xoffset, by = step, length.out = max(xbreaks)) - } - if (annotate == "cartesian") { - x <- utils::head(x, 9) - xt <- as.character(seq_along(x)) - } else { - if (length(x) > 26) x <- x[1:26] - xt <- letters[seq_along(x)] - } - if (!is.null(xbreaks)) { - x <- x[xbreaks] - xt <- xt[xbreaks] - } - cm$char[1, x] <- xt - - if (is.null(ybreaks)) { - y <- seq(1 + step + 2 * yoffset, nr, by= step) - } else { - ybreaks <- as.integer(ybreaks) - y <- seq(1 + step + 2 * yoffset, by= step, length.out = max(ybreaks)) - } - yt <- as.character(seq_along(y)) - if (length(yt) > 9) { - yt <- stringr::str_pad(yt, 2, "right") - cm$char[y[-seq(9)], 2L] <- substr(yt[-seq(9)], 2, 2) - } - if (!is.null(ybreaks)) { - y <- y[ybreaks] - yt <- yt[ybreaks] - } - cm$char[y, 1L] <- substr(yt, 1L, 1L) - cm + if (color == "html") { + # always colorize if we'll be converting to html + rlang::local_options(cli.num_colors = 256L) + } + if (!isFALSE(color)) { + for (rr in seq.int(nrow(cm$char))) { + for (cc in seq.int(ncol(cm$char))) { + fg <- col_cli(cm$fg[rr, cc]) + colorize <- cli::combine_ansi_styles(fg, cli::bg_br_white) + cm$char[rr, cc] <- colorize(cm$char[rr, cc]) + } + } + } + cm +} + +col_cli <- function( + col = c( + "black", + "blue", + "cyan", + "green", + "magenta", + "red", + "white", + "yellow", + "grey", + "silver", + "none", + "br_black", + "br_blue", + "br_cyan", + "br_green", + "br_red", + "br_white", + "br_yellow" + ) +) { + col <- match.arg(col) + get(paste0("col_", col), envir = getNamespace("cli")) +} + +annotate_text <- function( + cm, + nc, + nr, + xoffset, + yoffset, + annotate, + annotation_scale, + xbreaks, + ybreaks +) { + if (isFALSE(annotate) || annotate == "none") { + return(cm) + } + step <- 2 * annotation_scale + + if (is.null(xbreaks)) { + x <- seq(1 + step + 2 * xoffset, nc, by = step) + } else { + xbreaks <- as.integer(xbreaks) + x <- seq(1 + step + 2 * xoffset, by = step, length.out = max(xbreaks)) + } + if (annotate == "cartesian") { + x <- utils::head(x, 9) + xt <- as.character(seq_along(x)) + } else { + if (length(x) > 26) { + x <- x[1:26] + } + xt <- letters[seq_along(x)] + } + if (!is.null(xbreaks)) { + x <- x[xbreaks] + xt <- xt[xbreaks] + } + cm$char[1, x] <- xt + + if (is.null(ybreaks)) { + y <- seq(1 + step + 2 * yoffset, nr, by = step) + } else { + ybreaks <- as.integer(ybreaks) + y <- seq(1 + step + 2 * yoffset, by = step, length.out = max(ybreaks)) + } + yt <- as.character(seq_along(y)) + if (length(yt) > 9) { + yt <- stringr::str_pad(yt, 2, "right") + cm$char[y[-seq(9)], 2L] <- substr(yt[-seq(9)], 2, 2) + } + if (!is.null(ybreaks)) { + y <- y[ybreaks] + yt <- yt[ybreaks] + } + cm$char[y, 1L] <- substr(yt, 1L, 1L) + cm } clean_df <- function(df) { - if (!hasName(df, "cfg")) df$cfg <- "piecepack" - df$cfg <- ifelse(is.na(df$cfg), "piecepack", df$cfg) - if (!hasName(df, "rank")) df$rank <- NA_integer_ - df$rank <- ifelse(is.na(df$rank), 1L, df$rank) - if (!hasName(df, "suit")) df$suit <- NA_integer_ - df$suit <- ifelse(is.na(df$suit), 1L, df$suit) - if (!hasName(df, "angle")) df$angle <- NA_real_ - df$angle <- ifelse(is.na(df$angle), 0, df$angle %% 360) - - # Adjust board sizes - # checkers/chess boards rank is number of cells - df$rank <- ifelse(df$rank == 1L & str_detect(df$piece_side, "^board") & str_detect(df$cfg, "[12]$"), - 8L, - df$rank) - # go board rank is number of lines - df$rank <- ifelse(str_detect(df$piece_side, "^board") & df$cfg == "go", - ifelse(df$rank == 1L, 18L, df$rank - 1), - df$rank) - # marbles board rank is number of holes - df$rank <- ifelse(str_detect(df$piece_side, "^board") & df$cfg == "marbles", - ifelse(df$rank == 1L, 4L, df$rank), - df$rank) - # alquerque board always has four "cells" - df$rank <- ifelse(str_detect(df$piece_side, "^board") & df$cfg == "alquerque", - 4L, - df$rank) - # morris rank is number of men - df$rank <- ifelse(str_detect(df$piece_side, "^board") & df$cfg == "morris", - ifelse(df$rank == 1L, 9L, df$rank), - df$rank) - - # Go stones and marbles should be "bit_back" - bit_back_cfgs <- c("alquerque", "go", "marbles", "morris") - df$piece_side <- ifelse(df$piece_side == "bit_face" & df$cfg %in% bit_back_cfgs, - "bit_back", - df$piece_side) - # reversi - reversi_flip <- df$cfg == "reversi" & df$piece_side == "bit_back" - df$piece_side <- ifelse(reversi_flip, "bit_face", df$piece_side) - df$suit <- ifelse(reversi_flip, c(7L, 6L, 8L, 5L, 4L, 2L, 1L, 3L)[df$suit], df$suit) - - attr(df, "was_cleaned") <- TRUE - df + if (!hasName(df, "cfg")) { + df$cfg <- "piecepack" + } + df$cfg <- ifelse(is.na(df$cfg), "piecepack", df$cfg) + if (!hasName(df, "rank")) { + df$rank <- NA_integer_ + } + df$rank <- ifelse(is.na(df$rank), 1L, df$rank) + if (!hasName(df, "suit")) { + df$suit <- NA_integer_ + } + df$suit <- ifelse(is.na(df$suit), 1L, df$suit) + if (!hasName(df, "angle")) { + df$angle <- NA_real_ + } + df$angle <- ifelse(is.na(df$angle), 0, df$angle %% 360) + + # Adjust board sizes + # checkers/chess boards rank is number of cells + df$rank <- ifelse( + df$rank == 1L & str_detect(df$piece_side, "^board") & str_detect(df$cfg, "[12]$"), + 8L, + df$rank + ) + # go board rank is number of lines + df$rank <- ifelse( + str_detect(df$piece_side, "^board") & df$cfg == "go", + ifelse(df$rank == 1L, 18L, df$rank - 1), + df$rank + ) + # marbles board rank is number of holes + df$rank <- ifelse( + str_detect(df$piece_side, "^board") & df$cfg == "marbles", + ifelse(df$rank == 1L, 4L, df$rank), + df$rank + ) + # alquerque board always has four "cells" + df$rank <- ifelse(str_detect(df$piece_side, "^board") & df$cfg == "alquerque", 4L, df$rank) + # morris rank is number of men + df$rank <- ifelse( + str_detect(df$piece_side, "^board") & df$cfg == "morris", + ifelse(df$rank == 1L, 9L, df$rank), + df$rank + ) + + # Go stones and marbles should be "bit_back" + bit_back_cfgs <- c("alquerque", "go", "marbles", "morris") + df$piece_side <- ifelse( + df$piece_side == "bit_face" & df$cfg %in% bit_back_cfgs, + "bit_back", + df$piece_side + ) + # reversi + reversi_flip <- df$cfg == "reversi" & df$piece_side == "bit_back" + df$piece_side <- ifelse(reversi_flip, "bit_face", df$piece_side) + df$suit <- ifelse(reversi_flip, c(7L, 6L, 8L, 5L, 4L, 2L, 1L, 3L)[df$suit], df$suit) + + attr(df, "was_cleaned") <- TRUE + df } get_df_offsets <- function(df, lr, xoffset, yoffset, annotate = FALSE) { - if (!(isFALSE(annotate) || annotate == "none")) { - xlbound <- ifelse(lr$ymax >= 10, 1.0, 0.5) - ylbound <- 0.5 - } else { - xlbound <- 0 - ylbound <- 0 - } - if (is.null(xoffset)) xoffset <- min2offset(lr$xmin, xlbound) - if (is.null(yoffset)) yoffset <- min2offset(lr$ymin, ylbound) - list(x = xoffset, y = yoffset) + if (!(isFALSE(annotate) || annotate == "none")) { + xlbound <- ifelse(lr$ymax >= 10, 1.0, 0.5) + ylbound <- 0.5 + } else { + xlbound <- 0 + ylbound <- 0 + } + if (is.null(xoffset)) { + xoffset <- min2offset(lr$xmin, xlbound) + } + if (is.null(yoffset)) { + yoffset <- min2offset(lr$ymin, ylbound) + } + list(x = xoffset, y = yoffset) } min2offset <- function(min, lbound = 0.5) { - if (is.na(min)) { - NA_real_ - } else if (min < lbound) { - lbound - min - } else { - 0 - } -} - - -add_piece <- function(cm, piece_side, suit, rank, x, y, angle, cfg, reorient = "none", style = get_style()) { - if (piece_side %in% c("tile_back", "coin_face", "card_back", "board_face", "board_back")) { - fg <- "black" - } else { - if (grepl("pyramid", piece_side)) cfg <- "icehouse_pieces" - if (piece_side == "tile_face") - ss <- style$ss_big[[cfg]][suit] - else - ss <- style$ss[[cfg]][suit] - if (piece_side == "pyramid_top") ss <- top_subs[[ss]] - if (!grepl("matchstick", piece_side)) - ss <- style$rotate(ss, angle, reorient) - fg <- style$fg[[cfg]][suit] - } - if (!(piece_side %in% c("tile_back", "coin_back", "card_back", - "pawn_face", "pawn_back", "board_face", "board_back"))) { - if (piece_side == "tile_face") - rs <- style$rs_big[[cfg]][rank] - else - rs <- style$rs[[cfg]][rank] - if (grepl("chess", cfg) && suit == 6L) rs <- unicode_chess_white[rank] - if (grepl("reversi", cfg) && suit == 6L) rs <- "\u26c1" - if (grepl("checkers", cfg) && suit == 6L) rs <- "\u26c1" - if (!grepl("matchstick", piece_side)) rs <- style$rotate(rs, angle, reorient) - } - if (grepl("2", cfg)) { - cell <- 2 - } else { - cell <- 1 - } - if (cfg == "morris") { - morris_widths <- c(6, 2, 2, 2, 4, 4, 4, 6, 6, 6, 6, 6) - board_width <- morris_widths[rank] - board_height <- morris_widths[rank] - } else { - board_width <- cell * rank - board_height <- cell * rank - } - switch(piece_side, - coin_back = add_coin_back(cm, ss, x, y, angle, fg, style), - coin_face = add_coin_face(cm, rs, x, y, angle, fg, style), - die_face = add_die_face(cm, rs, x, y, angle, fg, cfg, style, suit), - pawn_face = add_pawn_face(cm, ss, x, y, angle, fg, style), - pawn_back = add_pawn_back(cm, ss, x, y, angle, fg, style), - tile_face = add_tile_face(cm, ss, rs, x, y, angle, fg, cfg, style), - tile_back = add_tile_back(cm, x, y, angle, cfg, style), - bit_back = add_bit_back(cm, ss, x, y, fg), - bit_face = add_bit_face(cm, rs, x, y, fg), - board_back = add_board(cm, x, y, board_width, board_height, cell, cfg, style, rank), - board_face = add_board(cm, x, y, board_height, board_height, cell, cfg, style, rank), - matchstick_back = add_matchstick_face(cm, x, y, angle, fg, rank), - matchstick_face = add_matchstick_face(cm, x, y, angle, fg, rank), - pyramid_top = add_pyramid_top(cm, ss, x, y, angle, fg, rank), - pyramid_face = add_pyramid_face(cm, ss, x, y, angle, fg, rank), - pyramid_left = add_pyramid_face(cm, ss, x, y, angle, fg, rank), - pyramid_right = add_pyramid_face(cm, ss, x, y, angle, fg, rank), - pyramid_back = add_pyramid_face(cm, ss, x, y, angle, fg, rank), - { # nolint - warning("Don't know how to draw ", piece_side) - cm - }) + if (is.na(min)) { + NA_real_ + } else if (min < lbound) { + lbound - min + } else { + 0 + } +} + + +add_piece <- function( + cm, + piece_side, + suit, + rank, + x, + y, + angle, + cfg, + reorient = "none", + style = get_style() +) { + if (piece_side %in% c("tile_back", "coin_face", "card_back", "board_face", "board_back")) { + fg <- "black" + } else { + if (grepl("pyramid", piece_side)) { + cfg <- "icehouse_pieces" + } + if (piece_side == "tile_face") { + ss <- style$ss_big[[cfg]][suit] + } else { + ss <- style$ss[[cfg]][suit] + } + if (piece_side == "pyramid_top") { + ss <- top_subs[[ss]] + } + if (!grepl("matchstick", piece_side)) { + ss <- style$rotate(ss, angle, reorient) + } + fg <- style$fg[[cfg]][suit] + } + if ( + !(piece_side %in% + c( + "tile_back", + "coin_back", + "card_back", + "pawn_face", + "pawn_back", + "board_face", + "board_back" + )) + ) { + if (piece_side == "tile_face") { + rs <- style$rs_big[[cfg]][rank] + } else { + rs <- style$rs[[cfg]][rank] + } + if (grepl("chess", cfg) && suit == 6L) { + rs <- unicode_chess_white[rank] + } + if (grepl("reversi", cfg) && suit == 6L) { + rs <- "\u26c1" + } + if (grepl("checkers", cfg) && suit == 6L) { + rs <- "\u26c1" + } + if (!grepl("matchstick", piece_side)) rs <- style$rotate(rs, angle, reorient) + } + if (grepl("2", cfg)) { + cell <- 2 + } else { + cell <- 1 + } + if (cfg == "morris") { + morris_widths <- c(6, 2, 2, 2, 4, 4, 4, 6, 6, 6, 6, 6) + board_width <- morris_widths[rank] + board_height <- morris_widths[rank] + } else { + board_width <- cell * rank + board_height <- cell * rank + } + switch( + piece_side, + coin_back = add_coin_back(cm, ss, x, y, angle, fg, style), + coin_face = add_coin_face(cm, rs, x, y, angle, fg, style), + die_face = add_die_face(cm, rs, x, y, angle, fg, cfg, style, suit), + pawn_face = add_pawn_face(cm, ss, x, y, angle, fg, style), + pawn_back = add_pawn_back(cm, ss, x, y, angle, fg, style), + tile_face = add_tile_face(cm, ss, rs, x, y, angle, fg, cfg, style), + tile_back = add_tile_back(cm, x, y, angle, cfg, style), + bit_back = add_bit_back(cm, ss, x, y, fg), + bit_face = add_bit_face(cm, rs, x, y, fg), + board_back = add_board(cm, x, y, board_width, board_height, cell, cfg, style, rank), + board_face = add_board(cm, x, y, board_height, board_height, cell, cfg, style, rank), + matchstick_back = add_matchstick_face(cm, x, y, angle, fg, rank), + matchstick_face = add_matchstick_face(cm, x, y, angle, fg, rank), + pyramid_top = add_pyramid_top(cm, ss, x, y, angle, fg, rank), + pyramid_face = add_pyramid_face(cm, ss, x, y, angle, fg, rank), + pyramid_left = add_pyramid_face(cm, ss, x, y, angle, fg, rank), + pyramid_right = add_pyramid_face(cm, ss, x, y, angle, fg, rank), + pyramid_back = add_pyramid_face(cm, ss, x, y, angle, fg, rank), + { + # nolint + warning("Don't know how to draw ", piece_side) + cm + } + ) } add_matchstick_face <- function(cm, x, y, angle, fg, rank) { - switch(rank, - add_matchstick_face1(cm, x, y, angle, fg), - add_matchstick_face2(cm, x, y, angle, fg), - add_matchstick_face3(cm, x, y, angle, fg), - add_matchstick_face4(cm, x, y, angle, fg), - add_matchstick_face5(cm, x, y, angle, fg), - add_matchstick_face6(cm, x, y, angle, fg), - abort(paste("Don't know how to draw matchstick of rank", rank), - class = "unicode_diagram")) + switch( + rank, + add_matchstick_face1(cm, x, y, angle, fg), + add_matchstick_face2(cm, x, y, angle, fg), + add_matchstick_face3(cm, x, y, angle, fg), + add_matchstick_face4(cm, x, y, angle, fg), + add_matchstick_face5(cm, x, y, angle, fg), + add_matchstick_face6(cm, x, y, angle, fg), + abort(paste("Don't know how to draw matchstick of rank", rank), class = "unicode_diagram") + ) } abort_angle <- function(angle) { - abort(paste("Can't handle angle", angle), - class = "unicode_diagram", - angle = angle) - + abort(paste("Can't handle angle", angle), class = "unicode_diagram", angle = angle) } add_matchstick_face1 <- function(cm, x, y, angle, fg) { - if (angle %in% c(0, 90, 180, 270)) { - cm$char[y, x] <- "\u25a0" - } else if (angle %in% c(45, 135, 225, 315)) { - cm$char[y, x] <- "\u25c6" - } else { - abort_angle(angle) - } - cm$fg[y, x] <- fg - cm + if (angle %in% c(0, 90, 180, 270)) { + cm$char[y, x] <- "\u25a0" + } else if (angle %in% c(45, 135, 225, 315)) { + cm$char[y, x] <- "\u25c6" + } else { + abort_angle(angle) + } + cm$fg[y, x] <- fg + cm } add_matchstick_face2 <- function(cm, x, y, angle, fg) { - if (angle %in% c(0, 180)) { - cm$char[y, x] <- "\u2503" - } else if (angle %in% c(90, 270)) { - cm$char[y, x] <- "\u2501" - } else if (angle %in% c(45, 225)) { - cm$char[y, x] <- "\u2572" - } else if (angle %in% c(135, 315)) { - cm$char[y, x] <- "\u2571" - } else { - abort_angle(angle) - } - cm$fg[y, x] <- fg - cm + if (angle %in% c(0, 180)) { + cm$char[y, x] <- "\u2503" + } else if (angle %in% c(90, 270)) { + cm$char[y, x] <- "\u2501" + } else if (angle %in% c(45, 225)) { + cm$char[y, x] <- "\u2572" + } else if (angle %in% c(135, 315)) { + cm$char[y, x] <- "\u2571" + } else { + abort_angle(angle) + } + cm$fg[y, x] <- fg + cm } add_matchstick_face3 <- add_matchstick_face2 add_matchstick_face4 <- function(cm, x, y, angle, fg) { - if (angle %in% c(0, 180)) { - cm$char[y+-1:1, x] <- "\u2503" - cm$fg[y+-1:1, x] <- fg - } else if (angle %in% c(90, 270)) { - cm$char[y, x+-1:1] <- "\u2501" - cm$fg[y, x+-1:1] <- fg - } else if (angle %in% c(45, 225)) { - cm$char[y+1, x+-1] <- "\u2572" - cm$fg[y+1, x+-1] <- fg - cm$char[y, x] <- "\u2572" - cm$fg[y, x] <- fg - cm$char[y-1, x+1] <- "\u2572" - cm$fg[y-1, x+1] <- fg - } else if (angle %in% c(135, 315)) { - cm$char[y+-1, x+-1] <- "\u2571" - cm$fg[y+-1, x+-1] <- fg - cm$char[y, x] <- "\u2571" - cm$fg[y, x] <- fg - cm$char[y+1, x+1] <- "\u2571" - cm$fg[y+1, x+1] <- fg - } else if (angle %in% c(60, 240)) { - cm$char[y, x] <- "\u2572" - cm$fg[y, x] <- fg - } else if (angle %in% c(120, 300)) { - cm$char[y, x] <- "\u2571" - cm$fg[y, x] <- fg - } else { - abort_angle(angle) - } - cm + if (angle %in% c(0, 180)) { + cm$char[y + -1:1, x] <- "\u2503" + cm$fg[y + -1:1, x] <- fg + } else if (angle %in% c(90, 270)) { + cm$char[y, x + -1:1] <- "\u2501" + cm$fg[y, x + -1:1] <- fg + } else if (angle %in% c(45, 225)) { + cm$char[y + 1, x + -1] <- "\u2572" + cm$fg[y + 1, x + -1] <- fg + cm$char[y, x] <- "\u2572" + cm$fg[y, x] <- fg + cm$char[y - 1, x + 1] <- "\u2572" + cm$fg[y - 1, x + 1] <- fg + } else if (angle %in% c(135, 315)) { + cm$char[y + -1, x + -1] <- "\u2571" + cm$fg[y + -1, x + -1] <- fg + cm$char[y, x] <- "\u2571" + cm$fg[y, x] <- fg + cm$char[y + 1, x + 1] <- "\u2571" + cm$fg[y + 1, x + 1] <- fg + } else if (angle %in% c(60, 240)) { + cm$char[y, x] <- "\u2572" + cm$fg[y, x] <- fg + } else if (angle %in% c(120, 300)) { + cm$char[y, x] <- "\u2571" + cm$fg[y, x] <- fg + } else { + abort_angle(angle) + } + cm } add_matchstick_face5 <- add_matchstick_face4 add_matchstick_face6 <- function(cm, x, y, angle, fg) { - if (angle %in% c(0, 180)) { - cm$char[y+-2:2, x] <- "\u2503" - cm$fg[y+-2:2, x] <- fg - } else if (angle %in% c(90, 270)) { - cm$char[y, x+-2:2] <- "\u2501" - cm$fg[y, x+-2:2] <- fg - } else if (angle %in% c(45, 225)) { - cm$char[y+1, x+-1] <- "\u2572" - cm$fg[y+1, x+-1] <- fg - cm$char[y, x] <- "\u2572" - cm$fg[y, x] <- fg - cm$char[y-1, x+1] <- "\u2572" - cm$fg[y-1, x+1] <- fg - } else if (angle %in% c(135, 315)) { - cm$char[y+-1, x+-1] <- "\u2571" - cm$fg[y+-1, x+-1] <- fg - cm$char[y, x] <- "\u2571" - cm$fg[y, x] <- fg - cm$char[y+1, x+1] <- "\u2571" - cm$fg[y+1, x+1] <- fg - } else { - abort_angle(angle) - } - cm + if (angle %in% c(0, 180)) { + cm$char[y + -2:2, x] <- "\u2503" + cm$fg[y + -2:2, x] <- fg + } else if (angle %in% c(90, 270)) { + cm$char[y, x + -2:2] <- "\u2501" + cm$fg[y, x + -2:2] <- fg + } else if (angle %in% c(45, 225)) { + cm$char[y + 1, x + -1] <- "\u2572" + cm$fg[y + 1, x + -1] <- fg + cm$char[y, x] <- "\u2572" + cm$fg[y, x] <- fg + cm$char[y - 1, x + 1] <- "\u2572" + cm$fg[y - 1, x + 1] <- fg + } else if (angle %in% c(135, 315)) { + cm$char[y + -1, x + -1] <- "\u2571" + cm$fg[y + -1, x + -1] <- fg + cm$char[y, x] <- "\u2571" + cm$fg[y, x] <- fg + cm$char[y + 1, x + 1] <- "\u2571" + cm$fg[y + 1, x + 1] <- fg + } else { + abort_angle(angle) + } + cm } add_bit_face <- function(cm, rs, x, y, fg) { - cm$char[y, x] <- rs - cm$fg[y, x] <- fg - cm + cm$char[y, x] <- rs + cm$fg[y, x] <- fg + cm } add_bit_back <- function(cm, ss, x, y, fg) { - cm$char[y, x] <- ss - cm$fg[y, x] <- fg - cm + cm$char[y, x] <- ss + cm$fg[y, x] <- fg + cm } add_coin_back <- function(cm, ss, x, y, angle, fg, style) { - enclosing_coin <- style$rotate(style$combining$coin, angle) - cm$char[y, x] <- paste0(ss, enclosing_coin) - cm$fg[y, x] <- fg - cm + enclosing_coin <- style$rotate(style$combining$coin, angle) + cm$char[y, x] <- paste0(ss, enclosing_coin) + cm$fg[y, x] <- fg + cm } add_coin_face <- function(cm, rs, x, y, angle, fg, style) { - enclosing_coin <- style$rotate(style$combining$coin, angle) - cm$char[y, x] <- paste0(rs, enclosing_coin) - cm$fg[y, x] <- fg - cm + enclosing_coin <- style$rotate(style$combining$coin, angle) + cm$char[y, x] <- paste0(rs, enclosing_coin) + cm$fg[y, x] <- fg + cm } add_die_face <- function(cm, rs, x, y, angle, fg, cfg, style, suit) { - enclosing_die <- style$rotate(style$combining$die[[cfg]][suit], angle) - # nolint start - # ds <- die_subs[[char]] - # if (!is.null(ds)) char <- ds - # nolint end - char <- paste0(rs, enclosing_die) - cm$char[y, x] <- char - cm$fg[y, x] <- fg - cm + enclosing_die <- style$rotate(style$combining$die[[cfg]][suit], angle) + # nolint start + # ds <- die_subs[[char]] + # if (!is.null(ds)) char <- ds + # nolint end + char <- paste0(rs, enclosing_die) + cm$char[y, x] <- char + cm$fg[y, x] <- fg + cm } add_pawn_face <- function(cm, ss, x, y, angle, fg, style) { - enclosing_pawn <- style$rotate(style$combining$pawn, angle) - cm$char[y, x] <- paste0(ss, enclosing_pawn) - cm$fg[y, x] <- fg - cm + enclosing_pawn <- style$rotate(style$combining$pawn, angle) + cm$char[y, x] <- paste0(ss, enclosing_pawn) + cm$fg[y, x] <- fg + cm } add_pawn_back <- function(cm, ss, x, y, angle, fg, style) { - enclosing_pawn <- style$rotate(style$combining$pawn, angle) - cm$char[y, x] <- paste0(ss, enclosing_pawn) - cm$fg[y, x] <- fg - cm + enclosing_pawn <- style$rotate(style$combining$pawn, angle) + cm$char[y, x] <- paste0(ss, enclosing_pawn) + cm$fg[y, x] <- fg + cm } add_pyramid_face <- function(cm, ss, x, y, angle, fg, rank = 1) { - # nolint start - # if (angle %% 90 == 0) { - # cm$char[y, x] <- paste0(ss, "\u20de") - # } else { - # cm$char[y, x] <- paste0(ss, "\u20df") - # } - # nolint end - cm$char[y, x] <- paste0(ss, get_dots(rank)) - cm$fg[y, x] <- fg - cm + # nolint start + # if (angle %% 90 == 0) { + # cm$char[y, x] <- paste0(ss, "\u20de") + # } else { + # cm$char[y, x] <- paste0(ss, "\u20df") + # } + # nolint end + cm$char[y, x] <- paste0(ss, get_dots(rank)) + cm$fg[y, x] <- fg + cm } # top dots U+0307 U+0308 U+20db U+20dc # bottom dots U+0323 U+0324 U+20ef get_dots <- function(rank) { - switch(rank, "\u0323", "\u0324", "\u20e8", "\u0324\u0308", "\u20e8\u0308", "\u20e8\u20db", - abort(paste("Doesn't support", rank, "dots")), class = "unicode_diagram") + switch( + rank, + "\u0323", + "\u0324", + "\u20e8", + "\u0324\u0308", + "\u20e8\u0308", + "\u20e8\u20db", + abort(paste("Doesn't support", rank, "dots")), + class = "unicode_diagram" + ) } add_pyramid_top <- function(cm, ss, x, y, angle, fg, rank = 1) { - # nolint start - # if (angle %% 90 == 0) { - # cm$char[y, x] <- paste0(ss, "\u20de") - # } else { - # cm$char[y, x] <- paste0(ss, "\u20df") - # } - # nolint end - cm$char[y, x] <- paste0(ss, get_dots(rank)) - cm$fg[y, x] <- fg - cm + # nolint start + # if (angle %% 90 == 0) { + # cm$char[y, x] <- paste0(ss, "\u20de") + # } else { + # cm$char[y, x] <- paste0(ss, "\u20df") + # } + # nolint end + cm$char[y, x] <- paste0(ss, get_dots(rank)) + cm$fg[y, x] <- fg + cm } add_tile_back <- function(cm, x, y, angle, cfg, style) { - if (angle %% 90 != 0) abort_angle(angle) + if (angle %% 90 != 0) { + abort_angle(angle) + } - if (cfg == "subpack") { - add_tile_back_subpack(cm, x, y, style) - } else if (grepl("dominoes", cfg)) { - add_tile_back_dominoes(cm, x, y, angle, style) - } else { - add_tile_back_piecepack(cm, x, y, style) - } + if (cfg == "subpack") { + add_tile_back_subpack(cm, x, y, style) + } else if (grepl("dominoes", cfg)) { + add_tile_back_dominoes(cm, x, y, angle, style) + } else { + add_tile_back_piecepack(cm, x, y, style) + } } add_tile_back_dominoes <- function(cm, x, y, angle, style) { - if (angle %% 180 == 0) { # vertical - cm$fg[y+-2:2, x+-1:1] <- "black" - cm <- add_border(cm, x, y, width = 1, height = 2, space = style$space) - cm - } else if (angle %% 90 == 0) { # horizontal - cm$fg[y+-1:1, x+-2:2] <- "black" - cm <- add_border(cm, x, y, width = 2, height = 1, space = style$space) - cm - } + if (angle %% 180 == 0) { + # vertical + cm$fg[y + -2:2, x + -1:1] <- "black" + cm <- add_border(cm, x, y, width = 1, height = 2, space = style$space) + cm + } else if (angle %% 90 == 0) { + # horizontal + cm$fg[y + -1:1, x + -2:2] <- "black" + cm <- add_border(cm, x, y, width = 2, height = 1, space = style$space) + cm + } } add_tile_back_piecepack <- function(cm, x, y, style) { - cm$fg[y+-2:2, x+-2:2] <- "black" - cm <- add_border(cm, x, y, space = style$space) - cm <- add_gridlines(cm, x, y, has_pua_box_drawing = style$has_pua_box_drawing) - cm + cm$fg[y + -2:2, x + -2:2] <- "black" + cm <- add_border(cm, x, y, space = style$space) + cm <- add_gridlines(cm, x, y, has_pua_box_drawing = style$has_pua_box_drawing) + cm } add_tile_back_subpack <- function(cm, x, y, style) { - cm$fg[y+-1:1, x+-1:1] <- "black" - cm <- add_border(cm, x, y, 1, 1, space = style$space) - cm <- add_gridlines(cm, x, y, 1, 1, 0.5, - has_pua_box_drawing = style$has_pua_box_drawing) - cm + cm$fg[y + -1:1, x + -1:1] <- "black" + cm <- add_border(cm, x, y, 1, 1, space = style$space) + cm <- add_gridlines(cm, x, y, 1, 1, 0.5, has_pua_box_drawing = style$has_pua_box_drawing) + cm } add_tile_face <- function(cm, ss, rs, x, y, angle, fg, cfg, style) { - if (angle %% 90 != 0) abort_angle(angle) + if (angle %% 90 != 0) { + abort_angle(angle) + } - if (cfg == "subpack") { - add_tile_face_subpack(cm, rs, x, y, fg, style) - } else if (grepl("dominoes", cfg)) { - add_tile_face_dominoes(cm, ss, rs, x, y, angle, fg, style) - } else { - add_tile_face_piecepack(cm, ss, rs, x, y, angle, fg, style) - } + if (cfg == "subpack") { + add_tile_face_subpack(cm, rs, x, y, fg, style) + } else if (grepl("dominoes", cfg)) { + add_tile_face_dominoes(cm, ss, rs, x, y, angle, fg, style) + } else { + add_tile_face_piecepack(cm, ss, rs, x, y, angle, fg, style) + } } add_tile_face_subpack <- function(cm, rs, x, y, fg, style) { - cm$fg[y+-1:1, x+-1:1] <- "black" - cm <- add_border(cm, x, y, 1, 1, space = style$space) - cm$char[y, x] <- rs - cm$fg[y, x] <- fg - cm + cm$fg[y + -1:1, x + -1:1] <- "black" + cm <- add_border(cm, x, y, 1, 1, space = style$space) + cm$char[y, x] <- rs + cm$fg[y, x] <- fg + cm } add_tile_face_dominoes <- function(cm, ss, rs, x, y, angle, fg, style) { - if (angle == 0) { - cm$fg[y+-2:2, x+-1:1] <- "black" - cm <- add_border(cm, x, y, width = 1, height = 2, space = style$space) - cm$char[y+-1:1, x] <- c(ss, "\u2501", rs) - cm$fg[y+-1:1, x] <- fg - } else if (angle == 90) { - cm$fg[y+-1:1, x+-2:2] <- "black" - cm <- add_border(cm, x, y, width = 2, height = 1, space = style$space) - cm$char[y, x+-1:1] <- c(rs, "\u2503", ss) - cm$fg[y, x+-1:1] <- fg - } - if (angle == 180) { - cm$fg[y+-2:2, x+-1:1] <- "black" - cm <- add_border(cm, x, y, width = 1, height = 2, space = style$space) - cm$char[y+-1:1, x] <- c(rs, "\u2501", ss) - cm$fg[y+-1:1, x] <- fg - } else if (angle == 270) { - cm$fg[y+-1:1, x+-2:2] <- "black" - cm <- add_border(cm, x, y, width = 2, height = 1, space = style$space) - cm$char[y, x+-1:1] <- c(ss, "\u2503", rs) - cm$fg[y, x+-1:1] <- fg - } - cm + if (angle == 0) { + cm$fg[y + -2:2, x + -1:1] <- "black" + cm <- add_border(cm, x, y, width = 1, height = 2, space = style$space) + cm$char[y + -1:1, x] <- c(ss, "\u2501", rs) + cm$fg[y + -1:1, x] <- fg + } else if (angle == 90) { + cm$fg[y + -1:1, x + -2:2] <- "black" + cm <- add_border(cm, x, y, width = 2, height = 1, space = style$space) + cm$char[y, x + -1:1] <- c(rs, "\u2503", ss) + cm$fg[y, x + -1:1] <- fg + } + if (angle == 180) { + cm$fg[y + -2:2, x + -1:1] <- "black" + cm <- add_border(cm, x, y, width = 1, height = 2, space = style$space) + cm$char[y + -1:1, x] <- c(rs, "\u2501", ss) + cm$fg[y + -1:1, x] <- fg + } else if (angle == 270) { + cm$fg[y + -1:1, x + -2:2] <- "black" + cm <- add_border(cm, x, y, width = 2, height = 1, space = style$space) + cm$char[y, x + -1:1] <- c(ss, "\u2503", rs) + cm$fg[y, x + -1:1] <- fg + } + cm } add_tile_face_piecepack <- function(cm, ss, rs, x, y, angle, fg, style) { - cm$fg[y+-2:2, x+-2:2] <- "black" - cm <- add_border(cm, x, y, space = style$space) - # rank symbol - cm$char[y, x] <- rs - cm$fg[y, x] <- fg - # suit symbol - if (angle == 0) { - cm$char[y+1, x-1] <- ss - cm$fg[y+1, x-1] <- fg - } else if (angle == 90) { - cm$char[y-1, x-1] <- ss - cm$fg[y-1, x-1] <- fg - } else if (angle == 180) { - cm$char[y-1, x+1] <- ss - cm$fg[y-1, x+1] <- fg - } else if (angle == 270) { - cm$char[y+1, x+1] <- ss - cm$fg[y+1, x+1] <- fg - } - cm -} - -add_board <- function(cm, x, y, width = 8, height = 8, cell = 1, - cfg = "checkers1", - style = get_style("Unicode"), - rank = 8L) { - cm$fg[y+-height:height, x+-width:width] <- "black" - if (cfg != "morris") - cm <- add_border(cm, x, y, width, height, space = style$space) - cm <- switch(cfg, - alquerque = add_alquerque_board(cm, x, y, width, height, cell), - marbles = add_holes(cm, x, y, width, height, cell), - morris = add_morris_board(cm, x, y, width, height, cell, style, rank), - add_gridlines(cm, x, y, width, height, cell) - ) - cm -} - -add_morris_board <- function(cm, x, y, width = 2, height = 2, cell = 1, - style = get_style("Unicode"), rank = 9L) { - hv <- 1L # light - if (rank == 2L) { # three men's morris without diagonals - cm <- add_border(cm, x, y, width, height, space = style$space) - cm <- add_gridlines(cm, x, y, width, height, cell = 1, heavy = FALSE) - } else if (rank < 5L) { # three men's morris - cm <- add_border(cm, x, y, width, height, space = style$space) - cm <- add_alquerque_board(cm, x, y, width, height, cell) - } else if (rank < 7L) { # six men's morris - cm <- add_border(cm, x, y, width, height, space = style$space) - cm <- add_border(cm, x, y, 2L, 2L, space = style$space) - cm$char[y, x + c(-3, 3)] <- "\u2500" # light horizontal line - cm$char[y + c(-3, 3), x] <- "\u2502" # light vertical line - # intersection gridlines and border line - cm <- add_box_edge(cm, x-width, y, c(1L, hv, 1L, NA)) # left - cm <- add_box_edge(cm, x+2, y, c(1L, hv, 1L, NA)) # left - cm <- add_box_edge(cm, x+width, y, c(1L, NA, 1L, hv)) # right - cm <- add_box_edge(cm, x-2, y, c(1L, NA, 1L, hv)) # right - cm <- add_box_edge(cm, x, y+height, c(NA, 1L, hv, 1L)) # top - cm <- add_box_edge(cm, x, y-2, c(NA, 1L, hv, 1L)) # top - cm <- add_box_edge(cm, x, y-height, c(hv, 1L, NA, 1L)) # bottom - cm <- add_box_edge(cm, x, y+2, c(hv, 1L, NA, 1L)) # bottom - } else if (rank == 7L) { # seven men's morris - cm <- add_border(cm, x, y, width, height, space = style$space) - cm <- add_border(cm, x, y, 2L, 2L, space = style$space) - cm <- add_gridlines(cm, x, y, width, height, cell = 2, heavy = FALSE) - cm$char[y, x + c(-2L, 2L)] <- "\u253c" # light crosses - cm$char[y + c(-2L, 2L), x] <- "\u253c" # light crosses - } else { # 9 men's morris - cm <- add_border(cm, x, y, width, height, space = style$space) - cm <- add_border(cm, x, y, 4L, 4L, space = style$space) - cm <- add_border(cm, x, y, 2L, 2L, space = style$space) - cm$char[y, x + c(-5, -3, 3, 5)] <- "\u2500" # light horizontal line - cm$char[y + c(-5, -3, 3, 5), x] <- "\u2502" # light vertical line - cm$char[y, x + c(-4L, 4L)] <- "\u253c" # light crosses - cm$char[y + c(-4L, 4L), x] <- "\u253c" # light crosses - cm <- add_box_edge(cm, x-width, y, c(1L, hv, 1L, NA)) # left - cm <- add_box_edge(cm, x+2, y, c(1L, hv, 1L, NA)) # left - cm <- add_box_edge(cm, x+width, y, c(1L, NA, 1L, hv)) # right - cm <- add_box_edge(cm, x-2, y, c(1L, NA, 1L, hv)) # right - cm <- add_box_edge(cm, x, y+height, c(NA, 1L, hv, 1L)) # top - cm <- add_box_edge(cm, x, y-2, c(NA, 1L, hv, 1L)) # top - cm <- add_box_edge(cm, x, y-height, c(hv, 1L, NA, 1L)) # bottom - cm <- add_box_edge(cm, x, y+2, c(hv, 1L, NA, 1L)) # bottom - if (rank > 10L) { # 12 men's morris - cm$char[x - 5, y - 5] <- "\u2571" # up to right diagonal - cm$char[x - 3, y - 3] <- "\u2571" # up to right diagonal - cm$char[x + 3, y + 3] <- "\u2571" # up to right diagonal - cm$char[x + 5, y + 5] <- "\u2571" # up to right diagonal - cm$char[x + 5, y - 5] <- "\u2572" # up to left diagonal - cm$char[x + 3, y - 3] <- "\u2572" # up to left diagonal - cm$char[x - 3, y + 3] <- "\u2572" # up to left diagonal - cm$char[x - 5, y + 5] <- "\u2572" # up to left diagonal - - } - } - cm + cm$fg[y + -2:2, x + -2:2] <- "black" + cm <- add_border(cm, x, y, space = style$space) + # rank symbol + cm$char[y, x] <- rs + cm$fg[y, x] <- fg + # suit symbol + if (angle == 0) { + cm$char[y + 1, x - 1] <- ss + cm$fg[y + 1, x - 1] <- fg + } else if (angle == 90) { + cm$char[y - 1, x - 1] <- ss + cm$fg[y - 1, x - 1] <- fg + } else if (angle == 180) { + cm$char[y - 1, x + 1] <- ss + cm$fg[y - 1, x + 1] <- fg + } else if (angle == 270) { + cm$char[y + 1, x + 1] <- ss + cm$fg[y + 1, x + 1] <- fg + } + cm +} + +add_board <- function( + cm, + x, + y, + width = 8, + height = 8, + cell = 1, + cfg = "checkers1", + style = get_style("Unicode"), + rank = 8L +) { + cm$fg[y + -height:height, x + -width:width] <- "black" + if (cfg != "morris") { + cm <- add_border(cm, x, y, width, height, space = style$space) + } + cm <- switch( + cfg, + alquerque = add_alquerque_board(cm, x, y, width, height, cell), + marbles = add_holes(cm, x, y, width, height, cell), + morris = add_morris_board(cm, x, y, width, height, cell, style, rank), + add_gridlines(cm, x, y, width, height, cell) + ) + cm +} + +add_morris_board <- function( + cm, + x, + y, + width = 2, + height = 2, + cell = 1, + style = get_style("Unicode"), + rank = 9L +) { + hv <- 1L # light + if (rank == 2L) { + # three men's morris without diagonals + cm <- add_border(cm, x, y, width, height, space = style$space) + cm <- add_gridlines(cm, x, y, width, height, cell = 1, heavy = FALSE) + } else if (rank < 5L) { + # three men's morris + cm <- add_border(cm, x, y, width, height, space = style$space) + cm <- add_alquerque_board(cm, x, y, width, height, cell) + } else if (rank < 7L) { + # six men's morris + cm <- add_border(cm, x, y, width, height, space = style$space) + cm <- add_border(cm, x, y, 2L, 2L, space = style$space) + cm$char[y, x + c(-3, 3)] <- "\u2500" # light horizontal line + cm$char[y + c(-3, 3), x] <- "\u2502" # light vertical line + # intersection gridlines and border line + cm <- add_box_edge(cm, x - width, y, c(1L, hv, 1L, NA)) # left + cm <- add_box_edge(cm, x + 2, y, c(1L, hv, 1L, NA)) # left + cm <- add_box_edge(cm, x + width, y, c(1L, NA, 1L, hv)) # right + cm <- add_box_edge(cm, x - 2, y, c(1L, NA, 1L, hv)) # right + cm <- add_box_edge(cm, x, y + height, c(NA, 1L, hv, 1L)) # top + cm <- add_box_edge(cm, x, y - 2, c(NA, 1L, hv, 1L)) # top + cm <- add_box_edge(cm, x, y - height, c(hv, 1L, NA, 1L)) # bottom + cm <- add_box_edge(cm, x, y + 2, c(hv, 1L, NA, 1L)) # bottom + } else if (rank == 7L) { + # seven men's morris + cm <- add_border(cm, x, y, width, height, space = style$space) + cm <- add_border(cm, x, y, 2L, 2L, space = style$space) + cm <- add_gridlines(cm, x, y, width, height, cell = 2, heavy = FALSE) + cm$char[y, x + c(-2L, 2L)] <- "\u253c" # light crosses + cm$char[y + c(-2L, 2L), x] <- "\u253c" # light crosses + } else { + # 9 men's morris + cm <- add_border(cm, x, y, width, height, space = style$space) + cm <- add_border(cm, x, y, 4L, 4L, space = style$space) + cm <- add_border(cm, x, y, 2L, 2L, space = style$space) + cm$char[y, x + c(-5, -3, 3, 5)] <- "\u2500" # light horizontal line + cm$char[y + c(-5, -3, 3, 5), x] <- "\u2502" # light vertical line + cm$char[y, x + c(-4L, 4L)] <- "\u253c" # light crosses + cm$char[y + c(-4L, 4L), x] <- "\u253c" # light crosses + cm <- add_box_edge(cm, x - width, y, c(1L, hv, 1L, NA)) # left + cm <- add_box_edge(cm, x + 2, y, c(1L, hv, 1L, NA)) # left + cm <- add_box_edge(cm, x + width, y, c(1L, NA, 1L, hv)) # right + cm <- add_box_edge(cm, x - 2, y, c(1L, NA, 1L, hv)) # right + cm <- add_box_edge(cm, x, y + height, c(NA, 1L, hv, 1L)) # top + cm <- add_box_edge(cm, x, y - 2, c(NA, 1L, hv, 1L)) # top + cm <- add_box_edge(cm, x, y - height, c(hv, 1L, NA, 1L)) # bottom + cm <- add_box_edge(cm, x, y + 2, c(hv, 1L, NA, 1L)) # bottom + if (rank > 10L) { + # 12 men's morris + cm$char[x - 5, y - 5] <- "\u2571" # up to right diagonal + cm$char[x - 3, y - 3] <- "\u2571" # up to right diagonal + cm$char[x + 3, y + 3] <- "\u2571" # up to right diagonal + cm$char[x + 5, y + 5] <- "\u2571" # up to right diagonal + cm$char[x + 5, y - 5] <- "\u2572" # up to left diagonal + cm$char[x + 3, y - 3] <- "\u2572" # up to left diagonal + cm$char[x - 3, y + 3] <- "\u2572" # up to left diagonal + cm$char[x - 5, y + 5] <- "\u2572" # up to left diagonal + } + } + cm } add_alquerque_board <- function(cm, x, y, width = 4, height = 4, cell = 1) { - stopifnot(width %% 2 == 0, height %% 2 == 0) - cm <- add_gridlines(cm, x, y, width, height, cell, heavy = FALSE) - xl <- x - width - xr <- x + width - yb <- y - height - yt <- y + height - xur <- rep(seq.int(xl + 1L, xr - 1L, by = 4L), height / 2) - yur <- rep(seq.int(yb + 1L, yt - 1L, by = 4L), each = 2L) - cm$char[xur, yur] <- "\u2571" - xur <- rep(seq.int(xl + 3L, xr - 1L, by = 4L), height / 2) - yur <- rep(seq.int(yb + 3L, yt - 1L, by = 4L), each = 2L) - cm$char[xur, yur] <- "\u2571" - xul <- rep(seq.int(xl + 1L, xr - 1L, by = 4L), height / 2) - yul <- rep(seq.int(yb + 3L, yt - 1L, by = 4L), each = 2L) - cm$char[xul, yul] <- "\u2572" - xul <- rep(seq.int(xl + 3L, xr - 1L, by = 4L), height / 2) - yul <- rep(seq.int(yb + 1L, yt - 1L, by = 4L), each = 2L) - cm$char[xul, yul] <- "\u2572" - cm + stopifnot(width %% 2 == 0, height %% 2 == 0) + cm <- add_gridlines(cm, x, y, width, height, cell, heavy = FALSE) + xl <- x - width + xr <- x + width + yb <- y - height + yt <- y + height + xur <- rep(seq.int(xl + 1L, xr - 1L, by = 4L), height / 2) + yur <- rep(seq.int(yb + 1L, yt - 1L, by = 4L), each = 2L) + cm$char[xur, yur] <- "\u2571" + xur <- rep(seq.int(xl + 3L, xr - 1L, by = 4L), height / 2) + yur <- rep(seq.int(yb + 3L, yt - 1L, by = 4L), each = 2L) + cm$char[xur, yur] <- "\u2571" + xul <- rep(seq.int(xl + 1L, xr - 1L, by = 4L), height / 2) + yul <- rep(seq.int(yb + 3L, yt - 1L, by = 4L), each = 2L) + cm$char[xul, yul] <- "\u2572" + xul <- rep(seq.int(xl + 3L, xr - 1L, by = 4L), height / 2) + yul <- rep(seq.int(yb + 1L, yt - 1L, by = 4L), each = 2L) + cm$char[xul, yul] <- "\u2572" + cm } add_holes <- function(cm, x, y, width = 2, height = 2, cell = 1) { - xgs <- x + seq(cell - width, width - cell, 2 * cell) - ygs <- y + seq(cell - height, height - cell, 2 * cell) - # cm$char[ygs, xgs] <- "\u25ce" - cm$char[ygs, xgs] <- "\u25cc" - cm -} - -add_gridlines <- function(cm, x, y, width = 2, height = 2, cell = 1, - has_pua_box_drawing = FALSE, heavy = TRUE) { - # gridlines - xgs <- x + seq(2 * cell - width, width - 2 * cell, 2 * cell) - ygs <- y + seq(2 * cell - height, height - 2 * cell, 2 * cell) - xo <- x + seq(1 - width, width - 1) - yo <- y + seq(1 - height, height - 1) - - if (heavy) { - cm$char[ygs, xo] <- "\u2501" # horizontal lines - cm$char[yo, xgs] <- "\u2503" # vertical lines - cm$char[ygs, xgs] <- "\u254b" # crosses - hv <- ifelse(has_pua_box_drawing, 3L, 2L) - } else { # "light" - cm$char[ygs, xo] <- "\u2500" # horizontal lines - cm$char[yo, xgs] <- "\u2502" # vertical lines - cm$char[ygs, xgs] <- "\u253c" # crosses - hv <- 1L - } - - # intersection gridlines and border line - for (xg in xgs) { - cm <- add_box_edge(cm, xg, y+height, c(NA, 1L, hv, 1L)) # top - cm <- add_box_edge(cm, xg, y-height, c(hv, 1L, NA, 1L)) # bottom - } - for (yg in ygs) { - cm <- add_box_edge(cm, x+width, yg, c(1L, NA, 1L, hv)) # right - cm <- add_box_edge(cm, x-width, yg, c(1L, hv, 1L, NA)) # left - } - cm + xgs <- x + seq(cell - width, width - cell, 2 * cell) + ygs <- y + seq(cell - height, height - cell, 2 * cell) + # cm$char[ygs, xgs] <- "\u25ce" + cm$char[ygs, xgs] <- "\u25cc" + cm +} + +add_gridlines <- function( + cm, + x, + y, + width = 2, + height = 2, + cell = 1, + has_pua_box_drawing = FALSE, + heavy = TRUE +) { + # gridlines + xgs <- x + seq(2 * cell - width, width - 2 * cell, 2 * cell) + ygs <- y + seq(2 * cell - height, height - 2 * cell, 2 * cell) + xo <- x + seq(1 - width, width - 1) + yo <- y + seq(1 - height, height - 1) + + if (heavy) { + cm$char[ygs, xo] <- "\u2501" # horizontal lines + cm$char[yo, xgs] <- "\u2503" # vertical lines + cm$char[ygs, xgs] <- "\u254b" # crosses + hv <- ifelse(has_pua_box_drawing, 3L, 2L) + } else { + # "light" + cm$char[ygs, xo] <- "\u2500" # horizontal lines + cm$char[yo, xgs] <- "\u2502" # vertical lines + cm$char[ygs, xgs] <- "\u253c" # crosses + hv <- 1L + } + + # intersection gridlines and border line + for (xg in xgs) { + cm <- add_box_edge(cm, xg, y + height, c(NA, 1L, hv, 1L)) # top + cm <- add_box_edge(cm, xg, y - height, c(hv, 1L, NA, 1L)) # bottom + } + for (yg in ygs) { + cm <- add_box_edge(cm, x + width, yg, c(1L, NA, 1L, hv)) # right + cm <- add_box_edge(cm, x - width, yg, c(1L, hv, 1L, NA)) # left + } + cm } add_border <- function(cm, x, y, width = 2, height = 2, space = " ") { - for (i in seq(1 - height, height - 1)) { - for (j in seq(1 - width, width - 1)) { - cm$char[y + i, x + j] <- space - } - } - for (i in seq(1 - width, width - 1)) { - cm <- add_box_edge(cm, x+i, y+height, c(NA, 1, 0, 1)) # top side - cm <- add_box_edge(cm, x+i, y-height, c(0, 1, NA, 1)) # bottom side - } - for (j in seq(1 - height, height - 1)) { - cm <- add_box_edge(cm, x+width, y+j, c(1, NA, 1, 0)) # right side - cm <- add_box_edge(cm, x-width, y+j, c(1, 0, 1, NA)) # left side - } - cm <- add_box_edge(cm, x-width, y+height, c(NA, 1, 1, NA)) # ul corner - cm <- add_box_edge(cm, x+width, y+height, c(NA, NA, 1, 1)) # ur corner - cm <- add_box_edge(cm, x-width, y-height, c(1, 1, NA, NA)) # ll corner - cm <- add_box_edge(cm, x+width, y-height, c(1, NA, NA, 1)) # lr corner - cm + for (i in seq(1 - height, height - 1)) { + for (j in seq(1 - width, width - 1)) { + cm$char[y + i, x + j] <- space + } + } + for (i in seq(1 - width, width - 1)) { + cm <- add_box_edge(cm, x + i, y + height, c(NA, 1, 0, 1)) # top side + cm <- add_box_edge(cm, x + i, y - height, c(0, 1, NA, 1)) # bottom side + } + for (j in seq(1 - height, height - 1)) { + cm <- add_box_edge(cm, x + width, y + j, c(1, NA, 1, 0)) # right side + cm <- add_box_edge(cm, x - width, y + j, c(1, 0, 1, NA)) # left side + } + cm <- add_box_edge(cm, x - width, y + height, c(NA, 1, 1, NA)) # ul corner + cm <- add_box_edge(cm, x + width, y + height, c(NA, NA, 1, 1)) # ur corner + cm <- add_box_edge(cm, x - width, y - height, c(1, 1, NA, NA)) # ll corner + cm <- add_box_edge(cm, x + width, y - height, c(1, NA, NA, 1)) # lr corner + cm } add_box_edge <- function(cm, x, y, box_info) { - # [top, right, bottom, left] 0-none 1-light 2-heavy 3-matted-heavy - bi <- char2bi[[cm$char[y, x]]] - if (is.null(bi)) bi <- c(0, 0, 0, 0) - ind <- which(!is.na(box_info)) - for (ii in ind) { - bi[ii] <- box_info[ii] - } - cm$char[y, x] <- box2char[[paste(bi, collapse = "")]] - cm + # [top, right, bottom, left] 0-none 1-light 2-heavy 3-matted-heavy + bi <- char2bi[[cm$char[y, x]]] + if (is.null(bi)) { + bi <- c(0, 0, 0, 0) + } + ind <- which(!is.na(box_info)) + for (ii in ind) { + bi[ii] <- box_info[ii] + } + cm$char[y, x] <- box2char[[paste(bi, collapse = "")]] + cm } get_style_rotate <- function(style = "unicode") { - rl <- list(r45 = r45, r90 = r90, r135 = r135, - r180 = r180, r225 = r225, r270 = r270, r315 = r315) - - if (style == "gamebitmono") { - r90[["\u283f"]] <- "\u3000\u20db\u20e8" - r270[["\u283f"]] <- "\u3000\u20db\u20e8" - } - - function(char, angle, reorient = "none") { - if (angle == 0 || reorient == "symbols") { - rchar <- char - } else if (angle == 45) { - rchar <- rl$r45[[char]] - } else if (angle == 90) { - rchar <- rl$r90[[char]] - } else if (angle == 135) { - rchar <- rl$r135[[char]] - } else if (angle == 180) { - rchar <- rl$r180[[char]] - } else if (angle == 225) { - rchar <- rl$r225[[char]] - } else if (angle == 270) { - rchar <- rl$r270[[char]] - } else if (angle == 315) { - rchar <- rl$r315[[char]] - } else { - rchar <- NULL - } - if (is.null(rchar)) { - warning(paste("Can't rotate", char, angle, "degrees")) - char - } else { - rchar - } - } + rl <- list( + r45 = r45, + r90 = r90, + r135 = r135, + r180 = r180, + r225 = r225, + r270 = r270, + r315 = r315 + ) + + if (style == "gamebitmono") { + r90[["\u283f"]] <- "\u3000\u20db\u20e8" + r270[["\u283f"]] <- "\u3000\u20db\u20e8" + } + + function(char, angle, reorient = "none") { + if (angle == 0 || reorient == "symbols") { + rchar <- char + } else if (angle == 45) { + rchar <- rl$r45[[char]] + } else if (angle == 90) { + rchar <- rl$r90[[char]] + } else if (angle == 135) { + rchar <- rl$r135[[char]] + } else if (angle == 180) { + rchar <- rl$r180[[char]] + } else if (angle == 225) { + rchar <- rl$r225[[char]] + } else if (angle == 270) { + rchar <- rl$r270[[char]] + } else if (angle == 315) { + rchar <- rl$r315[[char]] + } else { + rchar <- NULL + } + if (is.null(rchar)) { + warning(paste("Can't rotate", char, angle, "degrees")) + char + } else { + rchar + } + } } diff --git a/R/zzz.R b/R/zzz.R index aab91d2..018188f 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -3,12 +3,17 @@ #' @importFrom utils hasName NULL -assert_suggested <- function (package) { - calling_fn <- deparse(sys.calls()[[sys.nframe() - 1]]) - if (!requireNamespace(package, quietly = TRUE)) { - msg <- c(sprintf("You need to install the suggested package %s to use %s.", - sQuote(package), sQuote(calling_fn)), i = sprintf("Use %s.", - sQuote(sprintf("install.packages(\"%s\")", package)))) - abort(msg, class = "piecepackr_suggested_package") - } +assert_suggested <- function(package) { + calling_fn <- deparse(sys.calls()[[sys.nframe() - 1]]) + if (!requireNamespace(package, quietly = TRUE)) { + msg <- c( + sprintf( + "You need to install the suggested package %s to use %s.", + sQuote(package), + sQuote(calling_fn) + ), + i = sprintf("Use %s.", sQuote(sprintf("install.packages(\"%s\")", package))) + ) + abort(msg, class = "piecepackr_suggested_package") + } } diff --git a/data-raw/sysdata.R b/data-raw/sysdata.R index 286708c..881141e 100644 --- a/data-raw/sysdata.R +++ b/data-raw/sysdata.R @@ -10,15 +10,15 @@ r315 <- list() ### Spaces, Letters, Numbers ## Null - r45[[" "]] <- " " - r90[[" "]] <- " " -r135[[" "]] <- " " -r180[[" "]] <- " " -r225[[" "]] <- " " -r270[[" "]] <- " " -r315[[" "]] <- " " - r45[[" "]] <- " " # Double space - r90[[" "]] <- " " +r45[[" "]] <- " " +r90[[" "]] <- " " +r135[[" "]] <- " " +r180[[" "]] <- " " +r225[[" "]] <- " " +r270[[" "]] <- " " +r315[[" "]] <- " " +r45[[" "]] <- " " # Double space +r90[[" "]] <- " " r135[[" "]] <- " " r180[[" "]] <- " " r225[[" "]] <- " " @@ -40,10 +40,10 @@ r180[["n"]] <- "u" r270[["n"]] <- "\u1d59" r180[["N"]] <- "N" r180[["0"]] <- "0" - r90[["\U000FCB50"]] <- "\U000FCB74" # Game Bit PUA +r90[["\U000FCB50"]] <- "\U000FCB74" # Game Bit PUA r180[["\U000FCB50"]] <- "\U000FCB68" r270[["\U000FCB50"]] <- "\U000FCB5C" - r90[["\U000FCC50"]] <- "\U000FCC74" # Game Bit PUA +r90[["\U000FCC50"]] <- "\U000FCC74" # Game Bit PUA r180[["\U000FCC50"]] <- "\U000FCC68" r270[["\U000FCC50"]] <- "\U000FCC5C" @@ -65,28 +65,28 @@ r180[["\u2960"]] <- "\u295d" r270[["\u2960"]] <- "\u295b" r180[["\u0ed1"]] <- "\u0ed2" ## Spirals (Lao Digit One) r180[["\u0ed2"]] <- "\u0ed1" ## Spirals (Lao Digit One) - r90[["\U000FCB51"]] <- "\U000FCB75" # Game Bit PUA +r90[["\U000FCB51"]] <- "\U000FCB75" # Game Bit PUA r180[["\U000FCB51"]] <- "\U000FCB69" r270[["\U000FCB51"]] <- "\U000FCB5D" - r90[["\U000FCC51"]] <- "\U000FCC75" # Game Bit PUA +r90[["\U000FCC51"]] <- "\U000FCC75" # Game Bit PUA r180[["\U000FCC51"]] <- "\U000FCC69" r270[["\U000FCC51"]] <- "\U000FCC5D" r180[["2"]] <- "\u218a" - r90[["\U000FCB52"]] <- "\U000FCB76" # Game Bit PUA +r90[["\U000FCB52"]] <- "\U000FCB76" # Game Bit PUA r180[["\U000FCB52"]] <- "\U000FCB6A" r270[["\U000FCB52"]] <- "\U000FCB5E" - r90[["\U000FCC52"]] <- "\U000FCC76" # Game Bit PUA +r90[["\U000FCC52"]] <- "\U000FCC76" # Game Bit PUA r180[["\U000FCC52"]] <- "\U000FCC6A" r270[["\U000FCC52"]] <- "\U000FCC5E" r90[["3"]] <- "m" r180[["3"]] <- "\u218b" r270[["3"]] <- "\u03c9" - r90[["\U000FCB53"]] <- "\U000FCB77" # Game Bit PUA +r90[["\U000FCB53"]] <- "\U000FCB77" # Game Bit PUA r180[["\U000FCB53"]] <- "\U000FCB6B" r270[["\U000FCB53"]] <- "\U000FCB5F" - r90[["\U000FCC53"]] <- "\U000FCC77" # Game Bit PUA +r90[["\U000FCC53"]] <- "\U000FCC77" # Game Bit PUA r180[["\U000FCC53"]] <- "\U000FCC6B" r270[["\U000FCC53"]] <- "\U000FCC5F" @@ -96,62 +96,62 @@ r180[["4"]] <- "\u152d" # r180[["4"]] <- "\u07c8" # r180[["5"]] <- "\u03da" # nolint end - r90[["\U000FCB54"]] <- "\U000FCB78" # Game Bit PUA +r90[["\U000FCB54"]] <- "\U000FCB78" # Game Bit PUA r180[["\U000FCB54"]] <- "\U000FCB6C" r270[["\U000FCB54"]] <- "\U000FCB60" - r90[["\U000FCC54"]] <- "\U000FCC78" # Game Bit PUA +r90[["\U000FCC54"]] <- "\U000FCC78" # Game Bit PUA r180[["\U000FCC54"]] <- "\U000FCC6C" r270[["\U000FCC54"]] <- "\U000FCC60" r180[["5"]] <- "\u2185\u0332" - r90[["\U000FCB55"]] <- "\U000FCB79" # Game Bit PUA +r90[["\U000FCB55"]] <- "\U000FCB79" # Game Bit PUA r180[["\U000FCB55"]] <- "\U000FCB6D" r270[["\U000FCB55"]] <- "\U000FCB61" - r90[["\U000FCC55"]] <- "\U000FCC79" # Game Bit PUA +r90[["\U000FCC55"]] <- "\U000FCC79" # Game Bit PUA r180[["\U000FCC55"]] <- "\U000FCC6D" r270[["\U000FCC55"]] <- "\U000FCC61" r180[["6"]] <- "9" - r90[["\U000FCB56"]] <- "\U000FCB7A" # Game Bit PUA +r90[["\U000FCB56"]] <- "\U000FCB7A" # Game Bit PUA r180[["\U000FCB56"]] <- "\U000FCB6E" r270[["\U000FCB56"]] <- "\U000FCB62" - r90[["\U000FCC56"]] <- "\U000FCC7A" # Game Bit PUA +r90[["\U000FCC56"]] <- "\U000FCC7A" # Game Bit PUA r180[["\U000FCC56"]] <- "\U000FCC6E" r270[["\U000FCC56"]] <- "\U000FCC62" - r90[["\U000FCB57"]] <- "\U000FCB7B" # Game Bit PUA +r90[["\U000FCB57"]] <- "\U000FCB7B" # Game Bit PUA r180[["\U000FCB57"]] <- "\U000FCB6F" r270[["\U000FCB57"]] <- "\U000FCB63" - r90[["\U000FCC57"]] <- "\U000FCC7B" # Game Bit PUA +r90[["\U000FCC57"]] <- "\U000FCC7B" # Game Bit PUA r180[["\U000FCC57"]] <- "\U000FCC6F" r270[["\U000FCC57"]] <- "\U000FCC63" - r90[["\U000FCB58"]] <- "\U000FCB7C" # Game Bit PUA +r90[["\U000FCB58"]] <- "\U000FCB7C" # Game Bit PUA r180[["\U000FCB58"]] <- "\U000FCB70" r270[["\U000FCB58"]] <- "\U000FCB64" - r90[["\U000FCC58"]] <- "\U000FCC7C" # Game Bit PUA +r90[["\U000FCC58"]] <- "\U000FCC7C" # Game Bit PUA r180[["\U000FCC58"]] <- "\U000FCC70" r270[["\U000FCC58"]] <- "\U000FCC64" r180[["9"]] <- "6" - r90[["\U000FCB59"]] <- "\U000FCB7D" # Game Bit PUA +r90[["\U000FCB59"]] <- "\U000FCB7D" # Game Bit PUA r180[["\U000FCB59"]] <- "\U000FCB71" r270[["\U000FCB59"]] <- "\U000FCB65" - r90[["\U000FCC59"]] <- "\U000FCC7D" # Game Bit PUA +r90[["\U000FCC59"]] <- "\U000FCC7D" # Game Bit PUA r180[["\U000FCC59"]] <- "\U000FCC71" r270[["\U000FCC59"]] <- "\U000FCC65" - r90[["\U000FCB5A"]] <- "\U000FCB7E" # Game Bit PUA +r90[["\U000FCB5A"]] <- "\U000FCB7E" # Game Bit PUA r180[["\U000FCB5A"]] <- "\U000FCB72" r270[["\U000FCB5A"]] <- "\U000FCB66" - r90[["\U000FCC5A"]] <- "\U000FCC7E" # Game Bit PUA +r90[["\U000FCC5A"]] <- "\U000FCC7E" # Game Bit PUA r180[["\U000FCC5A"]] <- "\U000FCC72" r270[["\U000FCC5A"]] <- "\U000FCC66" - r90[["\U000FCB5B"]] <- "\U000FCB7F" # Game Bit PUA +r90[["\U000FCB5B"]] <- "\U000FCB7F" # Game Bit PUA r180[["\U000FCB5B"]] <- "\U000FCB73" r270[["\U000FCB5B"]] <- "\U000FCB67" - r90[["\U000FCC5B"]] <- "\U000FCC7F" # Game Bit PUA +r90[["\U000FCC5B"]] <- "\U000FCC7F" # Game Bit PUA r180[["\U000FCC5B"]] <- "\U000FCC73" r270[["\U000FCC5B"]] <- "\U000FCC67" @@ -178,23 +178,23 @@ r270[["\u263c"]] <- "\u263c" r315[["\u2600"]] <- "\u2600" r315[["\u2609"]] <- "\u2609" r315[["\u263c"]] <- "\u263c" - r90[["\U000FCB00"]] <- "\U000FCB0C" # Game Bit PUA (Black) +r90[["\U000FCB00"]] <- "\U000FCB0C" # Game Bit PUA (Black) r180[["\U000FCB00"]] <- "\U000FCB08" r270[["\U000FCB00"]] <- "\U000FCB04" - r90[["\U000FCC00"]] <- "\U000FCC0C" # Game Bit PUA (Black) +r90[["\U000FCC00"]] <- "\U000FCC0C" # Game Bit PUA (Black) r180[["\U000FCC00"]] <- "\U000FCC08" r270[["\U000FCC00"]] <- "\U000FCC04" - r90[["\U000FCE00"]] <- "\U000FCE0C" # Game Bit PUA (Black) +r90[["\U000FCE00"]] <- "\U000FCE0C" # Game Bit PUA (Black) r180[["\U000FCE00"]] <- "\U000FCE08" r270[["\U000FCE00"]] <- "\U000FCE04" - r90[["\U000FCB10"]] <- "\U000FCB1C" # Game Bit PUA (White) +r90[["\U000FCB10"]] <- "\U000FCB1C" # Game Bit PUA (White) r180[["\U000FCB10"]] <- "\U000FCB18" r270[["\U000FCB10"]] <- "\U000FCB14" - r90[["\U000FCC10"]] <- "\U000FCC1C" # Game Bit PUA (White) +r90[["\U000FCC10"]] <- "\U000FCC1C" # Game Bit PUA (White) r180[["\U000FCC10"]] <- "\U000FCC18" r270[["\U000FCC10"]] <- "\U000FCC14" - r90[["\U000FCE10"]] <- "\U000FCE1C" # Game Bit PUA (White) +r90[["\U000FCE10"]] <- "\U000FCE1C" # Game Bit PUA (White) r180[["\U000FCE10"]] <- "\U000FCE18" r270[["\U000FCE10"]] <- "\U000FCE14" @@ -207,23 +207,23 @@ r180[["\u25d8"]] <- "\u25d8" r270[["\u25d8"]] <- "\u25d8" r180[["\u263e"]] <- "\u263d" r180[["\u263d"]] <- "\u263e" - r90[["\U000FCB01"]] <- "\U000FCB0D" # Game Bit PUA (Black) +r90[["\U000FCB01"]] <- "\U000FCB0D" # Game Bit PUA (Black) r180[["\U000FCB01"]] <- "\U000FCB09" r270[["\U000FCB01"]] <- "\U000FCB05" - r90[["\U000FCC01"]] <- "\U000FCC0D" # Game Bit PUA (Black) +r90[["\U000FCC01"]] <- "\U000FCC0D" # Game Bit PUA (Black) r180[["\U000FCC01"]] <- "\U000FCC09" r270[["\U000FCC01"]] <- "\U000FCC05" - r90[["\U000FCE01"]] <- "\U000FCE0D" # Game Bit PUA (Black) +r90[["\U000FCE01"]] <- "\U000FCE0D" # Game Bit PUA (Black) r180[["\U000FCE01"]] <- "\U000FCE09" r270[["\U000FCE01"]] <- "\U000FCE05" - r90[["\U000FCB11"]] <- "\U000FCB1D" # Game Bit PUA (White) +r90[["\U000FCB11"]] <- "\U000FCB1D" # Game Bit PUA (White) r180[["\U000FCB11"]] <- "\U000FCB19" r270[["\U000FCB11"]] <- "\U000FCB15" - r90[["\U000FCC11"]] <- "\U000FCC1D" # Game Bit PUA (White) +r90[["\U000FCC11"]] <- "\U000FCC1D" # Game Bit PUA (White) r180[["\U000FCC11"]] <- "\U000FCC19" r270[["\U000FCC11"]] <- "\U000FCC15" - r90[["\U000FCE11"]] <- "\U000FCE1D" # Game Bit PUA (White) +r90[["\U000FCE11"]] <- "\U000FCE1D" # Game Bit PUA (White) r180[["\U000FCE11"]] <- "\U000FCE19" r270[["\U000FCE11"]] <- "\U000FCE15" @@ -231,23 +231,23 @@ r270[["\U000FCE11"]] <- "\U000FCE15" r180[["\u2641"]] <- "\u2640" # Earth r180[["\u2640"]] <- "\u2641" # Venus r180[["\u0238"]] <- "\u0239" # Small Letter db Digraph - r90[["\U000FCB02"]] <- "\U000FCB0E" # Game Bit PUA (Black) +r90[["\U000FCB02"]] <- "\U000FCB0E" # Game Bit PUA (Black) r180[["\U000FCB02"]] <- "\U000FCB0A" r270[["\U000FCB02"]] <- "\U000FCB06" - r90[["\U000FCC02"]] <- "\U000FCC0E" # Game Bit PUA (Black) +r90[["\U000FCC02"]] <- "\U000FCC0E" # Game Bit PUA (Black) r180[["\U000FCC02"]] <- "\U000FCC0A" r270[["\U000FCC02"]] <- "\U000FCC06" - r90[["\U000FCE02"]] <- "\U000FCE0E" # Game Bit PUA (Black) +r90[["\U000FCE02"]] <- "\U000FCE0E" # Game Bit PUA (Black) r180[["\U000FCE02"]] <- "\U000FCE0A" r270[["\U000FCE02"]] <- "\U000FCE06" - r90[["\U000FCB12"]] <- "\U000FCB1E" # Game Bit PUA (White) +r90[["\U000FCB12"]] <- "\U000FCB1E" # Game Bit PUA (White) r180[["\U000FCB12"]] <- "\U000FCB1A" r270[["\U000FCB12"]] <- "\U000FCB16" - r90[["\U000FCC12"]] <- "\U000FCC1E" # Game Bit PUA (White) +r90[["\U000FCC12"]] <- "\U000FCC1E" # Game Bit PUA (White) r180[["\U000FCC12"]] <- "\U000FCC1A" r270[["\U000FCC12"]] <- "\U000FCC16" - r90[["\U000FCE12"]] <- "\U000FCE1E" # Game Bit PUA (White) +r90[["\U000FCE12"]] <- "\U000FCE1E" # Game Bit PUA (White) r180[["\U000FCE12"]] <- "\U000FCE1A" r270[["\U000FCE12"]] <- "\U000FCE16" @@ -255,23 +255,23 @@ r270[["\U000FCE12"]] <- "\U000FCE16" r180[["\u2020"]] <- "\u2e38" ## Dagger r180[["\u2e38"]] <- "\u2020" ## Turned Dagger r180[["\u2021"]] <- "\u2021" ## Double Dagger - r90[["\U000FCB03"]] <- "\U000FCB0F" # Game Bit PUA (Black) +r90[["\U000FCB03"]] <- "\U000FCB0F" # Game Bit PUA (Black) r180[["\U000FCB03"]] <- "\U000FCB0B" r270[["\U000FCB03"]] <- "\U000FCB07" - r90[["\U000FCC03"]] <- "\U000FCC0F" # Game Bit PUA (Black) +r90[["\U000FCC03"]] <- "\U000FCC0F" # Game Bit PUA (Black) r180[["\U000FCC03"]] <- "\U000FCC0B" r270[["\U000FCC03"]] <- "\U000FCC07" - r90[["\U000FCE03"]] <- "\U000FCE0F" # Game Bit PUA (Black) +r90[["\U000FCE03"]] <- "\U000FCE0F" # Game Bit PUA (Black) r180[["\U000FCE03"]] <- "\U000FCE0B" r270[["\U000FCE03"]] <- "\U000FCE07" - r90[["\U000FCB13"]] <- "\U000FCB1F" # Game Bit PUA (White) +r90[["\U000FCB13"]] <- "\U000FCB1F" # Game Bit PUA (White) r180[["\U000FCB13"]] <- "\U000FCB1B" r270[["\U000FCB13"]] <- "\U000FCB17" - r90[["\U000FCC13"]] <- "\U000FCC1F" # Game Bit PUA (White) +r90[["\U000FCC13"]] <- "\U000FCC1F" # Game Bit PUA (White) r180[["\U000FCC13"]] <- "\U000FCC1B" r270[["\U000FCC13"]] <- "\U000FCC17" - r90[["\U000FCE13"]] <- "\U000FCE1F" # Game Bit PUA (White) +r90[["\U000FCE13"]] <- "\U000FCE1F" # Game Bit PUA (White) r180[["\U000FCE13"]] <- "\U000FCE1B" r270[["\U000FCE13"]] <- "\U000FCE17" @@ -285,71 +285,71 @@ r180[["\u260b"]] <- "\u260a" # Ascending/Descending nodes r90[["\u2665"]] <- "\u2765" # Rotated Black Heart r90[["\u2764"]] <- "\u2765" r180[["\u2665"]] <- "\u03c9\u0302" - r90[["\U000FCB20"]] <- "\U000FCB2C" # Game Bit PUA (Black) +r90[["\U000FCB20"]] <- "\U000FCB2C" # Game Bit PUA (Black) r180[["\U000FCB20"]] <- "\U000FCB28" r270[["\U000FCB20"]] <- "\U000FCB24" - r90[["\U000FCC20"]] <- "\U000FCC2C" # Game Bit PUA (Black) +r90[["\U000FCC20"]] <- "\U000FCC2C" # Game Bit PUA (Black) r180[["\U000FCC20"]] <- "\U000FCC28" r270[["\U000FCC20"]] <- "\U000FCC24" - r90[["\U000FCE20"]] <- "\U000FCE2C" # Game Bit PUA (Black) +r90[["\U000FCE20"]] <- "\U000FCE2C" # Game Bit PUA (Black) r180[["\U000FCE20"]] <- "\U000FCE28" r270[["\U000FCE20"]] <- "\U000FCE24" # White Heart r90[["\u2661"]] <- "\u2765" r180[["\u2661"]] <- "\u03c9\u0302" - r90[["\U000FCB30"]] <- "\U000FCB3C" # Game Bit PUA (White) +r90[["\U000FCB30"]] <- "\U000FCB3C" # Game Bit PUA (White) r180[["\U000FCB30"]] <- "\U000FCB38" r270[["\U000FCB30"]] <- "\U000FCB34" - r90[["\U000FCC30"]] <- "\U000FCC3C" # Game Bit PUA (White) +r90[["\U000FCC30"]] <- "\U000FCC3C" # Game Bit PUA (White) r180[["\U000FCC30"]] <- "\U000FCC38" r270[["\U000FCC30"]] <- "\U000FCC34" - r90[["\U000FCE30"]] <- "\U000FCE3C" # Game Bit PUA (White) +r90[["\U000FCE30"]] <- "\U000FCE3C" # Game Bit PUA (White) r180[["\U000FCE30"]] <- "\U000FCE38" r270[["\U000FCE30"]] <- "\U000FCE34" ## Spades # Black r180[["\u2660"]] <- "\u2764\u030d" - r90[["\U000FCB21"]] <- "\U000FCB2D" # Game Bit PUA (Black) +r90[["\U000FCB21"]] <- "\U000FCB2D" # Game Bit PUA (Black) r180[["\U000FCB21"]] <- "\U000FCB29" r270[["\U000FCB21"]] <- "\U000FCB25" - r90[["\U000FCC21"]] <- "\U000FCC2D" # Game Bit PUA (Black) +r90[["\U000FCC21"]] <- "\U000FCC2D" # Game Bit PUA (Black) r180[["\U000FCC21"]] <- "\U000FCC29" r270[["\U000FCC21"]] <- "\U000FCC25" - r90[["\U000FCE21"]] <- "\U000FCE2D" # Game Bit PUA (Black) +r90[["\U000FCE21"]] <- "\U000FCE2D" # Game Bit PUA (Black) r180[["\U000FCE21"]] <- "\U000FCE29" r270[["\U000FCE21"]] <- "\U000FCE25" # White r180[["\u2664"]] <- "\u2661\u030d" - r90[["\U000FCB31"]] <- "\U000FCB3D" # Game Bit PUA (White) +r90[["\U000FCB31"]] <- "\U000FCB3D" # Game Bit PUA (White) r180[["\U000FCB31"]] <- "\U000FCB39" r270[["\U000FCB31"]] <- "\U000FCB35" - r90[["\U000FCC31"]] <- "\U000FCC3D" # Game Bit PUA (White) +r90[["\U000FCC31"]] <- "\U000FCC3D" # Game Bit PUA (White) r180[["\U000FCC31"]] <- "\U000FCC39" r270[["\U000FCC31"]] <- "\U000FCC35" - r90[["\U000FCE31"]] <- "\U000FCE3D" # Game Bit PUA (White) +r90[["\U000FCE31"]] <- "\U000FCE3D" # Game Bit PUA (White) r180[["\U000FCE31"]] <- "\U000FCE39" r270[["\U000FCE31"]] <- "\U000FCE35" ## Clubs # Black r180[["\u2663"]] <- "\u2235\u0304" - r90[["\U000FCB22"]] <- "\U000FCB2E" # Game Bit PUA (White) +r90[["\U000FCB22"]] <- "\U000FCB2E" # Game Bit PUA (White) r180[["\U000FCB22"]] <- "\U000FCB2A" r270[["\U000FCB22"]] <- "\U000FCB26" - r90[["\U000FCC22"]] <- "\U000FCC2E" # Game Bit PUA (White) +r90[["\U000FCC22"]] <- "\U000FCC2E" # Game Bit PUA (White) r180[["\U000FCC22"]] <- "\U000FCC2A" r270[["\U000FCC22"]] <- "\U000FCC26" - r90[["\U000FCE22"]] <- "\U000FCE2E" # Game Bit PUA (White) +r90[["\U000FCE22"]] <- "\U000FCE2E" # Game Bit PUA (White) r180[["\U000FCE22"]] <- "\U000FCE2A" r270[["\U000FCE22"]] <- "\U000FCE26" # White r180[["\u2667"]] <- "\u2235\u0304" - r90[["\U000FCB32"]] <- "\U000FCB3E" # Game Bit PUA (White) +r90[["\U000FCB32"]] <- "\U000FCB3E" # Game Bit PUA (White) r180[["\U000FCB32"]] <- "\U000FCB3A" r270[["\U000FCB32"]] <- "\U000FCB36" - r90[["\U000FCC32"]] <- "\U000FCC3E" # Game Bit PUA (White) +r90[["\U000FCC32"]] <- "\U000FCC3E" # Game Bit PUA (White) r180[["\U000FCC32"]] <- "\U000FCC3A" r270[["\U000FCC32"]] <- "\U000FCC36" - r90[["\U000FCE32"]] <- "\U000FCE3E" # Game Bit PUA (White) +r90[["\U000FCE32"]] <- "\U000FCE3E" # Game Bit PUA (White) r180[["\U000FCE32"]] <- "\U000FCE3A" r270[["\U000FCE32"]] <- "\U000FCE36" ## Diamonds @@ -357,26 +357,26 @@ r270[["\U000FCE32"]] <- "\U000FCE36" r90[["\u2666"]] <- "\u25c6" r180[["\u2666"]] <- "\u2666" r270[["\u2666"]] <- "\u25c6" - r90[["\U000FCB23"]] <- "\U000FCB2F" # Game Bit PUA (White) +r90[["\U000FCB23"]] <- "\U000FCB2F" # Game Bit PUA (White) r180[["\U000FCB23"]] <- "\U000FCB2B" r270[["\U000FCB23"]] <- "\U000FCB27" - r90[["\U000FCC23"]] <- "\U000FCC2F" # Game Bit PUA (White) +r90[["\U000FCC23"]] <- "\U000FCC2F" # Game Bit PUA (White) r180[["\U000FCC23"]] <- "\U000FCC2B" r270[["\U000FCC23"]] <- "\U000FCC27" - r90[["\U000FCE23"]] <- "\U000FCE2F" # Game Bit PUA (White) +r90[["\U000FCE23"]] <- "\U000FCE2F" # Game Bit PUA (White) r180[["\U000FCE23"]] <- "\U000FCE2B" r270[["\U000FCE23"]] <- "\U000FCE27" # White r90[["\u2662"]] <- "\u25c7" r180[["\u2662"]] <- "\u2662" r270[["\u2662"]] <- "\u25c7" - r90[["\U000FCB33"]] <- "\U000FCB3F" # Game Bit PUA (White) +r90[["\U000FCB33"]] <- "\U000FCB3F" # Game Bit PUA (White) r180[["\U000FCB33"]] <- "\U000FCB3B" r270[["\U000FCB33"]] <- "\U000FCB37" - r90[["\U000FCC33"]] <- "\U000FCC3F" # Game Bit PUA (White) +r90[["\U000FCC33"]] <- "\U000FCC3F" # Game Bit PUA (White) r180[["\U000FCC33"]] <- "\U000FCC3B" r270[["\U000FCC33"]] <- "\U000FCC37" - r90[["\U000FCE33"]] <- "\U000FCE3F" # Game Bit PUA (White) +r90[["\U000FCE33"]] <- "\U000FCE3F" # Game Bit PUA (White) r180[["\U000FCE33"]] <- "\U000FCE3B" r270[["\U000FCE33"]] <- "\U000FCE37" @@ -437,35 +437,35 @@ r315[["\u265e"]] <- "\U1fa07" # n ### Checkers for (glyph in c("\u26c0", "\u26c1", "\u26c2", "\u26c3")) { - r45[[glyph]] <- glyph - r90[[glyph]] <- glyph - r135[[glyph]] <- glyph - r180[[glyph]] <- glyph - r225[[glyph]] <- glyph - r270[[glyph]] <- glyph - r315[[glyph]] <- glyph + r45[[glyph]] <- glyph + r90[[glyph]] <- glyph + r135[[glyph]] <- glyph + r180[[glyph]] <- glyph + r225[[glyph]] <- glyph + r270[[glyph]] <- glyph + r315[[glyph]] <- glyph } # Game Bit PUA Domino Pips - r90[["\U000FCA00"]] <- "\U000FCA13" # Zero - r90[["\U000FCA01"]] <- "\U000FCA14" # One - r90[["\U000FCA02"]] <- "\U000FCA15" # Two - r90[["\U000FCA03"]] <- "\U000FCA16" # Three - r90[["\U000FCA04"]] <- "\U000FCA17" # Four - r90[["\U000FCA05"]] <- "\U000FCA18" # Five - r90[["\U000FCA06"]] <- "\U000FCA19" # Six - r90[["\U000FCA07"]] <- "\U000FCA1A" # Seven - r90[["\U000FCA08"]] <- "\U000FCA1B" # Eight - r90[["\U000FCA09"]] <- "\U000FCA1C" # Nine - r90[["\U000FCA0A"]] <- "\U000FCA1D" # Ten - r90[["\U000FCA0B"]] <- "\U000FCA1E" # Eleven - r90[["\U000FCA0C"]] <- "\U000FCA1F" # Twelve - r90[["\U000FCA0D"]] <- "\U000FCA20" # Thirteen - r90[["\U000FCA0E"]] <- "\U000FCA21" # Fourteen - r90[["\U000FCA0F"]] <- "\U000FCA22" # Fifteen - r90[["\U000FCA10"]] <- "\U000FCA23" # Sixteen - r90[["\U000FCA11"]] <- "\U000FCA24" # Seventeen - r90[["\U000FCA12"]] <- "\U000FCA25" # Eighteen +r90[["\U000FCA00"]] <- "\U000FCA13" # Zero +r90[["\U000FCA01"]] <- "\U000FCA14" # One +r90[["\U000FCA02"]] <- "\U000FCA15" # Two +r90[["\U000FCA03"]] <- "\U000FCA16" # Three +r90[["\U000FCA04"]] <- "\U000FCA17" # Four +r90[["\U000FCA05"]] <- "\U000FCA18" # Five +r90[["\U000FCA06"]] <- "\U000FCA19" # Six +r90[["\U000FCA07"]] <- "\U000FCA1A" # Seven +r90[["\U000FCA08"]] <- "\U000FCA1B" # Eight +r90[["\U000FCA09"]] <- "\U000FCA1C" # Nine +r90[["\U000FCA0A"]] <- "\U000FCA1D" # Ten +r90[["\U000FCA0B"]] <- "\U000FCA1E" # Eleven +r90[["\U000FCA0C"]] <- "\U000FCA1F" # Twelve +r90[["\U000FCA0D"]] <- "\U000FCA20" # Thirteen +r90[["\U000FCA0E"]] <- "\U000FCA21" # Fourteen +r90[["\U000FCA0F"]] <- "\U000FCA22" # Fifteen +r90[["\U000FCA10"]] <- "\U000FCA23" # Sixteen +r90[["\U000FCA11"]] <- "\U000FCA24" # Seventeen +r90[["\U000FCA12"]] <- "\U000FCA25" # Eighteen r180[["\U000FCA00"]] <- "\U000FCA26" # Zero r180[["\U000FCA01"]] <- "\U000FCA27" # One r180[["\U000FCA02"]] <- "\U000FCA28" # Two @@ -741,36 +741,36 @@ r270[["\u25b3"]] <- "\u25b7" r315[["\u25b3"]] <- "\u25f9" # Various Symmetric Circles for (circle in c("\u25cb", "\u25cc", "\u25ce", "\u25cf", "\u20dd")) { - r45[[circle]] <- circle - r90[[circle]] <- circle - r135[[circle]] <- circle - r180[[circle]] <- circle - r225[[circle]] <- circle - r270[[circle]] <- circle - r315[[circle]] <- circle + r45[[circle]] <- circle + r90[[circle]] <- circle + r135[[circle]] <- circle + r180[[circle]] <- circle + r225[[circle]] <- circle + r270[[circle]] <- circle + r315[[circle]] <- circle } # Enclosing Coin - r90[["\U000FCE50"]] <- "\U000FCE5C" # Game Bit PUA +r90[["\U000FCE50"]] <- "\U000FCE5C" # Game Bit PUA r180[["\U000FCE50"]] <- "\U000FCE58" r270[["\U000FCE50"]] <- "\U000FCE54" # Enclosing Pawn - r45[["\u20df"]] <- "\u20de" - r90[["\u20df"]] <- "\u20df" +r45[["\u20df"]] <- "\u20de" +r90[["\u20df"]] <- "\u20df" r135[["\u20df"]] <- "\u20de" r180[["\u20df"]] <- "\u20df" r225[["\u20df"]] <- "\u20de" r270[["\u20df"]] <- "\u20df" r315[["\u20df"]] <- "\u20de" - r90[["\U000FCDE0"]] <- "\U000FCDEC" # Game Bit PUA +r90[["\U000FCDE0"]] <- "\U000FCDEC" # Game Bit PUA r180[["\U000FCDE0"]] <- "\U000FCDE8" r270[["\U000FCDE0"]] <- "\U000FCDE4" # Enclosing Die - r45[["\u20de"]] <- "\u20df" - r90[["\u20de"]] <- "\u20de" +r45[["\u20de"]] <- "\u20df" +r90[["\u20de"]] <- "\u20de" r135[["\u20de"]] <- "\u20df" r180[["\u20de"]] <- "\u20de" r225[["\u20de"]] <- "\u20df" @@ -988,85 +988,131 @@ box2char[["3131"]] <- "\U000fdd99" # nolint end unicode_dice <- c("\u2680", "\u2681", "\u2682", "\u2683", "\u2684", "\u2685") # excludes card back -unicode_cards <- c(intToUtf8(utf8ToInt("\U0001f0a1") + 0:13, multiple = TRUE), # spades - intToUtf8(utf8ToInt("\U0001f0b1") + 0:13, multiple = TRUE), # hearts - intToUtf8(utf8ToInt("\U0001f0c1") + 0:13, multiple = TRUE), # diamonds - intToUtf8(utf8ToInt("\U0001f0d1") + 0:13, multiple = TRUE), # clubs - "\U0001f0bf", "\U0001f0cf", "\U0001f0df", # jokers - intToUtf8(utf8ToInt("\U0001f0e0") + 0:21, multiple = TRUE)) # trumps +unicode_cards <- c( + intToUtf8(utf8ToInt("\U0001f0a1") + 0:13, multiple = TRUE), # spades + intToUtf8(utf8ToInt("\U0001f0b1") + 0:13, multiple = TRUE), # hearts + intToUtf8(utf8ToInt("\U0001f0c1") + 0:13, multiple = TRUE), # diamonds + intToUtf8(utf8ToInt("\U0001f0d1") + 0:13, multiple = TRUE), # clubs + "\U0001f0bf", + "\U0001f0cf", + "\U0001f0df", # jokers + intToUtf8(utf8ToInt("\U0001f0e0") + 0:21, multiple = TRUE) +) # trumps card2rank <- list() for (r in 1:14) { - card2rank[[unicode_cards[r]]] <- r - card2rank[[unicode_cards[r+14]]] <- r - card2rank[[unicode_cards[r+28]]] <- r - card2rank[[unicode_cards[r+42]]] <- r + card2rank[[unicode_cards[r]]] <- r + card2rank[[unicode_cards[r + 14]]] <- r + card2rank[[unicode_cards[r + 28]]] <- r + card2rank[[unicode_cards[r + 42]]] <- r } card2rank[[unicode_cards[57]]] <- 15 card2rank[[unicode_cards[58]]] <- 15 card2rank[[unicode_cards[59]]] <- 15 card2rank[[unicode_cards[60]]] <- 22 for (r in 1:21) { - card2rank[[unicode_cards[r+60]]] <- r + card2rank[[unicode_cards[r + 60]]] <- r } card2suit <- list() for (r in 1:14) { - card2suit[[unicode_cards[r]]] <- 2 - card2suit[[unicode_cards[r+14]]] <- 1 - card2suit[[unicode_cards[r+28]]] <- 4 - card2suit[[unicode_cards[r+42]]] <- 3 + card2suit[[unicode_cards[r]]] <- 2 + card2suit[[unicode_cards[r + 14]]] <- 1 + card2suit[[unicode_cards[r + 28]]] <- 4 + card2suit[[unicode_cards[r + 42]]] <- 3 } card2suit[[unicode_cards[57]]] <- 4 card2suit[[unicode_cards[58]]] <- 2 card2suit[[unicode_cards[59]]] <- 1 card2suit[[unicode_cards[60]]] <- 5 for (r in 1:21) { - card2suit[[unicode_cards[r+60]]] <- 5 + card2suit[[unicode_cards[r + 60]]] <- 5 } unicode_dominoes <- intToUtf8(utf8ToInt("\U0001f030") + 0:99, multiple = TRUE) -ranks <- c(NA_integer_, rep(0L, 7), # 0H - 0L, rep(1L, 6), # 1H - 0:1, rep(2L, 5), # 2H - 0:2, rep(3L, 4), # 3H - 0:3, rep(4L, 3), # 4H - 0:4, rep(5L, 2), # 5H - 0:5, 6L) # 6H +ranks <- c( + NA_integer_, + rep(0L, 7), # 0H + 0L, + rep(1L, 6), # 1H + 0:1, + rep(2L, 5), # 2H + 0:2, + rep(3L, 4), # 3H + 0:3, + rep(4L, 3), # 4H + 0:4, + rep(5L, 2), # 5H + 0:5, + 6L +) # 6H ranks <- c(ranks, ranks) -suits <- c(NA_integer_, 0:6, # 0H - rep(1L, 2), 2:6, # 1H - rep(2L, 3), 3:6, - rep(3L, 4), 4:6, - rep(4L, 5), 5:6, - rep(5L, 6), 6L, - rep(6L, 7)) +suits <- c( + NA_integer_, + 0:6, # 0H + rep(1L, 2), + 2:6, # 1H + rep(2L, 3), + 3:6, + rep(3L, 4), + 4:6, + rep(4L, 5), + 5:6, + rep(5L, 6), + 6L, + rep(6L, 7) +) suits <- c(suits, suits) -angles <- c(90, rep(90, 7), # 0H - rep(270, 1), rep(90, 6), # 1H - rep(270, 2), rep(90, 5), # 2H - rep(270, 3), rep(90, 4), # 3H - rep(270, 4), rep(90, 3), # 4H - rep(270, 5), rep(90, 2), # 5H - rep(270, 6), rep(90, 1)) # 6H +angles <- c( + 90, + rep(90, 7), # 0H + rep(270, 1), + rep(90, 6), # 1H + rep(270, 2), + rep(90, 5), # 2H + rep(270, 3), + rep(90, 4), # 3H + rep(270, 4), + rep(90, 3), # 4H + rep(270, 5), + rep(90, 2), # 5H + rep(270, 6), + rep(90, 1) +) # 6H angles <- c(angles, angles - 90) tile2rank <- list() tile2suit <- list() tile2angle <- list() for (i in seq_along(unicode_dominoes)) { - d <- unicode_dominoes[i] - tile2rank[[d]] <- ranks[i] - tile2suit[[d]] <- suits[i] - tile2angle[[d]] <- angles[i] + d <- unicode_dominoes[i] + tile2rank[[d]] <- ranks[i] + tile2suit[[d]] <- suits[i] + tile2angle[[d]] <- angles[i] } # chess unicode_chess_black <- c("\u265f", "\u265e", "\u265d", "\u265c", "\u265b", "\u265a") unicode_chess_white <- c("\u2659", "\u2658", "\u2657", "\u2656", "\u2655", "\u2654") -save(r45, r90, r135, r180, r225, r270, r315, - die_subs, top_subs, - box2char, char2bi, - unicode_dice, - unicode_cards, card2rank, card2suit, - unicode_dominoes, tile2rank, tile2suit, tile2angle, - unicode_chess_black, - unicode_chess_white, - file = "R/sysdata.rda", version = 2) +save( + r45, + r90, + r135, + r180, + r225, + r270, + r315, + die_subs, + top_subs, + box2char, + char2bi, + unicode_dice, + unicode_cards, + card2rank, + card2suit, + unicode_dominoes, + tile2rank, + tile2suit, + tile2angle, + unicode_chess_black, + unicode_chess_white, + file = "R/sysdata.rda", + version = 2 +) diff --git a/tests/testthat/test_cat_piece.R b/tests/testthat/test_cat_piece.R index 5ed9413..c8b65ec 100644 --- a/tests/testthat/test_cat_piece.R +++ b/tests/testthat/test_cat_piece.R @@ -1,247 +1,404 @@ cat_piece <- function(df, ...) ppcli::cat_piece(df, ..., color = FALSE) test_that("text diagrams", { - skip_if_not_installed("dplyr") - skip_if_not_installed("tibble") - skip_if_not_installed("withr") - library("tibble") - - style <- get_style("unicode") - expect_warning(style$rotate("$", 90)) - expect_warning(style$rotate("&", 180)) - expect_warning(style$rotate("&", 270)) - expect_warning(style$rotate("&", 45)) - expect_warning(style$rotate("&", 35)) - f <- tempfile() - expect_equal(cat_piece(tibble(), file = f), character()) - unlink(f) - expect_warning(capture.output(cat_piece(tibble(piece_side = "saucer_face", x=2, y=2)))) - expect_error(cat_piece(tibble(piece_side = "pyramid_top", x=2, y=2, rank=7, cfg="icehouse_pieces"))) - expect_error(suppressWarnings(cat_piece(tibble(piece_side = "tile_face", x=2, y=2, angle=45)))) - expect_error(cat_piece(tibble(piece_side = "tile_back", x=2, y=2, angle=45))) - - expect_error(suppressWarnings(cat_piece(tibble(piece_side = "tile_face", x=2, y=2, angle = 45)))) - - skip_on_os("windows") - - # checkers - expect_snapshot({ - dft <- tibble(piece_side = "board_back", x=seq(1.5, 5.5, 2), y=1.5, rank=2, - cfg="checkers1") - dfbb <- tibble(piece_side = "bit_back", x=1:6, y=1, suit=1:6, cfg="checkers1") - dfbf <- tibble(piece_side = "bit_face", x=1:6, y=2, suit=1:6, cfg="checkers1") - dfd <- tibble(piece_side = "die_face", x=1:6, y=3, suit=1:6, rank=1:6, - cfg="dice", angle = c(45, rep(0, 5))) - df <- dplyr::bind_rows(dft, dfbb, dfbf, dfd) - cat_piece(df) - - df <- dplyr::mutate(df, cfg = gsub("checkers1", "checkers2", cfg), - x = 2 * x, y = 2 * y) - cat_piece(df, annotate = TRUE, annotation_scale = 2, reorient = "all") - }) - - # fudge dice - expect_snapshot({ - df <- tibble(piece_side = "die_face", x=1:6, y=1, rank=1:6, suit=1:6, cfg="dice_fudge") - cat_piece(df) - - df$angle <- 90 - cat_piece(df) - }) - - # icehouse - expect_snapshot({ - dfb <- tibble(piece_side = "board_face", x=c(2.5,6.5), y=2, rank=4, cfg="checkers1") - dfpt <- tibble(piece_side = "pyramid_top", x=1:8, y=4, - rank=rep(1:3, length.out=8), suit=c(1:6, 1:2), - angle=seq(0, by=45, length.out=8), cfg="icehouse_pieces") - dfpf <- tibble(piece_side = rep(c("pyramid_face", "pyramid_left", "pyramid_right", "pyramid_back"), 6), - x=rep(1:8, 3), y=rep(1:3, each=8), - rank=rep(1:3, each=8), suit=rep(1:6, 4), - angle=rep(seq(0, by=45, length.out=8), 3), - cfg="icehouse_pieces") - df <- dplyr::bind_rows(dfb, dfpt, dfpf) - cat_piece(df) - }) - - expect_equal(get_dots(4), "\u0324\u0308") - expect_equal(get_dots(5), "\u20e8\u0308") - expect_equal(get_dots(6), "\u20e8\u20db") - - # stackpack - expect_snapshot({ - dfpt <- tibble(piece_side = "tile_back", x = c(1.5, 3.5, 1.5, 3.5), - y = c(1.5, 1.5, 3.5, 3.5)) - dfbt <- tibble(piece_side = rep(c("tile_face", "tile_back"), 2), - x = 1:4, y = 1, suit = 1:4, rank = 1:4, cfg = "subpack") - dfc <- tibble(piece_side = rep(c("coin_face", "coin_back"), 2), - x = 1:4, y = 2, suit = 1:4, rank = 1:4, cfg = "subpack") - dfd <- tibble(piece_side = "die_face", - x = 1:4, y = 3, suit = 1:4, rank = 1:4, cfg = "subpack") - dfp <- tibble(piece_side = rep(c("pawn_face", "pawn_back"), 2), - x = 1:4, y = 4, suit = 1:4, rank = 1:4, cfg = "subpack") - df <- dplyr::bind_rows(dfpt, dfbt, dfc, dfd, dfp) - cat_piece(df) - }) - - # misc - expect_snapshot({ - dft <- tibble(piece_side = "tile_face", x=c(1.5, 3.5), y=1.5, - suit = 1, rank = 4, angle = c(90, 270)) - dfpb <- tibble(piece_side = "pawn_back", x=1:2, y=1, - suit=2:1, angle = c(0, 45)) - dfpf <- tibble(piece_side = "pawn_face", x=1, y=2, - suit=1, angle = 45) - dfbf <- tibble(piece_side = "bit_back", x=3, y=1, suit=3, cfg="checkers1") - df <- dplyr::bind_rows(dft, dfpb, dfpf, dfbf) - cat_piece(df) - }) - - # dominoes - expect_snapshot({ - dff <- tibble(piece_side = "tile_face", - x = rep(1:6, 2), y = rep(c(1,3), each = 6), - suit = rep(1:6, 2), rank = rep(2:7, 2), - angle = rep(c(0, 180), each = 6), - cfg = rep(paste0("dominoes_", c("black", "blue", "green", "red", "white", "yellow")), 2)) - dfb <- tibble(piece_side = "tile_back", - x = 1:6, y = 5, suit = 1:6, rank = 2:7, angle = rep(c(0, 180), each = 3), - cfg = paste0("dominoes_", c("black", "blue", "green", "red", "white", "yellow"))) - df <- dplyr::bind_rows(dff, dfb) - cat_piece(df) - - dff <- tibble(piece_side = "tile_face", - x = rep(c(1,3), each = 6), y = rep(1:6, 2), - suit = rep(1:6, 2), rank = rep(2:7, 2), - angle = rep(c(90, 270), each = 6), - cfg = rep(paste0("dominoes_", c("black", "blue", "green", "red", "white", "yellow")), 2)) - dfb <- tibble(piece_side = "tile_back", - x = 5, y = 1:6, suit = 1:6, rank = 2:7, angle = rep(c(90, 270), each = 3), - cfg = paste0("dominoes_", c("black", "blue", "green", "red", "white", "yellow"))) - df <- dplyr::bind_rows(dff, dfb) - cat_piece(df) - }) - - # matchsticks - expect_snapshot({ - dft <- tibble(piece_side = "tile_back", - x=rep(seq(1, 9, 2), 7), - y = rep(seq(1, 13, 2), each = 5)) - for (angle in seq(0, 315, 45)) { - dfm <- tibble(piece_side = "matchstick_face", - x = 1:6, y = seq(1, 11, 2), - suit = 1, rank = 1:6, angle = angle) - df <- dplyr::bind_rows(dft, dfm) - cat_piece(df) - } - - dfm <- tibble(piece_side = "matchstick_back", - x = 1:4, y = seq(1, 7, 2), - suit = 1, rank = 5, - angle = c(60, 120, 240, 300)) - df <- dplyr::bind_rows(dft, dfm) - cat_piece(df) - }) - expect_error(cat_piece(tibble(piece_side = "matchstick_face", x=1, y=1, rank=7))) - for (rank in 1:6) { - expect_error(cat_piece(tibble(piece_side = "matchstick_face", x=1, y=1, - rank=rank, angle=30))) - } - - # chess - expect_snapshot({ - dfb <- tibble(piece_side = "board_face", x = 4.5, y = 4.5, - suit = 2, cfg = "chess1") - dfp <- tibble(piece_side = "bit_face", x = 1:6, y = 1, - rank = 1:6, suit = 1:6, - cfg = "chess1") - df <- dplyr::bind_rows(dfb, dfp) - cat_piece(df) - }) - - # go - expect_snapshot({ - dfb <- tibble(piece_side = "board_face", x = 10, y = 10, suit = 2, cfg = "go") - dfs <- tibble(piece_side = "bit_back", x = 1:19, y = 1:19, - suit = 1:19 %% 6 + 1, cfg = "go") - df <- dplyr::bind_rows(dfb, dfs) - cat_piece(df) - }) - - # marbles - expect_snapshot({ - withr::local_seed(42) - dfb <- tibble(piece_side = "board_face", suit = 4L, rank = 4L, - cfg ="marbles", x = 2, y = 2) - dfm <- tibble( - piece_side = "bit_face", - suit = sample.int(6L, 30L, replace = TRUE), - rank = 9L, - cfg = "marbles", - x = c(0.5 + rep(0:3, 4L), rep(rep(1:3, 3L)), 0.5 + rep(1:2, 2L), 2), - y = c(0.5 + rep(0:3, each = 4L), rep(1:3, each = 3L), 0.5 + rep(1:2, each = 2L), 2) - ) - df <- rbind(dfb, dfm) - cat_piece(dfb) - cat_piece(df, xbreaks = 1:7, ybreaks = 1:7, - annotate = TRUE, annotation_scale = 0.5) - }) - - # alquerque - expect_snapshot({ - dfb <- tibble(piece_side = "board_face", x= 3, y = 3, suit = 3, cfg = "alquerque") - dfs <- tibble(piece_side = "bit_back", x = 1:5, y = 1:5, suit = 1:5, cfg = "alquerque") - df <- rbind(dfb, dfs) - cat_piece(dfb) - cat_piece(df) - }) - - # morris - expect_snapshot({ - df2 <- tibble(piece_side = "board_face", x = 2, y = 2, - rank = 2L, suit = 3L, cfg = "morris") - cat_piece(df2) - - df3 <- tibble(piece_side = "board_face", x = 2, y = 2, - rank = 3L, suit = 3L, cfg = "morris") - dfs <- tibble(piece_side = "bit_back", x = rep(1:3, 2), y = rep(1:2, each = 3), - rank = 1L, suit = 1:6, cfg = "morris") - df <- rbind(df3, dfs) - cat_piece(df3) - cat_piece(df) - - df6 <- tibble(piece_side = "board_face", x = 3, y = 3, - rank = 6L, suit = 3L, cfg = "morris") - cat_piece(df6) - - df7 <- tibble(piece_side = "board_face", x = 3, y = 3, - rank = 7L, suit = 3L, cfg = "morris") - cat_piece(df7) - - df9 <- tibble(piece_side = "board_face", x = 4, y = 4, - rank = 9L, suit = 3L, cfg = "morris") - cat_piece(df9) - - df12 <- tibble(piece_side = "board_face", x = 4, y = 4, - rank = 12L, suit = 3L, cfg = "morris") - cat_piece(df12) - }) - - # reversi - expect_snapshot({ - dfx <- tibble(piece_side = "board_face", x = 4.5, y = 4.5, - rank = 8L, suit = 2L, cfg = "reversi") - dff <- tibble(piece_side = "bit_face", x = 1:6, y = 1, - rank = 1L, suit = 1:6, cfg = "reversi") - dfb <- tibble(piece_side = "bit_back", x = 1:6, y = 2, - rank = 1L, suit = 1:6, cfg = "reversi") - df <- rbind(dfx, dff, dfb) - cat_piece(df) - }) - - # numeral dice - expect_snapshot({ - df <- tibble(piece_side = "die_face", x=1:6, y=1, rank=1:6, suit=1:6, cfg="dice_numeral") - cat_piece(df) - }) + skip_if_not_installed("dplyr") + skip_if_not_installed("tibble") + skip_if_not_installed("withr") + library("tibble") + + style <- get_style("unicode") + expect_warning(style$rotate("$", 90)) + expect_warning(style$rotate("&", 180)) + expect_warning(style$rotate("&", 270)) + expect_warning(style$rotate("&", 45)) + expect_warning(style$rotate("&", 35)) + f <- tempfile() + expect_equal(cat_piece(tibble(), file = f), character()) + unlink(f) + expect_warning(capture.output(cat_piece(tibble(piece_side = "saucer_face", x = 2, y = 2)))) + expect_error(cat_piece(tibble( + piece_side = "pyramid_top", + x = 2, + y = 2, + rank = 7, + cfg = "icehouse_pieces" + ))) + expect_error(suppressWarnings(cat_piece(tibble( + piece_side = "tile_face", + x = 2, + y = 2, + angle = 45 + )))) + expect_error(cat_piece(tibble(piece_side = "tile_back", x = 2, y = 2, angle = 45))) + + expect_error(suppressWarnings(cat_piece(tibble( + piece_side = "tile_face", + x = 2, + y = 2, + angle = 45 + )))) + + skip_on_os("windows") + + # checkers + expect_snapshot({ + dft <- tibble( + piece_side = "board_back", + x = seq(1.5, 5.5, 2), + y = 1.5, + rank = 2, + cfg = "checkers1" + ) + dfbb <- tibble(piece_side = "bit_back", x = 1:6, y = 1, suit = 1:6, cfg = "checkers1") + dfbf <- tibble(piece_side = "bit_face", x = 1:6, y = 2, suit = 1:6, cfg = "checkers1") + dfd <- tibble( + piece_side = "die_face", + x = 1:6, + y = 3, + suit = 1:6, + rank = 1:6, + cfg = "dice", + angle = c(45, rep(0, 5)) + ) + df <- dplyr::bind_rows(dft, dfbb, dfbf, dfd) + cat_piece(df) + + df <- dplyr::mutate(df, cfg = gsub("checkers1", "checkers2", cfg), x = 2 * x, y = 2 * y) + cat_piece(df, annotate = TRUE, annotation_scale = 2, reorient = "all") + }) + + # fudge dice + expect_snapshot({ + df <- tibble( + piece_side = "die_face", + x = 1:6, + y = 1, + rank = 1:6, + suit = 1:6, + cfg = "dice_fudge" + ) + cat_piece(df) + + df$angle <- 90 + cat_piece(df) + }) + + # icehouse + expect_snapshot({ + dfb <- tibble( + piece_side = "board_face", + x = c(2.5, 6.5), + y = 2, + rank = 4, + cfg = "checkers1" + ) + dfpt <- tibble( + piece_side = "pyramid_top", + x = 1:8, + y = 4, + rank = rep(1:3, length.out = 8), + suit = c(1:6, 1:2), + angle = seq(0, by = 45, length.out = 8), + cfg = "icehouse_pieces" + ) + dfpf <- tibble( + piece_side = rep(c("pyramid_face", "pyramid_left", "pyramid_right", "pyramid_back"), 6), + x = rep(1:8, 3), + y = rep(1:3, each = 8), + rank = rep(1:3, each = 8), + suit = rep(1:6, 4), + angle = rep(seq(0, by = 45, length.out = 8), 3), + cfg = "icehouse_pieces" + ) + df <- dplyr::bind_rows(dfb, dfpt, dfpf) + cat_piece(df) + }) + + expect_equal(get_dots(4), "\u0324\u0308") + expect_equal(get_dots(5), "\u20e8\u0308") + expect_equal(get_dots(6), "\u20e8\u20db") + + # stackpack + expect_snapshot({ + dfpt <- tibble( + piece_side = "tile_back", + x = c(1.5, 3.5, 1.5, 3.5), + y = c(1.5, 1.5, 3.5, 3.5) + ) + dfbt <- tibble( + piece_side = rep(c("tile_face", "tile_back"), 2), + x = 1:4, + y = 1, + suit = 1:4, + rank = 1:4, + cfg = "subpack" + ) + dfc <- tibble( + piece_side = rep(c("coin_face", "coin_back"), 2), + x = 1:4, + y = 2, + suit = 1:4, + rank = 1:4, + cfg = "subpack" + ) + dfd <- tibble( + piece_side = "die_face", + x = 1:4, + y = 3, + suit = 1:4, + rank = 1:4, + cfg = "subpack" + ) + dfp <- tibble( + piece_side = rep(c("pawn_face", "pawn_back"), 2), + x = 1:4, + y = 4, + suit = 1:4, + rank = 1:4, + cfg = "subpack" + ) + df <- dplyr::bind_rows(dfpt, dfbt, dfc, dfd, dfp) + cat_piece(df) + }) + + # misc + expect_snapshot({ + dft <- tibble( + piece_side = "tile_face", + x = c(1.5, 3.5), + y = 1.5, + suit = 1, + rank = 4, + angle = c(90, 270) + ) + dfpb <- tibble(piece_side = "pawn_back", x = 1:2, y = 1, suit = 2:1, angle = c(0, 45)) + dfpf <- tibble(piece_side = "pawn_face", x = 1, y = 2, suit = 1, angle = 45) + dfbf <- tibble(piece_side = "bit_back", x = 3, y = 1, suit = 3, cfg = "checkers1") + df <- dplyr::bind_rows(dft, dfpb, dfpf, dfbf) + cat_piece(df) + }) + + # dominoes + expect_snapshot({ + dff <- tibble( + piece_side = "tile_face", + x = rep(1:6, 2), + y = rep(c(1, 3), each = 6), + suit = rep(1:6, 2), + rank = rep(2:7, 2), + angle = rep(c(0, 180), each = 6), + cfg = rep(paste0("dominoes_", c("black", "blue", "green", "red", "white", "yellow")), 2) + ) + dfb <- tibble( + piece_side = "tile_back", + x = 1:6, + y = 5, + suit = 1:6, + rank = 2:7, + angle = rep(c(0, 180), each = 3), + cfg = paste0("dominoes_", c("black", "blue", "green", "red", "white", "yellow")) + ) + df <- dplyr::bind_rows(dff, dfb) + cat_piece(df) + + dff <- tibble( + piece_side = "tile_face", + x = rep(c(1, 3), each = 6), + y = rep(1:6, 2), + suit = rep(1:6, 2), + rank = rep(2:7, 2), + angle = rep(c(90, 270), each = 6), + cfg = rep(paste0("dominoes_", c("black", "blue", "green", "red", "white", "yellow")), 2) + ) + dfb <- tibble( + piece_side = "tile_back", + x = 5, + y = 1:6, + suit = 1:6, + rank = 2:7, + angle = rep(c(90, 270), each = 3), + cfg = paste0("dominoes_", c("black", "blue", "green", "red", "white", "yellow")) + ) + df <- dplyr::bind_rows(dff, dfb) + cat_piece(df) + }) + + # matchsticks + expect_snapshot({ + dft <- tibble( + piece_side = "tile_back", + x = rep(seq(1, 9, 2), 7), + y = rep(seq(1, 13, 2), each = 5) + ) + for (angle in seq(0, 315, 45)) { + dfm <- tibble( + piece_side = "matchstick_face", + x = 1:6, + y = seq(1, 11, 2), + suit = 1, + rank = 1:6, + angle = angle + ) + df <- dplyr::bind_rows(dft, dfm) + cat_piece(df) + } + + dfm <- tibble( + piece_side = "matchstick_back", + x = 1:4, + y = seq(1, 7, 2), + suit = 1, + rank = 5, + angle = c(60, 120, 240, 300) + ) + df <- dplyr::bind_rows(dft, dfm) + cat_piece(df) + }) + expect_error(cat_piece(tibble(piece_side = "matchstick_face", x = 1, y = 1, rank = 7))) + for (rank in 1:6) { + expect_error(cat_piece(tibble( + piece_side = "matchstick_face", + x = 1, + y = 1, + rank = rank, + angle = 30 + ))) + } + + # chess + expect_snapshot({ + dfb <- tibble(piece_side = "board_face", x = 4.5, y = 4.5, suit = 2, cfg = "chess1") + dfp <- tibble( + piece_side = "bit_face", + x = 1:6, + y = 1, + rank = 1:6, + suit = 1:6, + cfg = "chess1" + ) + df <- dplyr::bind_rows(dfb, dfp) + cat_piece(df) + }) + + # go + expect_snapshot({ + dfb <- tibble(piece_side = "board_face", x = 10, y = 10, suit = 2, cfg = "go") + dfs <- tibble(piece_side = "bit_back", x = 1:19, y = 1:19, suit = 1:19 %% 6 + 1, cfg = "go") + df <- dplyr::bind_rows(dfb, dfs) + cat_piece(df) + }) + + # marbles + expect_snapshot({ + withr::local_seed(42) + dfb <- tibble( + piece_side = "board_face", + suit = 4L, + rank = 4L, + cfg = "marbles", + x = 2, + y = 2 + ) + dfm <- tibble( + piece_side = "bit_face", + suit = sample.int(6L, 30L, replace = TRUE), + rank = 9L, + cfg = "marbles", + x = c(0.5 + rep(0:3, 4L), rep(rep(1:3, 3L)), 0.5 + rep(1:2, 2L), 2), + y = c(0.5 + rep(0:3, each = 4L), rep(1:3, each = 3L), 0.5 + rep(1:2, each = 2L), 2) + ) + df <- rbind(dfb, dfm) + cat_piece(dfb) + cat_piece(df, xbreaks = 1:7, ybreaks = 1:7, annotate = TRUE, annotation_scale = 0.5) + }) + + # alquerque + expect_snapshot({ + dfb <- tibble(piece_side = "board_face", x = 3, y = 3, suit = 3, cfg = "alquerque") + dfs <- tibble(piece_side = "bit_back", x = 1:5, y = 1:5, suit = 1:5, cfg = "alquerque") + df <- rbind(dfb, dfs) + cat_piece(dfb) + cat_piece(df) + }) + + # morris + expect_snapshot({ + df2 <- tibble(piece_side = "board_face", x = 2, y = 2, rank = 2L, suit = 3L, cfg = "morris") + cat_piece(df2) + + df3 <- tibble(piece_side = "board_face", x = 2, y = 2, rank = 3L, suit = 3L, cfg = "morris") + dfs <- tibble( + piece_side = "bit_back", + x = rep(1:3, 2), + y = rep(1:2, each = 3), + rank = 1L, + suit = 1:6, + cfg = "morris" + ) + df <- rbind(df3, dfs) + cat_piece(df3) + cat_piece(df) + + df6 <- tibble(piece_side = "board_face", x = 3, y = 3, rank = 6L, suit = 3L, cfg = "morris") + cat_piece(df6) + + df7 <- tibble(piece_side = "board_face", x = 3, y = 3, rank = 7L, suit = 3L, cfg = "morris") + cat_piece(df7) + + df9 <- tibble(piece_side = "board_face", x = 4, y = 4, rank = 9L, suit = 3L, cfg = "morris") + cat_piece(df9) + + df12 <- tibble( + piece_side = "board_face", + x = 4, + y = 4, + rank = 12L, + suit = 3L, + cfg = "morris" + ) + cat_piece(df12) + }) + + # reversi + expect_snapshot({ + dfx <- tibble( + piece_side = "board_face", + x = 4.5, + y = 4.5, + rank = 8L, + suit = 2L, + cfg = "reversi" + ) + dff <- tibble( + piece_side = "bit_face", + x = 1:6, + y = 1, + rank = 1L, + suit = 1:6, + cfg = "reversi" + ) + dfb <- tibble( + piece_side = "bit_back", + x = 1:6, + y = 2, + rank = 1L, + suit = 1:6, + cfg = "reversi" + ) + df <- rbind(dfx, dff, dfb) + cat_piece(df) + }) + + # numeral dice + expect_snapshot({ + df <- tibble( + piece_side = "die_face", + x = 1:6, + y = 1, + rank = 1:6, + suit = 1:6, + cfg = "dice_numeral" + ) + cat_piece(df) + }) }) diff --git a/tests/testthat/test_game_bit_duo.R b/tests/testthat/test_game_bit_duo.R index 2687183..a395e1c 100644 --- a/tests/testthat/test_game_bit_duo.R +++ b/tests/testthat/test_game_bit_duo.R @@ -1,8 +1,8 @@ cat_piece <- function(df, ...) { - ppcli::cat_piece(df, ..., color = FALSE, style = "Game Bit Duo") + ppcli::cat_piece(df, ..., color = FALSE, style = "Game Bit Duo") } test_that("Piecepack", { - skip_if_not_installed("ppdf") - expect_snapshot(cat_piece(ppdf::piecepack_shopping_mall(seed = 42))) + skip_if_not_installed("ppdf") + expect_snapshot(cat_piece(ppdf::piecepack_shopping_mall(seed = 42))) }) diff --git a/tests/testthat/test_game_bit_mono.R b/tests/testthat/test_game_bit_mono.R index ef96b91..b017819 100644 --- a/tests/testthat/test_game_bit_mono.R +++ b/tests/testthat/test_game_bit_mono.R @@ -1,24 +1,24 @@ cat_piece <- function(df, ...) { - ppcli::cat_piece(df, ..., color = FALSE, style = "Game Bit Mono") + ppcli::cat_piece(df, ..., color = FALSE, style = "Game Bit Mono") } test_that("Dominoes", { - skip_if_not_installed("tibble") - library("tibble") - df <- tibble(piece_side = "tile_face", - x=c(0.5, 1.0, 1.5, 2.0, 2.5, 2.5, 3.5, 4.0, 4.0, - 4.5, 5.5, 6.0, 7.5, 8.0), - y=c(5.0, 2.5, 1.0, 4.5, 6.0, 3.0, 1.0, 6.5, 2.5, - 4.0, 6.0, 4.5, 4.0, 2.5), - rank = c(4, 2, 5, 4, 1, 1, 5, 1, 5, 6, 2, 6, 6, 4) + 1, - suit = c(4, 5, 0, 1, 1, 5, 4, 2, 5, 5, 6, 6, 4, 0) + 1, - angle = c(0, 90, 0, 90, 0, 0, 0, 90, 90, 0, 0, 90, 0, 90), - cfg = "dominoes_white") - expect_snapshot(cat_piece(df)) + skip_if_not_installed("tibble") + library("tibble") + df <- tibble( + piece_side = "tile_face", + x = c(0.5, 1.0, 1.5, 2.0, 2.5, 2.5, 3.5, 4.0, 4.0, 4.5, 5.5, 6.0, 7.5, 8.0), + y = c(5.0, 2.5, 1.0, 4.5, 6.0, 3.0, 1.0, 6.5, 2.5, 4.0, 6.0, 4.5, 4.0, 2.5), + rank = c(4, 2, 5, 4, 1, 1, 5, 1, 5, 6, 2, 6, 6, 4) + 1, + suit = c(4, 5, 0, 1, 1, 5, 4, 2, 5, 5, 6, 6, 4, 0) + 1, + angle = c(0, 90, 0, 90, 0, 0, 0, 90, 90, 0, 0, 90, 0, 90), + cfg = "dominoes_white" + ) + expect_snapshot(cat_piece(df)) }) # https://github.com/piecepackr/ppcli/issues/3 test_that("Can't rotate boards", { - skip_if_not_installed("ppdf", "0.2.0-13") - expect_snapshot(cat_piece(ppdf::checker_italian_checkers(), annotate = "cartesian")) + skip_if_not_installed("ppdf", "0.2.0-13") + expect_snapshot(cat_piece(ppdf::checker_italian_checkers(), annotate = "cartesian")) }) diff --git a/tests/testthat/test_html.R b/tests/testthat/test_html.R index 6b105ef..db5ab76 100644 --- a/tests/testthat/test_html.R +++ b/tests/testthat/test_html.R @@ -1,7 +1,7 @@ test_that('`color = "html"`', { - skip_if_not_installed("fansi") - skip_if_not_installed("ppdf") + skip_if_not_installed("fansi") + skip_if_not_installed("ppdf") - s <- str_piece(ppdf::piecepack_american_checkers(), color = "html") - expect_true(any(grepl("span style", s))) + s <- str_piece(ppdf::piecepack_american_checkers(), color = "html") + expect_true(any(grepl("span style", s))) }) diff --git a/tests/testthat/test_range.R b/tests/testthat/test_range.R index 21820b8..47bee91 100644 --- a/tests/testthat/test_range.R +++ b/tests/testthat/test_range.R @@ -1,17 +1,17 @@ test_that("`range_heuristic()`", { - skip_if_not_installed("ppdf") - skip_if_not_installed("tibble") - library("tibble") + skip_if_not_installed("ppdf") + skip_if_not_installed("tibble") + library("tibble") - df <- ppdf::piecepack_four_field_kono() - df$cfg <- "piecepack" - df$angle <- 0 - expect_equal(range_heuristic(df)$xmin, 0.5) - expect_equal(range_heuristic(df)$xmax, 4.5) - expect_equal(range_heuristic(df)$ymin, 0.5) - expect_equal(range_heuristic(df)$ymax, 4.5) - expect_equal(range_heuristic(tibble())$xmin, NA_real_) - expect_equal(range_heuristic(tibble())$xmax, NA_real_) - expect_equal(range_heuristic(tibble())$ymin, NA_real_) - expect_equal(range_heuristic(tibble())$ymax, NA_real_) + df <- ppdf::piecepack_four_field_kono() + df$cfg <- "piecepack" + df$angle <- 0 + expect_equal(range_heuristic(df)$xmin, 0.5) + expect_equal(range_heuristic(df)$xmax, 4.5) + expect_equal(range_heuristic(df)$ymin, 0.5) + expect_equal(range_heuristic(df)$ymax, 4.5) + expect_equal(range_heuristic(tibble())$xmin, NA_real_) + expect_equal(range_heuristic(tibble())$xmax, NA_real_) + expect_equal(range_heuristic(tibble())$ymin, NA_real_) + expect_equal(range_heuristic(tibble())$ymax, NA_real_) }) From 6340bb812e92f2f306d065719d8a65290f816f98 Mon Sep 17 00:00:00 2001 From: "Trevor L. Davis" Date: Mon, 6 Apr 2026 00:02:17 -0700 Subject: [PATCH 4/4] chore: `tldtools::use_tld_github_actions()` --- .Rbuildignore | 1 + .github/workflows/R-CMD-check.yaml | 11 +++++++++- .github/workflows/test-coverage.yaml | 32 ++++++++++++++++++++++++++++ .gitignore | 1 + 4 files changed, 44 insertions(+), 1 deletion(-) create mode 100644 .github/workflows/test-coverage.yaml diff --git a/.Rbuildignore b/.Rbuildignore index 81139b8..3fbbad7 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -25,3 +25,4 @@ tmp ^\.pre-commit-config.yaml$ ^Dockerfile$ ^\.dockerignore$ +^\.claude$ diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml index 8384ccc..da505fa 100644 --- a/.github/workflows/R-CMD-check.yaml +++ b/.github/workflows/R-CMD-check.yaml @@ -4,10 +4,11 @@ on: push: branches: [main, master] pull_request: - branches: [main, master] name: R-CMD-check +permissions: read-all + jobs: R-CMD-check: runs-on: ${{ matrix.config.os }} @@ -18,6 +19,8 @@ jobs: fail-fast: false matrix: config: + # - {os: macOS-latest, r: 'release'} + # - {os: windows-latest, r: 'release'} - {os: ubuntu-latest, r: 'devel', http-user-agent: 'release'} - {os: ubuntu-latest, r: 'release'} - {os: ubuntu-latest, r: 'oldrel-1'} @@ -29,6 +32,9 @@ jobs: steps: - uses: actions/checkout@v4 + # - if: runner.os == 'macOS' + # run: brew install --cask xquartz + - uses: r-lib/actions/setup-pandoc@v2 - uses: r-lib/actions/setup-r@v2 @@ -43,3 +49,6 @@ jobs: needs: check - uses: r-lib/actions/check-r-package@v2 + # with: + # upload-snapshots: true + # build_args: 'c("--no-manual","--compact-vignettes=gs+qpdf")' diff --git a/.github/workflows/test-coverage.yaml b/.github/workflows/test-coverage.yaml new file mode 100644 index 0000000..03362af --- /dev/null +++ b/.github/workflows/test-coverage.yaml @@ -0,0 +1,32 @@ +# Workflow derived from https://github.com/r-lib/actions/tree/master/examples +# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help +on: + push: + branches: [main, master] + pull_request: + branches: [main, master] + +name: test-coverage + +jobs: + test-coverage: + runs-on: ubuntu-latest + env: + GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} + CODECOV_TOKEN: ${{ secrets.CODECOV_TOKEN }} + NOT_CRAN: true + + steps: + - uses: actions/checkout@v4 + + - uses: r-lib/actions/setup-r@v2 + with: + use-public-rspm: true + + - uses: r-lib/actions/setup-r-dependencies@v2 + with: + extra-packages: covr + + - name: Test coverage + run: covr::codecov() + shell: Rscript {0} diff --git a/.gitignore b/.gitignore index 7daae70..3de9251 100644 --- a/.gitignore +++ b/.gitignore @@ -8,6 +8,7 @@ codecov.yml README.html +.claude/ html/ others/ tmp/