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)
})
trevorld/piecepackr documentation built on Jan. 4, 2024, 7:27 a.m.