tests/testthat/test-options.R

test_that("options work as expected", {
	cfg <- list(
		invert_colors.suited = TRUE,
		background_color = "white",
		suit_color = "darkred,black,darkgreen,darkblue,grey",
		lacks_suit = "coin_face",
		n_suits = 4
	)
	expect_equal(get_suit_color("coin_back", 1, 1, cfg), "white")
	expect_equal(get_suit_color("coin_face", 5, 1, cfg), "grey")
	expect_equal(pp_cfg(cfg)$get_suit_color(3:2), c("darkgreen", "black"))
	colors <- c("darkred", "black", "darkgreen", "darkblue", "grey")
	cfg <- list(
		invert_colors.suited = TRUE,
		background_color = "white",
		suit_color = colors,
		lacks_suit = "coin_face",
		n_suits = 4
	)
	expect_equal(get_suit_color("coin_back", 1, 1, cfg), "white")
	expect_equal(get_suit_color("coin_face", 5, 1, cfg), "grey")
	cfg <- pp_cfg(cfg)
	expect_equal(cfg$get_suit_color(3:2), colors[3:2])
	expect_equal(cfg$get_suit_color(), colors[1:4])

	cfg <- list(n_suits = 4)
	expect_equal(should_invert("coin_back", 1, 1, cfg), FALSE)
	expect_equal(should_invert("coin_face", 5, 1, cfg), FALSE)
	cfg <- list(invert_colors = TRUE, n_suits = 4)
	expect_equal(should_invert("coin_back", 1, 1, cfg), TRUE)
	expect_equal(should_invert("coin_face", 5, 1, cfg), TRUE)
	cfg <- list(invert_colors = FALSE, n_suits = 4)
	expect_equal(should_invert("coin_back", 1, 1, cfg), FALSE)
	expect_equal(should_invert("coin_face", 5, 1, cfg), FALSE)
	cfg <- list(invert_colors.suited = TRUE, lacks_suit = "coin_face", n_suits = 4)
	expect_equal(should_invert("coin_back", 1, 1, cfg), TRUE)
	expect_equal(should_invert("coin_face", 5, 1, cfg), FALSE)
	cfg <- list(invert_colors.unsuited = TRUE, lacks_suit = "coin_face", n_suits = 4)
	expect_equal(should_invert("coin_back", 1, 1, cfg), FALSE)
	expect_equal(should_invert("coin_face", 5, 1, cfg), TRUE)
	cfg <- list(invert_colors.coin_back = TRUE, n_suits = 4)
	expect_equal(should_invert("coin_back", 1, 1, cfg), TRUE)
	expect_equal(should_invert("coin_face", 5, 1, cfg), FALSE)
	cfg <- list(invert_colors.coin_face = TRUE, n_suits = 4)
	expect_equal(should_invert("coin_back", 1, 1, cfg), FALSE)
	expect_equal(should_invert("coin_face", 5, 1, cfg), TRUE)

	cfg <- pp_cfg(list(n_ranks = 7, n_suits = 3))
	expect_equal(cfg$n_ranks, 7)
	expect_equal(cfg$n_suits, 3)

	cfg <- list(rank_symbols = "A,B,C,D,E,F", use_suit_as_ace = TRUE, n_ranks = 6, n_suits = 4)
	expect_equal(get_rank_symbol("die_face", 6, 2, cfg), "\u263c")

	cfg <- list(background_color.unsuited = "orange", lacks_suit = "tile_back", n_suits = 4)
	expect_equal(get_background_color("tile_face", 1, 1, cfg), "white")
	expect_equal(get_background_color("tile_back", 1, 1, cfg), "orange")
	expect_equal(is_suited("die_face", 5, 1, list(n_suits = 4)), TRUE)
	expect_equal(is_suited("die_face", 6, 1, list(n_suits = 4)), FALSE)
	expect_equal(get_background_color("die_face", 5, 1, cfg), "white")
	expect_equal(get_background_color("die_face", 6, 1, cfg), "orange")
	cfg1 <- list(dm_text = "", n_suits = 4)
	cfg2 <- list(dm_text = ",,,,", n_suits = 4)
	expect_equal(get_dm_text("suitdie_face", 3, 1, cfg1), "")
	expect_equal(get_dm_text("suitdie_face", 3, 1, cfg2), "")
	expect_equal(get_dm_text("suitdie_face", 6, 1, cfg1), "")
	expect_equal(get_dm_text("suitdie_face", 6, 1, cfg2), "")
	expect_equal(get_dm_text("die_face", 6, 1, cfg2), "")
	cfg <- list(dm_text.saucer_face = "b", n_suits = 4)
	expect_equal(get_dm_text("saucer_face", 3, 1, cfg), "b")
	cfg <- list(dm_text.saucer_back = "b", n_suits = 4)
	expect_equal(get_dm_text("saucer_back", 5, 1, cfg), "b")

	cfg <- list(
		invert_colors.suited = TRUE,
		invert_colors.r1 = FALSE,
		suit_color = "darkred,black,darkgreen,darkblue,grey",
		n_suits = 4
	)
	expect_equal(get_background_color("tile_face", 1, 2, cfg), "darkred")
	expect_equal(get_background_color("tile_face", 1, 1, cfg), "white")
})

test_that("get_piece_opt works as expected", {
	cfg <- pp_cfg(list(suit_color = "darkred,black,darkgreen,darkblue,grey"))
	opt <- cfg$get_piece_opt("coin_face")
	expect_equal(opt$background_color, "white")
	expect_equal(opt$border_color, "grey")
	expect_equal(opt$bleed_color, "grey")
	expect_equal(opt$gridline_color, "transparent")
	expect_equal(opt$ps_color, "grey")
	expect_equal(opt$ps_text, "n")
	expect_equal(opt$ps_fontsize, 28)
	expect_equal(opt$ps_fontfamily, "sans")
	expect_equal(opt$ps_fontface, "plain")
	expect_equal(opt$dm_color, "grey")
	expect_equal(opt$dm_text, "\u25cf")
	expect_equal(opt$shape, "circle")
	expect_equal(opt$shape_r, 0.2)
	expect_equal(opt$shape_t, 90)
	expect_equal(opt$dm_fontsize, 12)
	expect_equal(opt$dm_fontfamily, "sans")
	expect_equal(opt$dm_fontface, "plain")
	expect_equal(opt$dm_x, 0.5)
	expect_equal(opt$dm_y, to_y(90, sqrt(0.25^2 + 0.25^2)) + 0.5)
	expect_equal(opt$ps_x, 0.5)
	expect_equal(opt$ps_y, 0.5)
	expect_equal(opt$dm_text, "\u25cf")

	cfg <- pp_cfg()
	opt <- cfg$get_piece_opt("saucer_back")
	expect_equal(opt$dm_text, "\u25b2")
	opt <- cfg$get_piece_opt("pawn_face")
	expect_equal(opt$dm_text, "\u0298\u0298")
	opt <- cfg$get_piece_opt("pawn_back")
	expect_equal(opt$dm_text, "")

	cfg <- pp_cfg(list(suit_color = "white"))
	opt <- cfg$get_piece_opt("tile_face", suit = 2, rank = 2)
	expect_equal(opt$ps_col, "white")
	cfg <- pp_cfg(list(suit_color.suited = "white"))
	opt <- cfg$get_piece_opt("tile_face", suit = 2, rank = 2)
	expect_equal(opt$ps_col, "white")
	cfg <- pp_cfg(list(suit_color.s2 = "white"))
	opt <- cfg$get_piece_opt("tile_face", suit = 2, rank = 2)
	expect_equal(opt$ps_col, "white")

	cfg <- pp_cfg(list(border_lex = 0))
	expect_equal(cfg$get_piece_opt("tile_face")$bleed_color, "white")
	cfg <- pp_cfg(list(border_color = "transparent"))
	expect_equal(cfg$get_piece_opt("tile_face")$bleed_color, "white")
	cfg <- pp_cfg(list(border_color = "transparent", mat_color = "blue"))
	expect_equal(cfg$get_piece_opt("tile_face")$bleed_color, "white")
	cfg <- pp_cfg(list(border_color = "transparent", mat_color = "blue", mat_width = 0.1))
	expect_equal(cfg$get_piece_opt("tile_face")$bleed_color, "blue")
	cfg <- pp_cfg(list(
		border_color = "transparent",
		mat_color = "blue",
		background_color = "#00000000"
	))
	expect_equal(cfg$get_piece_opt("tile_face")$bleed_color, "transparent")

	# edges
	cfg <- pp_cfg(list(
		suit_color = "darkred,black,darkgreen,darkblue,grey",
		edge_color = "darkred,black,darkgreen,darkblue,grey"
	))
	opt <- cfg$get_piece_opt("pawn_top", 1, 1)
	expect_equal(opt$shape, "rect")
	expect_equal(opt$dm_text, "")
	expect_equal(opt$ps_text, "")
	expect_equal(opt$background_color, "darkred")
})

test_that("pp_cfg querying variables work as expected", {
	cfg <- pp_cfg()
	expect_true(cfg$has_piecepack)

	expect_true(cfg$has_pawns)
	expect_true(cfg$has_coins)
	expect_true(cfg$has_tiles)
	expect_true(cfg$has_dice)

	cfg$has_dice <- FALSE
	cfg$has_tiles <- FALSE
	expect_false(cfg$has_tiles)
	expect_false(cfg$has_dice)
	expect_false(cfg$has_piecepack)
	cfg$has_piecepack <- TRUE
	expect_true(cfg$has_tiles)
	expect_true(cfg$has_dice)
	expect_true(cfg$has_piecepack)

	expect_false(cfg$has_saucers)
	expect_false(cfg$has_pyramids)
	expect_false(cfg$has_matchsticks)
	expect_error(cfg$has_piecepack <- 3, "is.logical\\(value)\\ is not TRUE")

	expect_true(cfg$cache_grob)
	cfg$cache_grob <- FALSE
	expect_false(cfg$cache_grob)
	cfg$cache_piece_opt <- FALSE
	expect_false(cfg$cache_piece_opt)
	cfg$cache_piece_opt <- TRUE
	expect_true(cfg$cache_piece_opt)
	cfg$cache_obj_fn <- FALSE
	expect_false(cfg$cache_obj_fn)
	cfg$cache_op_fn <- FALSE
	expect_false(cfg$cache_op_fn)
})

Try the piecepackr package in your browser

Any scripts or data that you put into this service are public.

piecepackr documentation built on May 12, 2026, 9:07 a.m.