Nothing
R/utils-d10.R
In piecepackr: Board Game Graphics
Defines functions
write_d10_texture
d10_rank
d10_edge_rank
save_d10_obj
kite_xyz_missing_left
kite_xyz_missing_right
d10_xyz
xy_vp_kite
d10TopGrob
# We'll use the alpha-90-beta-90 angle kites as described in
# "Mathematical Analysis of Trapezohedron with 2n congruent right kite faces" by Harish Chandra Rajpoot
# alpha = to_degrees(2 * atan(sqrt(tanpi(0.2) * tanpi(0.1)))) ~= 51.8272923729877490473
# beta = 180 - alpha ~= 128.1727076270122438473
# a = sqrt(tanpi(0.2) * tanpi(0.1)) * b ~= 0.48586827175664565326 * b := m_b * b
# inner radius = b/2 => die "depth" = b
#
# https://en.wikipedia.org/wiki/Right_kite
# diagonal that is a line of symmetry
# p = sqrt(a^2 + b^2) = sqrt(1 + m_b^2) * b
# p := 5 / 8 = 0.625
# => b = 0.625 / sqrt(1 + m_b^2) ~= 0.5621585749837085810299
# => a = m_b * b ~= 0.2731350152805132047718
# other diagonal
# q = 2ab / sqrt(a^2 + b^2) = (2 * m_b / sqrt(1 + m_b^2)) * b ~= 0.4913446110983896164548
# segments extending from intersection of diagonal to vertices in clockwise order d1, d2, d3, d4 then
# d1 * d3 = d2 * d4 = (p - d3) * d3 = (q / 2) * (q / 2) => d3^2 - p * d3 + q^2 / 4 = 0
# => d3 = (p - sqrt(p^2 - q^2)) / 2 OR d3 = (p + sqrt(p^2 - q^2)) / 2 (latter seems too big!)
# => d3 ~ 0.1193643785156578984719 => d3 / p = 0.1909830056250526320039
# => kite "radius" = 0.5 - d3 / p ~= 0.3090169943749473402406
#
# Other links
# https://rechneronline.de/pi/right-kite.php
# http://www.dicecollector.com/JM/D10.HTM
# https://rpg.stackexchange.com/questions/114672/is-there-a-standard-d10-dimension-ratio
# https://math.stackexchange.com/questions/2464000/pentagonal-trapezohedron-with-face-perpendicular-to-side
# https://www.youtube.com/watch?v=eYO19tYYqXk
# https://www.athenopolis.net/2018/03/the-dimensions-of-ten-sided-die.html
d10TopGrob <- function(
piece_side,
suit,
rank,
cfg = pp_cfg(),
x = unit(0.5, "npc"),
y = unit(0.5, "npc"),
z = unit(0, "npc"),
angle = 0,
type = "normal",
width = NA,
height = NA,
depth = NA,
op_scale = 0,
op_angle = 45
) {
cfg <- as_pp_cfg(cfg)
opt <- cfg$get_piece_opt("die_face", suit, rank)
x <- convertX(x, "in", valueOnly = TRUE)
y <- convertY(y, "in", valueOnly = TRUE)
z <- convertX(z, "in", valueOnly = TRUE)
width <- convertX(width, "in", valueOnly = TRUE)
height <- convertY(height, "in", valueOnly = TRUE)
depth <- convertX(depth, "in", valueOnly = TRUE)
#### allow limited 3D rotation #281
axis_x <- 0
axis_y <- 0
xyz <- d10_xyz(suit, rank, cfg, x, y, z, angle, axis_x, axis_y, width, height, depth)
l_xyz <- list()
dfc <- data.frame(x = numeric(0), y = numeric(0), z = numeric(0))
for (i in 1:10) {
idx <- seq.int(4 * i - 3, length.out = 4)
dfc <- rbind(dfc, as.data.frame(mean(xyz[idx])))
}
dfc$edge <- paste0(
"d10_",
c(
"face",
"left1",
"left2",
"right1",
"right2",
"opposite",
"opposite_left1",
"opposite_left2",
"opposite_right1",
"opposite_right2"
)
)
dfc$rank <- vapply(dfc$edge, d10_edge_rank, numeric(1), rank = rank, USE.NAMES = FALSE)
dfc$idx <- 1:10
dfc <- dfc[
painter_order(as_coord3d(dfc$x, dfc$y, dfc$z), scale = op_scale, alpha = degrees(op_angle)),
]
gl <- gList()
fn_idx <- function(idx) {
switch(idx, 1:4, 5:8, 9:12, 13:16, 17:20, 21:24, 25:28, 29:32, 33:36, 37:40)
}
if (nigh(opt$shape_t, 90)) {
idx_vp <- 1:4
} else if (nigh(opt$shape_t, 0)) {
idx_vp <- c(2:4, 1)
} else if (nigh(opt$shape_t, 180)) {
idx_vp <- c(4, 1:3)
} else if (nigh(opt$shape_t, 270)) {
idx_vp <- c(3:4, 1:2)
}
for (i in 1:nrow(dfc)) {
edge_rank <- dfc$rank[i]
opt <- cfg$get_piece_opt("die_face", suit, edge_rank)
gp <- gpar(col = opt$border_color, lex = opt$border_lex, fill = opt$background_color)
xyz_polygon <- xyz[fn_idx(dfc$idx[i])]
xy_polygon <- as_coord2d(xyz_polygon, alpha = degrees(op_angle), scale = op_scale)
xy_vp <- xy_vp_kite(xyz_polygon, op_scale, op_angle)[idx_vp]
gl[[i]] <- at_ps_grob(
"die_face",
suit,
edge_rank,
cfg,
xy_vp,
xy_polygon,
name = dfc$edge[i]
)
}
# pre-compute grobCoords
coords_xyl <- as.list(convex_hull2d((xy_polygon)))
gTree(
scale = 1,
coords_xyl = coords_xyl,
children = gl,
cl = c("projected_rpg_die", "coords_xyl")
)
}
# Assumes "acute" angle on top (`theta = 90`)
xy_vp_kite <- function(xyz_polygon, op_scale, op_angle) {
p_mid <- mean(xyz_polygon[c(2, 4)])
p_left <- xyz_polygon[2]
p_right <- xyz_polygon[4]
up_diff <- xyz_polygon[1] - p_mid
down_diff <- xyz_polygon[3] - p_mid
p_ul <- p_left + up_diff
p_ur <- p_right + up_diff
p_ll <- p_left + down_diff
p_lr <- p_right + down_diff
x <- c(p_ul$x, p_ll$x, p_lr$x, p_ur$x)
y <- c(p_ul$y, p_ll$y, p_lr$y, p_ur$y)
z <- c(p_ul$z, p_ll$z, p_lr$z, p_ur$z)
as_coord2d(as_coord3d(x, y, z), alpha = degrees(op_angle), scale = op_scale)
}
d10_xyz <- function(suit, rank, cfg, x, y, z, angle, axis_x, axis_y, width, height, depth) {
opt <- cfg$get_piece_opt("die_face", suit, rank)
xy <- kite_xy(r = 0.5 - 0.1909830056250526320039)
if (nigh(opt$shape_t, 90) || nigh(opt$shape_t, 270)) {
xyz_t <- as_coord3d(xy$x, xy$y, 0.0)$translate(as_coord3d(-0.5, -0.5, 0.5))$scale(
width,
height,
depth
)
xyz_b <- as_coord3d(xy$x, xy$y, 0.0)$translate(as_coord3d(-0.5, -0.5, -0.5))$rotate(
"z-axis",
degrees(180)
)$scale(width, height, depth)
} else {
xyz_t <- as_coord3d(xy$x, xy$y, z = 0.0)$translate(as_coord3d(-0.5, -0.5, 0.5))$scale(
height,
width,
depth
)
xyz_b <- as_coord3d(xy$x, xy$y, z = 0.0)$translate(as_coord3d(-0.5, -0.5, -0.5))$rotate(
"z-axis",
degrees(180)
)$scale(height, width, depth)
}
xyz_b <- xyz_b[c(1, 4, 3, 2)]
xyz_l2 <- kite_xyz_missing_right(xyz_t[1], xyz_b[3], xyz_b[2]) # left2 face
xyz_r2 <- kite_xyz_missing_left(xyz_t[1], xyz_b[4], xyz_b[3]) # right2 face
xyz_ol2 <- kite_xyz_missing_right(xyz_b[1], xyz_t[3], xyz_t[2]) # opposite left2 face
xyz_or2 <- kite_xyz_missing_left(xyz_b[1], xyz_t[4], xyz_t[3]) # opposite right2 face
# top face
x_face <- xyz_t$x
y_face <- xyz_t$y
z_face <- xyz_t$z
# left1
x_left1 <- c(xyz_l2$x[c(1, 4)], xyz_ol2$x[4], xyz_t$x[2])
y_left1 <- c(xyz_l2$y[c(1, 4)], xyz_ol2$y[4], xyz_t$y[2])
z_left1 <- c(xyz_l2$z[c(1, 4)], xyz_ol2$z[4], xyz_t$z[2])
# left2
x_left2 <- xyz_l2$x
y_left2 <- xyz_l2$y
z_left2 <- xyz_l2$z
# right1
x_right1 <- c(xyz_t$x[c(1, 4)], xyz_or2$x[2], xyz_r2$x[2])
y_right1 <- c(xyz_t$y[c(1, 4)], xyz_or2$y[2], xyz_r2$y[2])
z_right1 <- c(xyz_t$z[c(1, 4)], xyz_or2$z[2], xyz_r2$z[2])
# right2
x_right2 <- xyz_r2$x
y_right2 <- xyz_r2$y
z_right2 <- xyz_r2$z
# opposite (bottom)
x_opposite <- xyz_b$x
y_opposite <- xyz_b$y
z_opposite <- xyz_b$z
# opposite left1
x_opposite_left1 <- c(xyz_ol2$x[c(1, 4)], xyz_l2$x[4], xyz_b$x[2])
y_opposite_left1 <- c(xyz_ol2$y[c(1, 4)], xyz_l2$y[4], xyz_b$y[2])
z_opposite_left1 <- c(xyz_ol2$z[c(1, 4)], xyz_l2$z[4], xyz_b$z[2])
# opposite left2
x_opposite_left2 <- xyz_ol2$x
y_opposite_left2 <- xyz_ol2$y
z_opposite_left2 <- xyz_ol2$z
# opposite right1
x_opposite_right1 <- c(xyz_b$x[c(1, 4)], xyz_r2$x[2], xyz_or2$x[2])
y_opposite_right1 <- c(xyz_b$y[c(1, 4)], xyz_r2$y[2], xyz_or2$y[2])
z_opposite_right1 <- c(xyz_b$z[c(1, 4)], xyz_r2$z[2], xyz_or2$z[2])
# opposite right2
x_opposite_right2 <- xyz_or2$x
y_opposite_right2 <- xyz_or2$y
z_opposite_right2 <- xyz_or2$z
xs <- c(
x_face,
x_left1,
x_left2,
x_right1,
x_right2,
x_opposite,
x_opposite_left1,
x_opposite_left2,
x_opposite_right1,
x_opposite_right2
)
ys <- c(
y_face,
y_left1,
y_left2,
y_right1,
y_right2,
y_opposite,
y_opposite_left1,
y_opposite_left2,
y_opposite_right1,
y_opposite_right2
)
zs <- c(
z_face,
z_left1,
z_left2,
z_right1,
z_right2,
z_opposite,
z_opposite_left1,
z_opposite_left2,
z_opposite_right1,
z_opposite_right2
)
pc <- as_coord3d(x, y, z)
R <- R_z(opt$shape_t - 90) %*% AA_to_R(angle, axis_x, axis_y)
as_coord3d(xs, ys, zs)$transform(R)$translate(pc)
}
kite_xyz_missing_right <- function(p_top, p_left, p_bottom) {
p_mid <- p_bottom + 0.1909830056250526320039 * (p_top - p_bottom)
p_right <- p_mid + (p_mid - p_left)
as_coord3d(
x = c(p_top$x, p_left$x, p_bottom$x, p_right$x),
y = c(p_top$y, p_left$y, p_bottom$y, p_right$y),
z = c(p_top$z, p_left$z, p_bottom$z, p_right$z)
)
}
kite_xyz_missing_left <- function(p_top, p_bottom, p_right) {
p_mid <- p_bottom + 0.1909830056250526320039 * (p_top - p_bottom)
p_left <- p_mid + (p_mid - p_right)
as_coord3d(
x = c(p_top$x, p_left$x, p_bottom$x, p_right$x),
y = c(p_top$y, p_left$y, p_bottom$y, p_right$y),
z = c(p_top$z, p_left$z, p_bottom$z, p_right$z)
)
}
save_d10_obj <- function(
piece_side,
suit,
rank,
cfg,
x,
y,
z,
angle,
axis_x,
axis_y,
width,
height,
depth,
filename,
scale,
res
) {
cfg <- as_pp_cfg(cfg)
opt <- cfg$get_piece_opt(piece_side, suit, rank)
xyz <- d10_xyz(suit, rank, cfg, x, y, z, angle, axis_x, axis_y, width, height, depth)
xy <- kite_xy(r = 0.5 - 0.1909830056250526320039)
xy_vt <- list(
x = rep(xy$x / 2, 10) + rep(rep(0:1 / 2, each = 4), 5),
y = rep(xy$y / 5, 10) + rep(rep(4:0 / 5, each = 4), each = 2)
)
# textured face elements: face, left1, left2, right1, right2
# opposite, opposite left, opposite right, opposite back
f <- list()
fn_vt <- function(r) switch(r, 1:4, 5:8, 9:12, 13:16, 17:20, 21:24, 25:28, 29:32, 33:36, 37:40)
f[[1]] <- list(v = 1:4, vt = fn_vt(rank))
f[[2]] <- list(v = 5:8, vt = fn_vt(d10_edge_rank("d10_left1", rank)))
f[[3]] <- list(v = 9:12, vt = fn_vt(d10_edge_rank("d10_left2", rank)))
f[[4]] <- list(v = 13:16, vt = fn_vt(d10_edge_rank("d10_right1", rank)))
f[[5]] <- list(v = 17:20, vt = fn_vt(d10_edge_rank("d10_right2", rank)))
f[[6]] <- list(v = 21:24, vt = fn_vt(d10_edge_rank("d10_opposite", rank)))
f[[7]] <- list(v = 25:28, vt = fn_vt(d10_edge_rank("d10_opposite_left1", rank)))
f[[8]] <- list(v = 29:32, vt = fn_vt(d10_edge_rank("d10_opposite_left2", rank)))
f[[9]] <- list(v = 33:36, vt = fn_vt(d10_edge_rank("d10_opposite_right1", rank)))
f[[10]] <- list(v = 37:40, vt = fn_vt(d10_edge_rank("d10_opposite_right2", rank)))
ext <- tools::file_ext(filename)
mtl_filename <- gsub(paste0("\\.", ext, "$"), ".mtl", filename)
png_filename <- gsub(paste0("\\.", ext, "$"), ".png", filename)
write_obj(filename, v = xyz, vt = xy_vt, f = f)
write_d10_texture("die_face", suit, rank, cfg, filename = png_filename, res = res)
invisible(list(obj = filename, mtl = mtl_filename, png = png_filename))
}
d10_edge_rank <- function(edge, rank) {
switch(
edge,
d10_face = rank,
d10_left1 = d10_rank(rank + 2),
d10_left2 = d10_rank(rank + 4),
d10_right1 = d10_rank(rank + 8),
d10_right2 = d10_rank(rank + 6),
d10_opposite = 11 - rank,
d10_opposite_left1 = d10_rank(11 - rank + 2),
d10_opposite_left2 = d10_rank(11 - rank + 4),
d10_opposite_right1 = d10_rank(11 - rank + 8),
d10_opposite_right2 = d10_rank(11 - rank + 6)
)
}
d10_rank <- function(x) {
(x - 1) %% 10 + 1
}
write_d10_texture <- function(
piece_side = "die_face",
suit = 1,
rank = 1,
cfg = pp_cfg(),
...,
filename = tempfile(fileext = ".png"),
res = 72
) {
current_dev <- grDevices::dev.cur()
if (current_dev > 1) {
on.exit(grDevices::dev.set(current_dev), add = TRUE)
}
opt <- cfg$get_piece_opt(piece_side, suit, rank)
height <- cfg$get_height("die_face", suit, rank)
width <- cfg$get_width("die_face", suit, rank)
if (nigh(opt$shape_t, 90) || nigh(opt$shape_t, 270)) {
args <- list(
filename = filename,
height = 5 * height,
width = 2 * width,
units = "in",
res = res,
bg = "transparent"
)
} else {
args <- list(
filename = filename,
height = 5 * width,
width = 2 * height,
units = "in",
res = res,
bg = "transparent"
)
}
angle <- 90 - opt$shape_t
if (capabilities("cairo")) {
args$type <- "cairo"
}
do.call(grDevices::png, args)
xs <- rep(1:2 / 2 - 1 / 4, 5)
ys <- rep(5:1 / 5 - 1 / 10, each = 2)
for (i in 1:10) {
pushViewport(viewport(
x = xs[i],
width = inch(width),
y = ys[i],
height = inch(height),
angle = angle
))
draw_piece_and_bleed("die_face", suit, i, cfg)
popViewport()
}
grDevices::dev.off()
invisible(filename)
}
Try the piecepackr package in your browser
Any scripts or data that you put into this service are public.
piecepackr documentation built on Oct. 23, 2026, 5:07 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Defines functions write_d10_texture d10_rank d10_edge_rank save_d10_obj kite_xyz_missing_left kite_xyz_missing_right d10_xyz xy_vp_kite d10TopGrob
# We'll use the alpha-90-beta-90 angle kites as described in
# "Mathematical Analysis of Trapezohedron with 2n congruent right kite faces" by Harish Chandra Rajpoot
# alpha = to_degrees(2 * atan(sqrt(tanpi(0.2) * tanpi(0.1)))) ~= 51.8272923729877490473
# beta = 180 - alpha ~= 128.1727076270122438473
# a = sqrt(tanpi(0.2) * tanpi(0.1)) * b ~= 0.48586827175664565326 * b := m_b * b
# inner radius = b/2 => die "depth" = b
#
# https://en.wikipedia.org/wiki/Right_kite
# diagonal that is a line of symmetry
# p = sqrt(a^2 + b^2) = sqrt(1 + m_b^2) * b
# p := 5 / 8 = 0.625
# => b = 0.625 / sqrt(1 + m_b^2) ~= 0.5621585749837085810299
# => a = m_b * b ~= 0.2731350152805132047718
# other diagonal
# q = 2ab / sqrt(a^2 + b^2) = (2 * m_b / sqrt(1 + m_b^2)) * b ~= 0.4913446110983896164548
# segments extending from intersection of diagonal to vertices in clockwise order d1, d2, d3, d4 then
# d1 * d3 = d2 * d4 = (p - d3) * d3 = (q / 2) * (q / 2) => d3^2 - p * d3 + q^2 / 4 = 0
# => d3 = (p - sqrt(p^2 - q^2)) / 2 OR d3 = (p + sqrt(p^2 - q^2)) / 2 (latter seems too big!)
# => d3 ~ 0.1193643785156578984719 => d3 / p = 0.1909830056250526320039
# => kite "radius" = 0.5 - d3 / p ~= 0.3090169943749473402406
#
# Other links
# https://rechneronline.de/pi/right-kite.php
# http://www.dicecollector.com/JM/D10.HTM
# https://rpg.stackexchange.com/questions/114672/is-there-a-standard-d10-dimension-ratio
# https://math.stackexchange.com/questions/2464000/pentagonal-trapezohedron-with-face-perpendicular-to-side
# https://www.youtube.com/watch?v=eYO19tYYqXk
# https://www.athenopolis.net/2018/03/the-dimensions-of-ten-sided-die.html
d10TopGrob <- function(
piece_side,
suit,
rank,
cfg = pp_cfg(),
x = unit(0.5, "npc"),
y = unit(0.5, "npc"),
z = unit(0, "npc"),
angle = 0,
type = "normal",
width = NA,
height = NA,
depth = NA,
op_scale = 0,
op_angle = 45
) {
cfg <- as_pp_cfg(cfg)
opt <- cfg$get_piece_opt("die_face", suit, rank)
x <- convertX(x, "in", valueOnly = TRUE)
y <- convertY(y, "in", valueOnly = TRUE)
z <- convertX(z, "in", valueOnly = TRUE)
width <- convertX(width, "in", valueOnly = TRUE)
height <- convertY(height, "in", valueOnly = TRUE)
depth <- convertX(depth, "in", valueOnly = TRUE)
#### allow limited 3D rotation #281
axis_x <- 0
axis_y <- 0
xyz <- d10_xyz(suit, rank, cfg, x, y, z, angle, axis_x, axis_y, width, height, depth)
l_xyz <- list()
dfc <- data.frame(x = numeric(0), y = numeric(0), z = numeric(0))
for (i in 1:10) {
idx <- seq.int(4 * i - 3, length.out = 4)
dfc <- rbind(dfc, as.data.frame(mean(xyz[idx])))
}
dfc$edge <- paste0(
"d10_",
c(
"face",
"left1",
"left2",
"right1",
"right2",
"opposite",
"opposite_left1",
"opposite_left2",
"opposite_right1",
"opposite_right2"
)
)
dfc$rank <- vapply(dfc$edge, d10_edge_rank, numeric(1), rank = rank, USE.NAMES = FALSE)
dfc$idx <- 1:10
dfc <- dfc[
painter_order(as_coord3d(dfc$x, dfc$y, dfc$z), scale = op_scale, alpha = degrees(op_angle)),
]
gl <- gList()
fn_idx <- function(idx) {
switch(idx, 1:4, 5:8, 9:12, 13:16, 17:20, 21:24, 25:28, 29:32, 33:36, 37:40)
}
if (nigh(opt$shape_t, 90)) {
idx_vp <- 1:4
} else if (nigh(opt$shape_t, 0)) {
idx_vp <- c(2:4, 1)
} else if (nigh(opt$shape_t, 180)) {
idx_vp <- c(4, 1:3)
} else if (nigh(opt$shape_t, 270)) {
idx_vp <- c(3:4, 1:2)
}
for (i in 1:nrow(dfc)) {
edge_rank <- dfc$rank[i]
opt <- cfg$get_piece_opt("die_face", suit, edge_rank)
gp <- gpar(col = opt$border_color, lex = opt$border_lex, fill = opt$background_color)
xyz_polygon <- xyz[fn_idx(dfc$idx[i])]
xy_polygon <- as_coord2d(xyz_polygon, alpha = degrees(op_angle), scale = op_scale)
xy_vp <- xy_vp_kite(xyz_polygon, op_scale, op_angle)[idx_vp]
gl[[i]] <- at_ps_grob(
"die_face",
suit,
edge_rank,
cfg,
xy_vp,
xy_polygon,
name = dfc$edge[i]
)
}
# pre-compute grobCoords
coords_xyl <- as.list(convex_hull2d((xy_polygon)))
gTree(
scale = 1,
coords_xyl = coords_xyl,
children = gl,
cl = c("projected_rpg_die", "coords_xyl")
)
}
# Assumes "acute" angle on top (`theta = 90`)
xy_vp_kite <- function(xyz_polygon, op_scale, op_angle) {
p_mid <- mean(xyz_polygon[c(2, 4)])
p_left <- xyz_polygon[2]
p_right <- xyz_polygon[4]
up_diff <- xyz_polygon[1] - p_mid
down_diff <- xyz_polygon[3] - p_mid
p_ul <- p_left + up_diff
p_ur <- p_right + up_diff
p_ll <- p_left + down_diff
p_lr <- p_right + down_diff
x <- c(p_ul$x, p_ll$x, p_lr$x, p_ur$x)
y <- c(p_ul$y, p_ll$y, p_lr$y, p_ur$y)
z <- c(p_ul$z, p_ll$z, p_lr$z, p_ur$z)
as_coord2d(as_coord3d(x, y, z), alpha = degrees(op_angle), scale = op_scale)
}
d10_xyz <- function(suit, rank, cfg, x, y, z, angle, axis_x, axis_y, width, height, depth) {
opt <- cfg$get_piece_opt("die_face", suit, rank)
xy <- kite_xy(r = 0.5 - 0.1909830056250526320039)
if (nigh(opt$shape_t, 90) || nigh(opt$shape_t, 270)) {
xyz_t <- as_coord3d(xy$x, xy$y, 0.0)$translate(as_coord3d(-0.5, -0.5, 0.5))$scale(
width,
height,
depth
)
xyz_b <- as_coord3d(xy$x, xy$y, 0.0)$translate(as_coord3d(-0.5, -0.5, -0.5))$rotate(
"z-axis",
degrees(180)
)$scale(width, height, depth)
} else {
xyz_t <- as_coord3d(xy$x, xy$y, z = 0.0)$translate(as_coord3d(-0.5, -0.5, 0.5))$scale(
height,
width,
depth
)
xyz_b <- as_coord3d(xy$x, xy$y, z = 0.0)$translate(as_coord3d(-0.5, -0.5, -0.5))$rotate(
"z-axis",
degrees(180)
)$scale(height, width, depth)
}
xyz_b <- xyz_b[c(1, 4, 3, 2)]
xyz_l2 <- kite_xyz_missing_right(xyz_t[1], xyz_b[3], xyz_b[2]) # left2 face
xyz_r2 <- kite_xyz_missing_left(xyz_t[1], xyz_b[4], xyz_b[3]) # right2 face
xyz_ol2 <- kite_xyz_missing_right(xyz_b[1], xyz_t[3], xyz_t[2]) # opposite left2 face
xyz_or2 <- kite_xyz_missing_left(xyz_b[1], xyz_t[4], xyz_t[3]) # opposite right2 face
# top face
x_face <- xyz_t$x
y_face <- xyz_t$y
z_face <- xyz_t$z
# left1
x_left1 <- c(xyz_l2$x[c(1, 4)], xyz_ol2$x[4], xyz_t$x[2])
y_left1 <- c(xyz_l2$y[c(1, 4)], xyz_ol2$y[4], xyz_t$y[2])
z_left1 <- c(xyz_l2$z[c(1, 4)], xyz_ol2$z[4], xyz_t$z[2])
# left2
x_left2 <- xyz_l2$x
y_left2 <- xyz_l2$y
z_left2 <- xyz_l2$z
# right1
x_right1 <- c(xyz_t$x[c(1, 4)], xyz_or2$x[2], xyz_r2$x[2])
y_right1 <- c(xyz_t$y[c(1, 4)], xyz_or2$y[2], xyz_r2$y[2])
z_right1 <- c(xyz_t$z[c(1, 4)], xyz_or2$z[2], xyz_r2$z[2])
# right2
x_right2 <- xyz_r2$x
y_right2 <- xyz_r2$y
z_right2 <- xyz_r2$z
# opposite (bottom)
x_opposite <- xyz_b$x
y_opposite <- xyz_b$y
z_opposite <- xyz_b$z
# opposite left1
x_opposite_left1 <- c(xyz_ol2$x[c(1, 4)], xyz_l2$x[4], xyz_b$x[2])
y_opposite_left1 <- c(xyz_ol2$y[c(1, 4)], xyz_l2$y[4], xyz_b$y[2])
z_opposite_left1 <- c(xyz_ol2$z[c(1, 4)], xyz_l2$z[4], xyz_b$z[2])
# opposite left2
x_opposite_left2 <- xyz_ol2$x
y_opposite_left2 <- xyz_ol2$y
z_opposite_left2 <- xyz_ol2$z
# opposite right1
x_opposite_right1 <- c(xyz_b$x[c(1, 4)], xyz_r2$x[2], xyz_or2$x[2])
y_opposite_right1 <- c(xyz_b$y[c(1, 4)], xyz_r2$y[2], xyz_or2$y[2])
z_opposite_right1 <- c(xyz_b$z[c(1, 4)], xyz_r2$z[2], xyz_or2$z[2])
# opposite right2
x_opposite_right2 <- xyz_or2$x
y_opposite_right2 <- xyz_or2$y
z_opposite_right2 <- xyz_or2$z
xs <- c(
x_face,
x_left1,
x_left2,
x_right1,
x_right2,
x_opposite,
x_opposite_left1,
x_opposite_left2,
x_opposite_right1,
x_opposite_right2
)
ys <- c(
y_face,
y_left1,
y_left2,
y_right1,
y_right2,
y_opposite,
y_opposite_left1,
y_opposite_left2,
y_opposite_right1,
y_opposite_right2
)
zs <- c(
z_face,
z_left1,
z_left2,
z_right1,
z_right2,
z_opposite,
z_opposite_left1,
z_opposite_left2,
z_opposite_right1,
z_opposite_right2
)
pc <- as_coord3d(x, y, z)
R <- R_z(opt$shape_t - 90) %*% AA_to_R(angle, axis_x, axis_y)
as_coord3d(xs, ys, zs)$transform(R)$translate(pc)
}
kite_xyz_missing_right <- function(p_top, p_left, p_bottom) {
p_mid <- p_bottom + 0.1909830056250526320039 * (p_top - p_bottom)
p_right <- p_mid + (p_mid - p_left)
as_coord3d(
x = c(p_top$x, p_left$x, p_bottom$x, p_right$x),
y = c(p_top$y, p_left$y, p_bottom$y, p_right$y),
z = c(p_top$z, p_left$z, p_bottom$z, p_right$z)
)
}
kite_xyz_missing_left <- function(p_top, p_bottom, p_right) {
p_mid <- p_bottom + 0.1909830056250526320039 * (p_top - p_bottom)
p_left <- p_mid + (p_mid - p_right)
as_coord3d(
x = c(p_top$x, p_left$x, p_bottom$x, p_right$x),
y = c(p_top$y, p_left$y, p_bottom$y, p_right$y),
z = c(p_top$z, p_left$z, p_bottom$z, p_right$z)
)
}
save_d10_obj <- function(
piece_side,
suit,
rank,
cfg,
x,
y,
z,
angle,
axis_x,
axis_y,
width,
height,
depth,
filename,
scale,
res
) {
cfg <- as_pp_cfg(cfg)
opt <- cfg$get_piece_opt(piece_side, suit, rank)
xyz <- d10_xyz(suit, rank, cfg, x, y, z, angle, axis_x, axis_y, width, height, depth)
xy <- kite_xy(r = 0.5 - 0.1909830056250526320039)
xy_vt <- list(
x = rep(xy$x / 2, 10) + rep(rep(0:1 / 2, each = 4), 5),
y = rep(xy$y / 5, 10) + rep(rep(4:0 / 5, each = 4), each = 2)
)
# textured face elements: face, left1, left2, right1, right2
# opposite, opposite left, opposite right, opposite back
f <- list()
fn_vt <- function(r) switch(r, 1:4, 5:8, 9:12, 13:16, 17:20, 21:24, 25:28, 29:32, 33:36, 37:40)
f[[1]] <- list(v = 1:4, vt = fn_vt(rank))
f[[2]] <- list(v = 5:8, vt = fn_vt(d10_edge_rank("d10_left1", rank)))
f[[3]] <- list(v = 9:12, vt = fn_vt(d10_edge_rank("d10_left2", rank)))
f[[4]] <- list(v = 13:16, vt = fn_vt(d10_edge_rank("d10_right1", rank)))
f[[5]] <- list(v = 17:20, vt = fn_vt(d10_edge_rank("d10_right2", rank)))
f[[6]] <- list(v = 21:24, vt = fn_vt(d10_edge_rank("d10_opposite", rank)))
f[[7]] <- list(v = 25:28, vt = fn_vt(d10_edge_rank("d10_opposite_left1", rank)))
f[[8]] <- list(v = 29:32, vt = fn_vt(d10_edge_rank("d10_opposite_left2", rank)))
f[[9]] <- list(v = 33:36, vt = fn_vt(d10_edge_rank("d10_opposite_right1", rank)))
f[[10]] <- list(v = 37:40, vt = fn_vt(d10_edge_rank("d10_opposite_right2", rank)))
ext <- tools::file_ext(filename)
mtl_filename <- gsub(paste0("\\.", ext, "$"), ".mtl", filename)
png_filename <- gsub(paste0("\\.", ext, "$"), ".png", filename)
write_obj(filename, v = xyz, vt = xy_vt, f = f)
write_d10_texture("die_face", suit, rank, cfg, filename = png_filename, res = res)
invisible(list(obj = filename, mtl = mtl_filename, png = png_filename))
}
d10_edge_rank <- function(edge, rank) {
switch(
edge,
d10_face = rank,
d10_left1 = d10_rank(rank + 2),
d10_left2 = d10_rank(rank + 4),
d10_right1 = d10_rank(rank + 8),
d10_right2 = d10_rank(rank + 6),
d10_opposite = 11 - rank,
d10_opposite_left1 = d10_rank(11 - rank + 2),
d10_opposite_left2 = d10_rank(11 - rank + 4),
d10_opposite_right1 = d10_rank(11 - rank + 8),
d10_opposite_right2 = d10_rank(11 - rank + 6)
)
}
d10_rank <- function(x) {
(x - 1) %% 10 + 1
}
write_d10_texture <- function(
piece_side = "die_face",
suit = 1,
rank = 1,
cfg = pp_cfg(),
...,
filename = tempfile(fileext = ".png"),
res = 72
) {
current_dev <- grDevices::dev.cur()
if (current_dev > 1) {
on.exit(grDevices::dev.set(current_dev), add = TRUE)
}
opt <- cfg$get_piece_opt(piece_side, suit, rank)
height <- cfg$get_height("die_face", suit, rank)
width <- cfg$get_width("die_face", suit, rank)
if (nigh(opt$shape_t, 90) || nigh(opt$shape_t, 270)) {
args <- list(
filename = filename,
height = 5 * height,
width = 2 * width,
units = "in",
res = res,
bg = "transparent"
)
} else {
args <- list(
filename = filename,
height = 5 * width,
width = 2 * height,
units = "in",
res = res,
bg = "transparent"
)
}
angle <- 90 - opt$shape_t
if (capabilities("cairo")) {
args$type <- "cairo"
}
do.call(grDevices::png, args)
xs <- rep(1:2 / 2 - 1 / 4, 5)
ys <- rep(5:1 / 5 - 1 / 10, each = 2)
for (i in 1:10) {
pushViewport(viewport(
x = xs[i],
width = inch(width),
y = ys[i],
height = inch(height),
angle = angle
))
draw_piece_and_bleed("die_face", suit, i, cfg)
popViewport()
}
grDevices::dev.off()
invisible(filename)
}
Try the piecepackr package in your browser
Any scripts or data that you put into this service are public.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.