cfg_default <- pp_cfg(list(title="default cfg")) cfg_3d <- game_systems("sans3d")$piecepack test_that("pp_cfg works as expected", { expect_true(inherits(cfg_default, "pp_cfg")) expect_equal(class(as.list(cfg_default)), "list") expect_output(print(cfg_default), "default cfg") }) test_that("update_names works as expected", { df <- tibble(x = 1:4, name = 1:4) expect_equal(update_name(df)$name, as.character(1:4)) df <- tibble(x = 1:4, id = 1:4) expect_equal(update_name(df)$name, paste0("piece.", 1:4)) df <- tibble(x = 1:4) expect_equal(update_name(df)$name, paste0("piece.", 1:4)) df <- tibble(x = 1:4, name = 1) expect_warning(update_name(df)$name, "the name column in .l is not unique, generating new name column") df <- tibble(x = 1:4, id = 1) expect_warning(update_name(df)$name, "the id column in .l is not unique, generating new name column") }) test_that("save_print_and_play works as expected", { skip_on_cran() pdf_deck_dir <- tempfile() dir.create(pdf_deck_dir) on.exit(unlink(pdf_deck_dir, recursive=TRUE)) pdf_deck_filename <- file.path(pdf_deck_dir, "piecepack_deck.pdf") on.exit(unlink(pdf_deck_filename)) pdf_deck_filename_a4 <- file.path(pdf_deck_dir, "piecepack_deck_a4.pdf") on.exit(unlink(pdf_deck_filename_a4)) pdf_deck_filename_a5 <- file.path(pdf_deck_dir, "piecepack_deck_a5.pdf") on.exit(unlink(pdf_deck_filename_a5)) pdf_deck_filename_5s <- file.path(pdf_deck_dir, "piecepack_deck_5s.pdf") on.exit(unlink(pdf_deck_filename_5s)) pdf_deck_filename_4x6 <- file.path(pdf_deck_dir, "piecepack_deck_4x6.pdf") on.exit(unlink(pdf_deck_filename_4x6)) pdf_deck_filename_bleed <- file.path(pdf_deck_dir, "piecepack_deck_bleed.pdf") cfg_5s <- list(suit_text="♥,★,♣,♦,♠,꩜", suit_color="darkred,gold,darkgreen,darkblue,black,grey") skip_if_not(capabilities("cairo")) save_print_and_play(cfg_5s, pdf_deck_filename_5s, "A5", "all", "double-sided", quietly = TRUE) save_print_and_play(cfg_default, pdf_deck_filename, "letter", quietly = TRUE) cfg_large_dice <- pp_cfg(list(title="default cfg", width.die = 0.7)) save_print_and_play(cfg_large_dice, pdf_deck_filename_a4, "A4", arrangement = "double-sided", quietly = TRUE) save_print_and_play(cfg_default, pdf_deck_filename_a5, "A5", quietly = TRUE) save_print_and_play(cfg_default, pdf_deck_filename_4x6, "4x6", pieces = "piecepack", quietly = TRUE) save_print_and_play(cfg_default, pdf_deck_filename_bleed, bleed=TRUE, quietly = TRUE) expect_true(file.exists(pdf_deck_filename)) skip_if_not_installed("qpdf") # avoid potential "n_pages_gs()" bug on Windows skip_if_not_installed("xmpdf") expect_equal(xmpdf::n_pages(pdf_deck_filename), 7, ignore_attr = "names") expect_equal(xmpdf::n_pages(pdf_deck_filename_a4), 10, ignore_attr = "names") expect_equal(xmpdf::n_pages(pdf_deck_filename_a5), 14, ignore_attr = "names") expect_equal(xmpdf::n_pages(pdf_deck_filename_4x6), 13, ignore_attr = "names") expect_equal(xmpdf::n_pages(pdf_deck_filename_bleed), 7, ignore_attr = "names") }) test_that("save_piece_images works as expected", { skip_if_not(capabilities("cairo")) directory <- tempfile() on.exit(unlink(directory)) cfg <- pp_cfg(list(grob_fn=picturePieceGrobFn(directory))) g.p <- function(...) { grid.piece(..., op_scale=0.5, default.units="in") } current_dev <- grDevices::dev.cur() expect_error(save_piece_images(cfg_default, directory), "dir.exists\\(directory\\) is not TRUE") expect_error(grid.piece("tile_back", cfg=cfg), "Couldn't find suitable") grDevices::dev.off() if (current_dev > 1) { grDevices::dev.set(current_dev) } dir.create(directory) save_piece_images(cfg_default, directory, format="svgz", angle=c(0,90)) expect_equal(length(list.files(directory)), 496) announce_snapshot_file(name = "diagram-op-ppgf.svg") skip_if_not(Sys.info()[["nodename"]] == "pesd-tld-laptop") library("vdiffr") suppressMessages({ expect_doppelganger("diagram_op_ppgf", function() { g.p("tile_back", x=0.5+c(3,1,3,1), y=0.5+c(3,3,1,1), cfg=cfg) g.p("tile_back", x=0.5+3, y=0.5+1, z=1/4+1/8, cfg=cfg) g.p("tile_back", x=0.5+3, y=0.5+1, z=2/4+1/8, cfg=cfg) g.p("die_face", x=1, y=1, z=1/4+1/4, cfg=cfg) g.p("pawn_face", x=1, y=4, z=1/4+1/8, angle=90, cfg=cfg) g.p("coin_face", x=3, y=4, z=1/4+1/16, angle=180, cfg=cfg) g.p("coin_back", x=3, y=4, z=1/4+1/8+1/16, angle=180, cfg=cfg) g.p("coin_back", x=3, y=1, z=3/4+1/16, angle=90, cfg=cfg) }) }, classes="piecepackr_affine_transformation") }) test_that("no regressions in figures", { skip_on_ci() skip_if_not(capabilities("cairo")) skip_if_not_installed("vdiffr") library("vdiffr") dc <- function(..., cfg=cfg_default) { grid.piece(..., cfg=cfg, default.units="npc") } dce <- function(...) { tmpfile <- tempfile(fileext=".svg") on.exit(unlink(tmpfile)) svg(tmpfile) on.exit(dev.off()) grid.piece(..., default.units="npc") } # tile back expect_doppelganger("tile_back", function() dc("tile_back", bleed=TRUE)) expect_doppelganger("tile_back_thickgrid", function() dc("tile_back", cfg=list(gridline_lex.tile_back=5))) expect_doppelganger("tile_back_thickborder", function() dc("tile_back", cfg=list(border_lex.tile_back=5))) expect_doppelganger("tile_back-svg", function() dc("tile_back", type="picture")) expect_doppelganger("tile_back-hex", function() dc("tile_back", cfg=list(shape.tile_back="convex6"))) # tile face expect_doppelganger("tile_face.s1.r1", function() dc("tile_face", suit=1, rank=1)) expect_doppelganger("tile_face.s3.r2", function() dc("tile_face", suit=3, rank=2)) expect_doppelganger("tile_face.s3.r2-suit_as_ace", function() dc("tile_face", cfg=list(use_suit_as_ace=TRUE), suit=3, rank=2)) expect_doppelganger("tile_face.s2.r3", function() dc("tile_face", suit=2, rank=3)) df_tile <- tibble::tribble(~x, ~y, ~suit, ~rank, 1, 1, NA, NA, 3, 1, 3, NA, 1, 3, NA, 3, 3, 3, 3, 3) df_tile$piece_side <- "tile_back" df_tile$please_ignore <- "what" df_tile$id <- 1:4 expect_doppelganger("tiles_faces", function() pmap_piece(df_tile, width=2, height=2, default.units="inches", cfg="cfg_default") ) # 106 expect_doppelganger("different_sizes", function() { pushViewport(viewport(width=inch(6), height=inch(6))) dc("tile_face", suit=2, rank=3, x=inch(1), y=inch(5)) dc("tile_face", suit=2, rank=3, x=inch(4), y=inch(4.5), cfg=list(width.tile=3)) dc("tile_face", suit=2, rank=3, x=inch(4), y=inch(1.5), cfg=list(width.tile=4, height.tile=3)) dc("coin_back", suit=3, x=inch(1), y=inch(1), cfg=list(mat_width.coin=0.1)) dc("coin_back", suit=3, x=inch(2), y=inch(1), cfg=list(width.coin=1, mat_width.coin=0.1)) }) #### coins appear wrong #99 # coin back expect_doppelganger("coin_back.s4", function() dc("coin_back", suit=4)) expect_doppelganger("coin_back.s4-inverted", function() dc("coin_back", cfg=list(invert_colors=TRUE), suit=4)) # coin face expect_doppelganger("coin_face.r1", function() dc("coin_face", rank=1)) expect_doppelganger("coin_face.r2", function() dc("coin_face", rank=2)) expect_doppelganger("coin_face.r4", function() dc("coin_face", rank=4)) expect_doppelganger("coin_face.r4italic", function() { dc("coin_face", cfg=list(ps_fontface.coin_face="italic"), rank=4) }) expect_doppelganger("coin_face.r4pyramid", function() dc("coin_face", rank=4, cfg=list(shape.coin="pyramid"))) expect_doppelganger("coin_face.r4convex8", function() dc("coin_face", rank=4, cfg=list(shape.coin="convex8"))) expect_doppelganger("coin_face.r4concave8", function() dc("coin_face", rank=4, cfg=list(shape.coin="concave8", shape_r.coin=0.4))) expect_doppelganger("coin_face.r4oval", function() dc("coin_face", rank=4, op_scale = 0.5, cfg=list(shape.coin="oval", height.coin=1.3))) # die faces expect_doppelganger("die_face.s4.r1", function() dc("die_face", suit=4, rank=1)) expect_doppelganger("die_face.s3.r2", function() dc("die_face", suit=3, rank=2)) expect_doppelganger("die_face.s2.r5", function() dc("die_face", suit=2, rank=5)) expect_doppelganger("die_face.s2.r5.kite", function() dc("die_face", suit=2, rank=5, cfg=list(shape.die_face="kite", dm_t=90, suit_cex="1,1,1,1"))) expect_doppelganger("die_face.s2.r5.convex5mat", function() { dc("die_face", suit=2, rank=5, cfg=list(shape.die_face="convex5", mat_width.die_face=0.1, mat_color="pink")) }) expect_doppelganger("suitdie_face.s1", function() dc("suitdie_face", suit=1)) expect_doppelganger("suitdie_face.s5", function() dc("suitdie_face", suit=5)) expect_doppelganger("suitdie_face.s6", function() dc("suitdie_face", suit=6)) # pawns expect_doppelganger("pawn_face.s3", function() dc("pawn_face", suit=3)) expect_doppelganger("pawn_back.s2", function() dc("pawn_back", suit=2)) expect_doppelganger("belt_face.s1", function() dc("belt_face", suit=1)) expect_doppelganger("saucer_face.s4", function() dc("saucer_face", suit=4)) expect_doppelganger("saucer_back", function() dc("saucer_back")) cfg <- list(shape.pawn="convex6", height.pawn=1, width.pawn=0.5) expect_doppelganger("pawn_face.irregular_convex", function() dc("pawn_face", cfg=cfg, op_scale=0.5)) # matchsticks expect_doppelganger("matchstick_face.s1.r1", function() dc("matchstick_face", suit=1, rank=1)) expect_doppelganger("matchstick_face.s2.r2", function() dc("matchstick_face", suit=2, rank=2)) expect_doppelganger("matchstick_face.s3.r3", function() dc("matchstick_face", suit=3, rank=3)) expect_doppelganger("matchstick_face.s4.r4", function() dc("matchstick_face", suit=4, rank=4)) expect_doppelganger("matchstick_face.s1.r5", function() dc("matchstick_face", suit=1, rank=5)) expect_doppelganger("matchstick_face.s2.r6", function() dc("matchstick_face", suit=2, rank=6)) cfg <- list(invert_colors.suited=TRUE, grob_fn="basicPieceGrob") expect_doppelganger("matchstick_back.s3.r6", function() dc("matchstick_back", cfg=cfg, suit=3, rank=6)) expect_doppelganger("preview", function() dc("preview_layout")) expect_doppelganger("preview.5s", function() { dc("preview_layout", cfg=list(suit_text="A,B,C,D,E,", die_arrangement="counter_up")) }) expect_doppelganger("preview.6s", function() dc("preview_layout", cfg=list(suit_text="I,II,III,IV,V,VI,"))) # dice cfg <- list(suit_text="-,0,+,") expect_doppelganger("suitdie_layoutLF", function() dc("suitdie_layoutLF", cfg=cfg)) expect_doppelganger("suitdie_layoutRF", function() dc("suitdie_layoutRF")) expect_doppelganger("suitrankdie_layoutLF", function() dc("suitrankdie_layoutLF")) cfg <- list(die_arrangement="opposites_sum_to_5") expect_doppelganger("die_layoutRF-opposites_sum_to_5", function() dc("die_layoutRF", suit=3, cfg=cfg)) # 102 expect_doppelganger("rankdie_layoutRF_suitasace", function() { dc("die_layoutRF", suit=6, cfg=list(use_suit_as_ace=TRUE)) }) # edges df <- tibble(piece_side = c("pawn_top", "coin_left", "tile_base"), x = 1:3, y = 1:3, suit = 1:3, rank = 1:3) cfg <- list(border_color = "black", edge_color.pawn = "red", edge_color.coin = "grey", edge_color.tile = "grey") expect_doppelganger("piece_edges", function() { pushViewport(viewport(width=inch(4), height=inch(4))) pmap_piece(df, cfg=cfg, default.units="in") }) cfg <- list(suit_text="A,B,C,D,E,F", suit_color="red,black,green,blue,orange,grey") expect_doppelganger("suitdie_layoutRF-5suits", function() dc("suitdie_layoutRF", cfg=cfg)) expect_doppelganger("suitrankdie_layoutRF-5suits", function() dc("suitrankdie_layoutRF", cfg=cfg)) cfg <- list(suit_text="A,B,C,D,E,F,G", suit_color="red,black,green,blue,orange,purple,grey") expect_doppelganger("suitdie_layoutRF-6suits", function() dc("suitdie_layoutRF", cfg=cfg)) expect_doppelganger("suitrankdie_layoutRF-6suits", function() dc("suitrankdie_layoutRF", cfg=cfg)) # draw_pieces df <- tibble::tribble(~piece_side, ~x, ~y, ~suit, ~rank, "tile_face", 0.25, 0.25, 1, 1, "tile_face", 0.75, 0.25, 2, 2, "tile_face", 0.25, 0.75, 3, 5, "tile_face", 0.75, 0.75, 4, 6) expect_doppelganger("draw_components", function() { pushViewport(viewport(width=inch(4), height=inch(4))) pmap_piece(df, cfg="default", envir=list(default=cfg_default)) }) expect_doppelganger("draw_components.default", function() { pushViewport(viewport(width=inch(4), height=inch(4))) pmap_piece(df, envir=list()) }) # errors expect_error(dce("coin_face", rank = 3, cfg=list(gridline_color = "grey")), "Don't know how to add grid lines to shape circle") expect_error(dce("coin_face", rank = 3, cfg=list(shape = "megahex")), "Don't recognize shape label megahex") expect_error(dce("coin_face", rank = 3, cfg=list(mat_width=0.2, mat_color="green", shape="kite")), "Don't know how to add mat to shape kite") expect_error(cfg_default$get_width("boo_back"), "Don't know width of piece boo") expect_error(game_systems("boobear"), "Don't have a customized configuration for style boobear") # piecepack pyramids expect_doppelganger("pyramid_face.s1.r6", function() dc("pyramid_face", suit=1, rank=6)) expect_doppelganger("pyramid_left.s2.r5", function() dc("pyramid_left", suit=2, rank=5)) expect_doppelganger("pyramid_right.s3.r2", function() dc("pyramid_right", suit=3, rank=2)) expect_doppelganger("pyramid_back.s4.r1", function() dc("pyramid_back", suit=4, rank=1)) expect_doppelganger("pyramid_face.s2.r1", function() dc("pyramid_face", suit=2, rank=1)) cfg <- list(invert_colors.suited=TRUE, grob_fn="basicPieceGrob") expect_doppelganger("pyramid_layout.s3.r4", function() dc("pyramid_layout", cfg=cfg, suit=3, rank=4)) announce_snapshot_file(name = "pyramid-face-op.svg") announce_snapshot_file(name = "pyramid-top-op.svg") announce_snapshot_file(name = "pyramid-top-s4-r3.svg") skip_if_not(Sys.info()[["nodename"]] == "pesd-tld-laptop") suppressMessages({ expect_doppelganger("pyramid_top.s4.r3", function() dc("pyramid_top", suit=4, rank=3)) expect_doppelganger("pyramid_top_op", function() dc("pyramid_top", rank = 6, op_angle = 90, op_scale = 0.5, cfg = list(invert_colors = TRUE))) expect_doppelganger("pyramid_face_op", function() dc("pyramid_face", rank = 6, op_angle = 90, op_scale = 0.5, cfg = list(invert_colors = TRUE))) }, classes="piecepackr_affine_transformation") }) test_that("oblique projection works", { skip_on_ci() skip_on_cran() skip_if_not(capabilities("cairo")) skip_if_not_installed("vdiffr") library("vdiffr") dc <- function(..., cfg=cfg_default) { grid.piece(..., cfg=cfg, op_scale=0.5, default.units="npc") } expect_doppelganger("tile_face_op", function() dc("tile_face")) expect_doppelganger("tile_face_op_roundrect", function() dc("tile_face", cfg=list(shape.tile="roundrect"))) expect_doppelganger("coin_face_op", function() dc("coin_face")) expect_doppelganger("pawn_face_op", function() dc("pawn_face", cfg=cfg_3d)) expect_doppelganger("matchstick_face_op", function() dc("matchstick_face")) suppressMessages({ expect_doppelganger("die_face_op", function() dc("die_face")) g.p <- function(...) { grid.piece(..., op_scale=0.5, default.units="in") } cfg <- pp_cfg(list(depth.pawn=1, width.pawn=0.75, height.pawn=0.75, dm_text.pawn="", shape.pawn="convex6", invert_colors.pawn=TRUE)) expect_doppelganger("diagram_op", function() { g.p("tile_back", x=0.5+c(3,1,3,1), y=0.5+c(3,3,1,1), cfg=cfg) g.p("tile_back", x=0.5+3, y=0.5+1, z=1/4+1/8, cfg=cfg) g.p("tile_back", x=0.5+3, y=0.5+1, z=2/4+1/8, cfg=cfg) g.p("die_face", x=1, y=1, z=1/4+1/4, cfg=cfg) g.p("pawn_face", x=1, y=4, z=1/4+1/2, angle=90, cfg=cfg) g.p("coin_back", x=3, y=4, z=1/4+1/16, angle=180, cfg=cfg) g.p("coin_back", x=3, y=4, z=1/4+1/8+1/16, angle=180, cfg=cfg) g.p("coin_back", x=3, y=1, z=3/4+1/16, angle=90, cfg=cfg) }) }, classes="piecepackr_affine_transformation") cfg <- pp_cfg(list(depth.pawn = 10/25.4, width.pawn=16/25.4, height.pawn=16/25.4, dm_cex.pawn=0.5, shape.pawn="meeple", invert_colors.pawn=TRUE)) expect_doppelganger("meeple", function() { g.p("pawn_face", x=2, y=3, cfg=cfg, op_angle=90) g.p("pawn_face", x=3, y=3, cfg=cfg, op_angle=45) g.p("pawn_face", x=3, y=2, cfg=cfg, op_angle=0) g.p("pawn_face", x=3, y=1, cfg=cfg, op_angle=-45) g.p("pawn_face", x=2, y=1, cfg=cfg, op_angle=-90) g.p("pawn_face", x=1, y=1, cfg=cfg, op_angle=-135) g.p("pawn_face", x=1, y=2, cfg=cfg, op_angle=180) g.p("pawn_face", x=1, y=3, cfg=cfg, op_angle=135) g.p("coin_face", x=2, y=2, cfg=cfg, op_angle=0, angle=190) }) }) test_that("alpha and scale works", { skip_on_ci() skip_if_not(capabilities("cairo")) skip_if_not_installed("vdiffr") library("vdiffr") expect_doppelganger("alpha", function() { cfg <- pp_cfg(list(shape.coin="convex6")) df <- tibble(piece_side="coin_back", x=1:6, y=1, alpha=seq(0, 1, length.out=6)) pmap_piece(df, default.units="in", cfg=cfg) }) expect_doppelganger("scale", function() { cfg <- pp_cfg(list(shape.coin="convex6")) df <- tibble(piece_side="coin_back", x=1:6, y=1, scale=seq(0, 1, length.out=6)) pmap_piece(df, default.units="in", cfg=cfg) }) announce_snapshot_file(name = "alpha-and-scale-op.svg") skip_if_not(Sys.info()[["nodename"]] == "pesd-tld-laptop") expect_doppelganger("alpha_and_scale_op", function() { cfg <- pp_cfg(list(shape.coin="convex6")) df <- tibble(piece_side="coin_back", x=1:6, y=1, alpha=seq(0, 1, length.out=6), scale=seq(0, 1, length.out=6)) g <- pmap_piece(df, default.units="in", cfg=cfg, op_scale=0.5) grid.draw(pp_shape()$polyclip(g, "minus", gp=gpar(fill="yellow"))) }) })