1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
|
# Functions related to working in pkgdown
pkgdown_rdname <- function()
getOption("downlit.rdname", "")
in_pkgdown <- function()
requireNamespace("pkgdown", quietly = TRUE) && pkgdown::in_pkgdown()
in_pkgdown_example <- function()
nchar(pkgdown_rdname()) &&
requireNamespace("downlit", quietly = TRUE) &&
requireNamespace("pkgdown", quietly = TRUE)
fns <- local({
plotnum <- 0
pkgdown_print.rglId <- function(x, visible = TRUE) {
if (inherits(x, "rglHighlevel"))
plotnum <<- plotnum + 1
if (visible) {
scene <- scene3d()
structure(list(plotnum = plotnum,
scene = scene),
class = c("rglRecordedplot", "otherRecordedplot"))
} else
invisible()
}
pkgdown_print.rglOpen3d <- function(x, visible = TRUE) {
plotnum <<- plotnum + 1
invisible(x)
}
list(pkgdown_print.rglId = pkgdown_print.rglId,
pkgdown_print.rglOpen3d = pkgdown_print.rglOpen3d)
})
pkgdown_print.rglId <- fns[["pkgdown_print.rglId"]]
pkgdown_print.rglOpen3d <- fns[["pkgdown_print.rglOpen3d"]]
rm(fns)
globalVariables("fig.asp")
pkgdown_dims <- function() {
settings <- pkgdown::fig_settings()
rgl <- settings$other.parameters$rgl
settings[names(rgl)] <- rgl
numparms <- length(intersect(names(rgl), c("fig.width", "fig.height", "fig.asp")))
if (numparms > 0 && numparms < 3) {
settings <- within(settings, {
if (is.null(rgl$fig.height))
fig.height <- fig.width * fig.asp
if (is.null(rgl$fig.width))
fig.width <- fig.height / fig.asp
})
}
width <- with(settings, dpi*fig.width)
height <- with(settings, dpi*fig.height)
list(width = width, height = height)
}
replay_html.rglRecordedplot <- local({
rdname <- ""
function(x, ...) {
if (pkgdown_rdname() != rdname)
rdname <<- pkgdown_rdname()
settings <- pkgdown_dims()
rendered <- htmltools::renderTags(rglwidget(x$scene,
width = settings$width, height = settings$height))
structure(rendered$html, dependencies = rendered$dependencies)
}
})
pkgdown_info <- local({
info <- NULL
function() {
if (!is.null(info))
return(info)
path <- "."
repeat {
if (file.exists(file.path(path, "DESCRIPTION"))) {
info <<- pkgdown::as_pkgdown(path)
return(info)
}
newpath <- file.path(path, "..")
if (normalizePath(newpath) == normalizePath(path))
return(list())
path <- newpath
}
}
})
register_pkgdown_methods <- local({
registered <- FALSE
function(register = in_pkgdown_example()) {
if (!registered && register) {
registerS3method("replay_html", "rglRecordedplot",
replay_html.rglRecordedplot,
envir = asNamespace("downlit"))
registerS3method("is_low_change", "rglRecordedplot",
is_low_change.rglRecordedplot,
envir = asNamespace("downlit"))
registerS3method("pkgdown_print", "rglId",
pkgdown_print.rglId,
envir = asNamespace("pkgdown"))
registerS3method("pkgdown_print", "rglOpen3d",
pkgdown_print.rglOpen3d,
envir = asNamespace("pkgdown"))
registered <<- TRUE
}
}
})
|
