## ----hidden, echo = FALSE-----------------------------------------------------
knitr::opts_chunk$set(fig.cap = "", dev = "ragg_png")
## ----hex-logo2, fig.width = 4.5, fig.height = 4.5, fig.alt = "Isometric-cube hex logo", eval = requireNamespace("ggplot2", quietly=TRUE) && requireNamespace("aRtsy", quietly=TRUE) && requireNamespace("gtable", quietly=TRUE), message = FALSE----
library("aRtsy")
library("ggplot2")
gg <- canvas_planet(colorPalette("lava"), threshold = 3) +
scale_x_continuous(expand=c(0, 0)) +
scale_y_continuous(expand=c(0, 0))
grob <- ggplotGrob(gg)
grob <- gtable::gtable_filter(grob, "panel") # grab just the panel
affiner::grid.isocube(top = grob, left = grob, right = grob,
gp_border = grid::gpar(col = "darkorange", lwd = 12))
## ----hex-logo, fig.width = 4.5, fig.height = 4.5, fig.alt = "Isometric-cube hex logo"----
library("affiner")
library("grid")
xy <- as_coord2d(angle(seq(90, 360 + 90, by = 60), "degrees"),
radius = c(rep(0.488, 6), 0))
xy$translate(x = 0.5, y = 0.5)
l_xy <- list()
l_xy$top <- xy[c(1, 2, 7, 6)]
l_xy$right <- xy[c(7, 4, 5, 6)]
l_xy$left <- xy[c(2, 3, 4, 7)]
gp_border <- gpar(fill = NA, col = "black", lwd = 12)
vp_define <- viewport(width = unit(3, "inches"), height = unit(3, "inches"))
colors <- c("#D55E00", "#56B4E9", "#009E73")
spacings <- c(0.25, 0.25, 0.2)
texts <- c("pkgname", "right\nface", "left\nface")
rots <- c(45, 0, 0)
fontsizes <- c(52, 80, 80)
sides <- c("top", "right", "left")
types <- gridpattern::names_polygon_tiling[c(5, 9, 7)]
l_grobs <- list()
grid.newpage()
for (i in 1:3) {
side <- sides[i]
xy_side <- l_xy[[side]]
if (requireNamespace("gridpattern", quietly = TRUE)) {
bg <- gridpattern::grid.pattern_polygon_tiling(
colour = "grey80",
fill = c(colors[i], "white"),
type = types[i],
spacing = spacings[i],
draw = FALSE)
} else {
bg <- rectGrob(gp = gpar(col = NA, fill = colors[i]))
}
text <- textGrob(texts[i], rot = rots[i],
gp = gpar(fontsize = fontsizes[i]))
settings <- affine_settings(xy_side, unit = "snpc")
grob <- l_grobs[[side]] <- grobTree(bg, text)
grid.affine(grob,
vp_define = vp_define,
transform = settings$transform,
vp_use = settings$vp)
grid.polygon(xy_side$x, xy_side$y, gp = gp_border)
}
## ----die-faces, fig.width = 4.0, fig.height = 3.0, fig.alt = "The six die faces"----
library("affiner")
library("grid")
xyz_face <- as_coord3d(x = c(0, 0, 1, 1) - 0.5, y = c(1, 0, 0, 1) - 0.5, z = 0.5)
l_faces <- list() # order faces for our target projections
l_faces$bottom <- xyz_face$clone()$
rotate("z-axis", angle(180, "degrees"))$
rotate("y-axis", angle(180, "degrees"))
l_faces$north <- xyz_face$clone()$
rotate("z-axis", angle(90, "degrees"))$
rotate("x-axis", angle(-90, "degrees"))
l_faces$east <- xyz_face$clone()$
rotate("z-axis", angle(90, "degrees"))$
rotate("y-axis", angle(90, "degrees"))
l_faces$west <- xyz_face$clone()$
rotate("y-axis", angle(-90, "degrees"))
l_faces$south <- xyz_face$clone()$
rotate("z-axis", angle(180, "degrees"))$
rotate("x-axis", angle(90, "degrees"))
l_faces$top <- xyz_face$clone()$
rotate("z-axis", angle(-90, "degrees"))
colors <- c("#D55E00", "#009E73", "#56B4E9", "#E69F00", "#CC79A7", "#0072B2")
spacings <- c(0.25, 0.2, 0.25, 0.25, 0.25, 0.25)
die_face_grob <- function(digit) {
if (requireNamespace("gridpattern", quietly = TRUE)) {
bg <- gridpattern::grid.pattern_polygon_tiling(
colour = "grey80",
fill = c(colors[digit], "white"),
type = gridpattern::names_polygon_tiling[digit],
spacing = spacings[digit],
draw = FALSE)
} else {
bg <- rectGrob(gp = gpar(col = NA, fill = colors[digit]))
}
digit <- textGrob(digit, gp = gpar(fontsize = 72))
grobTree(bg, digit)
}
l_face_grobs <- lapply(1:6, function(i) die_face_grob(i))
grid.newpage()
for (i in 1:6) {
vp <- viewport(x = unit((i - 1) %% 3 + 1, "inches"),
y = unit(3 - ((i - 1) %/% 3 + 1), "inches"),
width = unit(1, "inches"), height = unit(1, "inches"))
pushViewport(vp)
grid.draw(l_face_grobs[[i]])
popViewport()
grid.text("The six die faces", y = 0.9,
gp = gpar(fontsize = 18, face = "bold"))
}
## ----projected-die, fig.width = 3.0, fig.height = 3.0, fig.alt = "Parallel projection of a die"----
# re-order face grobs for our target projections
# bottom = 6, north = 4, east = 5, west = 2, south = 3, top = 1
l_face_grobs <- l_face_grobs[c(6, 4, 5, 2, 3, 1)]
draw_die <- function(l_xy, l_face_grobs) {
min_x <- min(vapply(l_xy, function(x) min(x$x), numeric(1)))
min_y <- min(vapply(l_xy, function(x) min(x$y), numeric(1)))
l_xy <- lapply(l_xy, function(xy) {
xy$translate(x = -min_x + 0.5, y = -min_y + 0.5)
})
grid.newpage()
vp_define <- viewport(width = unit(1, "inches"), height = unit(1, "inches"))
gp_border <- gpar(col = "black", lwd = 4, fill = NA)
for (i in 1:6) {
xy <- l_xy[[i]]
settings <- affine_settings(xy, unit = "inches")
grid.affine(l_face_grobs[[i]],
vp_define = vp_define,
transform = settings$transform,
vp_use = settings$vp)
grid.polygon(xy$x, xy$y, default.units = "inches", gp = gp_border)
}
}
# oblique projection of dice onto xy-plane
l_xy_oblique1 <- lapply(l_faces, function(xyz) {
xyz$clone() |>
as_coord2d(scale = 0.5)
})
draw_die(l_xy_oblique1, l_face_grobs)
grid.text("Oblique projection\n(onto xy-plane)", y = 0.9,
gp = gpar(fontsize = 18, face = "bold"))
# oblique projection of dice on xz-plane
l_xy_oblique2 <- lapply(l_faces, function(xyz) {
xyz$clone()$
permute("xzy") |>
as_coord2d(scale = 0.5, alpha = angle(135, "degrees"))
})
draw_die(l_xy_oblique2, l_face_grobs)
grid.text("Oblique projection\n(onto xz-plane)", y = 0.9,
gp = gpar(fontsize = 18, face = "bold"))
# isometric projection
l_xy_isometric <- lapply(l_faces, function(xyz) {
xyz$clone()$
rotate("z-axis", angle(45, "degrees"))$
rotate("x-axis", angle(-(90 - 35.264), "degrees")) |>
as_coord2d()
})
draw_die(l_xy_isometric, l_face_grobs)
grid.text("Isometric projection", y = 0.9,
gp = gpar(fontsize = 18, face = "bold"))