😎 Give your xaringan slides some style
Vous ne pouvez pas sélectionner plus de 25 sujets Les noms de sujets doivent commencer par une lettre ou un nombre, peuvent contenir des tirets ('-') et peuvent comporter jusqu'à 35 caractères.

784 lines
23KB

  1. #' A Plot Theme for ggplot2 by xaringanthemer
  2. #'
  3. #' @description
  4. #'
  5. #' **Lifecycle:** [Experimental](https://www.tidyverse.org/lifecycle/#experimental).
  6. #'
  7. #' Creates [ggplot2] themes to match the xaringanthemer theme used in the
  8. #' [xaringan] slides that seamlessly matches the "normal" slide colors and
  9. #' styles.
  10. #'
  11. #' @param text_color Color for text and foreground, inherits from `text_color`
  12. #' @param background_color Color for background, inherits from
  13. #' `background_color`
  14. #' @param accent_color Color for titles and accents, inherits from
  15. #' `header_color`
  16. #' @param accent_secondary_color Color for secondary accents, inherits from
  17. #' `text_bold_color`
  18. #' @inheritDotParams theme_xaringan_base
  19. #'
  20. #' @examples
  21. #' if (requireNamespace("ggplot2", quietly = TRUE)) {
  22. #' # Set xaringanthemer theme but save to tempfile
  23. #' style_duo_accent(outfile = tempfile())
  24. #'
  25. #' library(ggplot2)
  26. #' ggplot(iris) +
  27. #' aes(Petal.Length, Petal.Width) +
  28. #' geom_point() +
  29. #' theme_xaringan()
  30. #' }
  31. #' @return A ggplot2 theme
  32. #' @family xaringanthemer ggplot2 themes
  33. #' @export
  34. theme_xaringan <- function(
  35. text_color = NULL,
  36. background_color = NULL,
  37. accent_color = NULL,
  38. accent_secondary_color = NULL,
  39. ...
  40. ) {
  41. requires_xaringanthemer_env()
  42. requires_package(fn = "xaringan_theme")
  43. background_color <- background_color %||% xaringanthemer_env$background_color
  44. text_color <- text_color %||% xaringanthemer_env$text_color
  45. accent_color <- accent_color %||% xaringanthemer_env$header_color
  46. accent_secondary_color <- accent_secondary_color %||% xaringanthemer_env$text_bold_color %||% accent_color
  47. theme_xaringan_base(
  48. text_color,
  49. background_color,
  50. accent_color = accent_color,
  51. accent_secondary_color = accent_secondary_color,
  52. ...
  53. )
  54. }
  55. #' An Inverse Plot Theme for ggplot2 by xaringanthemer
  56. #'
  57. #' @description
  58. #'
  59. #' **Lifecycle:** [Experimental](https://www.tidyverse.org/lifecycle/#experimental).
  60. #'
  61. #' A [ggplot2] xaringanthemer plot theme to seamlessly match the "inverse"
  62. #' [xaringan] slide colors and styles as styled by [xaringanthemer].
  63. #'
  64. #' @param text_color Color for text and foreground, inherits from `text_color`
  65. #' @param background_color Color for background, inherits from
  66. #' `background_color`
  67. #' @param accent_color Color for titles and accents, inherits from
  68. #' `header_color`
  69. #' @param accent_secondary_color Color for secondary accents, inherits from
  70. #' `text_bold_color`
  71. #' @inheritDotParams theme_xaringan_base
  72. #'
  73. #' @examples
  74. #' if (requireNamespace("ggplot2", quietly = TRUE)) {
  75. #' # Set xaringanthemer theme but save to tempfile
  76. #' style_duo_accent(outfile = tempfile())
  77. #'
  78. #' library(ggplot2)
  79. #' ggplot(iris) +
  80. #' aes(Petal.Length, Petal.Width) +
  81. #' geom_point() +
  82. #' theme_xaringan()
  83. #' }
  84. #' @return A ggplot2 theme
  85. #' @family xaringanthemer ggplot2 themes
  86. #' @export
  87. theme_xaringan_inverse <- function(
  88. text_color = NULL,
  89. background_color = NULL,
  90. accent_color = NULL,
  91. accent_secondary_color = NULL,
  92. ...
  93. ) {
  94. requires_xaringanthemer_env()
  95. requires_package(fn = "xaringan_theme")
  96. background_color <- background_color %||% xaringanthemer_env$inverse_background_color
  97. text_color <- text_color %||% xaringanthemer_env$inverse_text_color
  98. accent_color <- accent_color %||% xaringanthemer_env$inverse_header_color
  99. accent_secondary_color <- accent_secondary_color %||% accent_color
  100. theme_xaringan_base(
  101. text_color,
  102. background_color,
  103. accent_color = accent_color,
  104. accent_secondary_color = accent_secondary_color,
  105. ...
  106. )
  107. }
  108. #' The ggplot2 xaringanthemer base plot theme
  109. #'
  110. #' @description
  111. #'
  112. #' **Lifecycle:** [Experimental](https://www.tidyverse.org/lifecycle/#experimental).
  113. #'
  114. #' Provides a base plot theme for [ggplot2] to match the [xaringan] slide theme
  115. #' created by [xaringanthemer]. The theme is designed to create a general plot
  116. #' style from two colors, a `background_color` and a `text_color` (or foreground
  117. #' color). Also accepts an `accent_color` and an `accent_secondary_color` that are
  118. #' [xaringanthemer] is not required for the base theme. Use
  119. #' [theme_xaringan()] or [theme_xaringan_inverse()] in xaringan slides styled by
  120. #' xaringanthemer for a plot theme that matches the slide style.
  121. #'
  122. #' @param text_color Color for text and foreground
  123. #' @param background_color Color for background
  124. #' @param accent_color Color for titles and accents, inherits from
  125. #' `header_color` or `text_color`. Used for the `title` base setting in
  126. #' [ggplot2::theme()], and additionally for setting the `color` or `fill` of
  127. #' [ggplot2] geom defaults.
  128. #' @param accent_secondary_color Color for secondary accents, inherits from
  129. #' `text_bold_color` or `accent_color`. Used only when setting [ggplot2] geom
  130. #' defaults.
  131. #' @param set_ggplot_defaults Should defaults be set for [ggplot2] _geoms_?
  132. #' Defaults to TRUE. To restore ggplot's defaults, or the previously set geom
  133. #' defaults, see [theme_xaringan_restore_defaults()].
  134. #' @param text_font Font to use for text elements, passed to
  135. #' [sysfonts::font_add_google()], if available and `text_font_use_google` is
  136. #' `TRUE`. Inherits from `text_font_family`.
  137. #' @param text_font_use_google Is `text_font` available on [Google
  138. #' Fonts](https://fonts.google.com)?
  139. #' @param text_font_size Base text font size, inherits from `text_font_size`, or
  140. #' defaults to 11.
  141. #' @param title_font Font to use for title elements, passed to
  142. #' [sysfonts::font_add_google()], if available and `title_font_use_google` is
  143. #' `TRUE`. Inherits from `title_font_family`.
  144. #' @param title_font_use_google Is `title_font` available on [Google
  145. #' Fonts](https://fonts.google.com)?
  146. #' @param title_font_size Base text font size, inherits from `title_font_size`,
  147. #' or defaults to 14.
  148. #' @param ... Ignored
  149. #'
  150. #' @examples
  151. #' if (requireNamespace("ggplot2", quietly = TRUE)) {
  152. #' library(ggplot2)
  153. #' ggplot(iris) +
  154. #' aes(Petal.Length, Petal.Width) +
  155. #' geom_point() +
  156. #' theme_xaringan_base(
  157. #' text_color = "#e1e5f2",
  158. #' background_color = "#021c25",
  159. #' accent_color = "#1f7a8c",
  160. #' set_ggplot_defaults = TRUE
  161. #' ) +
  162. #' labs(
  163. #' title = "Basic Iris Plot",
  164. #' subtitle = "+ theme_xaringan_base()",
  165. #' caption = "{xaringanthemer}"
  166. #' )
  167. #'
  168. #' ggplot(iris) +
  169. #' aes(Petal.Length, Petal.Width) +
  170. #' geom_point() +
  171. #' theme_xaringan_base(
  172. #' text_color = "#021c25",
  173. #' background_color = "#e1e5f2",
  174. #' accent_color = "#1f7a8c",
  175. #' set_ggplot_defaults = TRUE
  176. #' ) +
  177. #' labs(
  178. #' title = "Basic Iris Plot",
  179. #' subtitle = "+ theme_xaringan_base()",
  180. #' caption = "{xaringanthemer}"
  181. #' )
  182. #' }
  183. #' @return A ggplot2 theme
  184. #' @family xaringanthemer ggplot2 themes
  185. #' @export
  186. theme_xaringan_base <- function(
  187. text_color,
  188. background_color,
  189. ...,
  190. set_ggplot_defaults = TRUE,
  191. accent_color = NULL,
  192. accent_secondary_color = NULL,
  193. text_font = NULL,
  194. text_font_use_google = NULL,
  195. text_font_size = NULL,
  196. title_font = NULL,
  197. title_font_use_google = NULL,
  198. title_font_size = NULL
  199. ) {
  200. blend <- color_blender(text_color, background_color)
  201. text_font_size <- text_font_size %||% web_to_point(xaringanthemer_env$text_font_size, scale = 1.25) %||% 11
  202. title_font_size <- title_font_size %||% web_to_point(xaringanthemer_env$header_h3_font_size, scale = 0.8) %||% 14
  203. text_font <- if (!is.null(text_font)) {
  204. register_font(text_font, identical(text_font_use_google, TRUE))
  205. } else {
  206. get_theme_font("text")
  207. }
  208. title_font <- if (!is.null(title_font)) {
  209. register_font(title_font, identical(title_font_use_google, TRUE))
  210. } else {
  211. get_theme_font("header")
  212. }
  213. text_font %||% "sans"
  214. title_font %||% "sans"
  215. if (set_ggplot_defaults) {
  216. accent_color <- accent_color %||% xaringanthemer_env$header_color %||% text_color
  217. accent_secondary_color <- accent_secondary_color %||% xaringanthemer_env$text_bold_color %||% accent_color
  218. theme_xaringan_set_defaults(text_color, background_color, accent_color, accent_secondary_color)
  219. }
  220. ggplot2::theme(
  221. line = ggplot2::element_line(color = blend(0.2)),
  222. rect = ggplot2::element_rect(fill = background_color),
  223. text = ggplot2::element_text(
  224. color = blend(0.1),
  225. family = text_font,
  226. size = text_font_size
  227. ),
  228. title = ggplot2::element_text(
  229. color = accent_color,
  230. family = title_font,
  231. size = title_font_size
  232. ),
  233. plot.background = ggplot2::element_rect(
  234. fill = background_color,
  235. color = background_color
  236. ),
  237. panel.background = ggplot2::element_rect(
  238. fill = background_color,
  239. color = background_color
  240. ),
  241. panel.grid.major = ggplot2::element_line(
  242. color = blend(0.8),
  243. inherit.blank = TRUE
  244. ),
  245. panel.grid.minor = ggplot2::element_line(
  246. color = blend(0.9),
  247. inherit.blank = TRUE
  248. ),
  249. axis.title = ggplot2::element_text(size = title_font_size * 0.8),
  250. axis.ticks = ggplot2::element_line(color = blend(0.8)),
  251. axis.text = ggplot2::element_text(color = blend(0.4)),
  252. legend.key = ggplot2::element_rect(fill = "transparent", colour = NA),
  253. plot.caption = ggplot2::element_text(
  254. size = text_font_size * 0.8,
  255. color = blend(0.3)
  256. )
  257. )
  258. }
  259. #' Set and Restore ggplot2 geom Defaults
  260. #'
  261. #' @description
  262. #'
  263. #' **Lifecycle:** [Experimental](https://www.tidyverse.org/lifecycle/#experimental).
  264. #'
  265. #' Set [ggplot2] _geom_ defaults to match [theme_xaringan()] with
  266. #' `theme_xaringan_set_defaults()` and restore the standard or previously-set
  267. #' defaults with `theme_xaringan_restore_defaults()`. By default,
  268. #' `theme_xaringan_set_defaults()` is run with [theme_xaringan()] or
  269. #' [theme_xaringan_inverse()].
  270. #'
  271. #' @family xaringanthemer ggplot2 themes
  272. #' @inheritParams theme_xaringan
  273. #' @return Invisibly returns a list of the current ggplot2 geom defaults
  274. #' @export
  275. theme_xaringan_set_defaults <- function(
  276. text_color = NULL,
  277. background_color = NULL,
  278. accent_color = text_color,
  279. accent_secondary_color = accent_color,
  280. text_family = NULL
  281. ) {
  282. requires_package("ggplot2")
  283. blend <- color_blender(text_color, background_color)
  284. xaringan_theme_defaults <- list(
  285. "line" = list(color = text_color),
  286. "vline" = list(color = accent_secondary_color),
  287. "hline" = list(color = accent_secondary_color),
  288. "abline" = list(color = accent_secondary_color),
  289. "segment" = list(color = text_color),
  290. "bar" = list(fill = accent_color),
  291. "col" = list(fill = accent_color),
  292. "boxplot" = list(color = text_color),
  293. "contour" = list(color = text_color),
  294. "density" = list(color = text_color,
  295. fill = text_color,
  296. alpha = 0.1),
  297. "dotplot" = list(color = accent_color),
  298. "errorbarh" = list(color = text_color),
  299. "crossbar" = list(color = text_color),
  300. "errorbar" = list(color = text_color),
  301. "linerange" = list(color = text_color),
  302. "pointrange" = list(color = text_color),
  303. "map" = list(color = text_color),
  304. "path" = list(color = text_color),
  305. "line" = list(color = text_color),
  306. "step" = list(color = text_color),
  307. "point" = list(color = accent_color),
  308. "polygon" = list(color = accent_color,
  309. fill = accent_color),
  310. "quantile" = list(color = text_color),
  311. "rug" = list(color = blend(0.5)),
  312. "segment" = list(color = text_color),
  313. "smooth" = list(fill = blend(0.75),
  314. color = accent_secondary_color),
  315. "spoke" = list(color = text_color),
  316. "label" = list(color = text_color,
  317. family = text_family %||% get_theme_font("text")),
  318. "text" = list(color = text_color,
  319. family = text_family %||% get_theme_font("text")),
  320. "rect" = list(fill = text_color),
  321. "tile" = list(fill = text_color),
  322. "violin" = list(fill = text_color),
  323. "sf" = list(color = text_color)
  324. )
  325. geom_names <- purrr::set_names(names(xaringan_theme_defaults))
  326. previous_defaults <- lapply(
  327. geom_names,
  328. function(geom) safely_set_geom(geom, xaringan_theme_defaults[[geom]])
  329. )
  330. if (is.null(xaringanthemer_env$old_ggplot_defaults)) {
  331. xaringanthemer_env$old_ggplot_defaults <- previous_defaults
  332. }
  333. invisible(previous_defaults)
  334. }
  335. #' @describeIn theme_xaringan_set_defaults Restore previous or standard [ggplot2] _geom_ defaults.
  336. #' @inheritParams theme_xaringan
  337. #' @return Invisibly returns a list of the current ggplot2 geom defaults
  338. #' @export
  339. xaringan_theme_restore_defaults <- function() {
  340. requires_package("ggplot2")
  341. requires_xaringanthemer_env()
  342. if (is.null(xaringanthemer_env$old_ggplot_defaults)) {
  343. return(invisible())
  344. }
  345. old_default <- xaringanthemer_env$old_ggplot_defaults
  346. old_default_not_std <- vapply(old_default, function(x) length(x) > 0, logical(1))
  347. old_default <- old_default[old_default_not_std]
  348. restore_default <- utils::modifyList(xaringanthemer_env$std_ggplot_defaults, old_default)
  349. geom_names <- purrr::set_names(names(restore_default))
  350. previous_defaults <- lapply(
  351. geom_names,
  352. function(geom) safely_set_geom(geom, restore_default[[geom]])
  353. )
  354. invisible(previous_defaults)
  355. }
  356. safely_set_geom <- function(geom, new) {
  357. tryCatch(
  358. {
  359. ggplot2::update_geom_defaults(geom, new)
  360. },
  361. error = function(e) invisible(),
  362. warning = function(w) invisible()
  363. )
  364. }
  365. # Color Scales ------------------------------------------------------------
  366. #' Xaringan Themer ggplot2 Scales
  367. #'
  368. #' @description
  369. #'
  370. #' **Lifecycle:** [Experimental](https://www.tidyverse.org/lifecycle/#experimental).
  371. #'
  372. #' Color and fill single-color scales for discrete and continuous values,
  373. #' created using the primary accent color of the xaringanthemer styles.
  374. #'
  375. #' @param ... Arguments passed on to the appropriate scale function, one of
  376. #' [colorspace::scale_color_discrete_sequential],
  377. #' [colorspace::scale_color_continuous_sequential],
  378. #' [colorspace::scale_fill_discrete_sequential], or
  379. #' [colorspace::scale_fill_continuous_sequential].
  380. #' @param color A color value, in hex, to override the default color. Otherwise,
  381. #' the primary color of the resulting scale is chosen from the xaringanthemer
  382. #' slide styles.
  383. #' @param inverse If `color` is not supplied and `inverse = TRUE`, a primary
  384. #' color is chosen to work well with the inverse slide styles, namely the
  385. #' value of `inverse_header_color`
  386. #' @param direction Direction of the discrete scale. Use values less than 0 to
  387. #' reverse the direction, e.g. `direction = -1`.
  388. #' @inheritParams colorspace::scale_color_continuous_sequential
  389. #' @param ... Additional arguments passed to [ggplot2::continuous_scale()] or
  390. #' [ggplot2:discrete_scale()].
  391. #' @param aes_type The type of aesthetic to which the scale is being applied.
  392. #' One of "color", "colour", or "fill".
  393. #' @name scale_xaringan
  394. NULL
  395. #' @rdname scale_xaringan
  396. #' @export
  397. scale_xaringan_discrete <- function(
  398. aes_type = c("color", "colour", "fill"),
  399. ...,
  400. color = NULL,
  401. direction = 1,
  402. inverse = FALSE
  403. ) {
  404. requires_package("ggplot2", "scale_xaringan_discrete")
  405. aes_type <- match.arg(aes_type)
  406. color <- hex2HCL(get_theme_accent_color(color, inverse))
  407. pal <- function(n) {
  408. colors <- colorspace::sequential_hcl(
  409. n = n,
  410. c1 = color[1, "C"],
  411. l1 = color[1, "L"],
  412. h1 = color[1, "H"],
  413. rev = direction >= 1
  414. )
  415. }
  416. ggplot2::discrete_scale(aes_type, "manual", pal, ...)
  417. }
  418. #' @rdname scale_xaringan
  419. #' @export
  420. scale_xaringan_fill_discrete <- function(
  421. ...,
  422. color = NULL,
  423. direction = 1,
  424. inverse = FALSE
  425. ) {
  426. scale_xaringan_discrete(
  427. "fill",
  428. ...,
  429. color = color,
  430. direction = direction,
  431. inverse = inverse
  432. )
  433. }
  434. #' @rdname scale_xaringan
  435. #' @export
  436. scale_xaringan_color_discrete <- function(
  437. ...,
  438. color = NULL,
  439. direction = 1,
  440. inverse = FALSE
  441. ) {
  442. scale_xaringan_discrete(
  443. "color",
  444. ...,
  445. color = color,
  446. direction = direction,
  447. inverse = inverse
  448. )
  449. }
  450. #' @rdname scale_xaringan
  451. #' @export
  452. scale_xaringan_colour_discrete <- scale_xaringan_color_discrete
  453. #' @rdname scale_xaringan
  454. #' @export
  455. scale_xaringan_continuous <- function(
  456. aes_type = c("color", "colour", "fill"),
  457. ...,
  458. color = NULL,
  459. begin = 0,
  460. end = 1,
  461. inverse = FALSE
  462. ) {
  463. requires_package("ggplot2", "scale_xaringan_continuous")
  464. requires_package("scales", "scale_xaringan_continuous")
  465. aes_type <- match.arg(aes_type)
  466. color <- hex2HCL(get_theme_accent_color(color, inverse))
  467. colors <- colorspace::sequential_hcl(
  468. n = 12,
  469. c1 = color[1, "C"],
  470. l1 = color[1, "L"],
  471. h1 = color[1, "H"],
  472. rev = TRUE
  473. )
  474. rescaler <- function(x, ...) {
  475. scales::rescale(x, to = c(begin, end), from = range(x, na.rm = TRUE))
  476. }
  477. ggplot2::continuous_scale(
  478. aes_type,
  479. "continuous_sequential",
  480. palette = scales::gradient_n_pal(colors, values = NULL),
  481. rescaler = rescaler,
  482. oob = scales::censor,
  483. ...
  484. )
  485. }
  486. #' @rdname scale_xaringan
  487. #' @export
  488. scale_xaringan_fill_continuous <- function(
  489. ...,
  490. color = NULL,
  491. begin = 0,
  492. end = 1,
  493. inverse = FALSE
  494. ) {
  495. scale_xaringan_continuous(
  496. "fill",
  497. ...,
  498. color = color,
  499. begin = begin,
  500. end = end,
  501. inverse = inverse
  502. )
  503. }
  504. #' @rdname scale_xaringan
  505. #' @export
  506. scale_xaringan_color_continuous <- function(
  507. ...,
  508. color = NULL,
  509. begin = 0,
  510. end = 1,
  511. inverse = FALSE
  512. ) {
  513. scale_xaringan_continuous(
  514. "color",
  515. ...,
  516. color = color,
  517. begin = begin,
  518. end = end,
  519. inverse = inverse
  520. )
  521. }
  522. #' @rdname scale_xaringan
  523. #' @export
  524. scale_xaringan_colour_continuous <- scale_xaringan_color_continuous
  525. get_theme_accent_color <- function(color = NULL, inverse = FALSE) {
  526. color <-
  527. if (!inverse) {
  528. color %||%
  529. xaringanthemer_env[["header_color"]] %||%
  530. xaringanthemer_env[["text_color"]]
  531. } else {
  532. color %||% xaringanthemer_env[["inverse_header_color"]]
  533. }
  534. if (is.null(color)) {
  535. stop(
  536. call. = FALSE,
  537. "No color provided and no default available. ",
  538. "Have you forgotten to use a style function to set the xaringan theme?"
  539. )
  540. }
  541. color
  542. }
  543. blend_colors <- function(x, y, alpha = 0.5) {
  544. x <- colorspace::hex2RGB(x)
  545. y <- colorspace::hex2RGB(y)
  546. z <- colorspace::mixcolor(alpha, x, y)
  547. colorspace::hex(z)
  548. }
  549. color_blender <- function(x, y) function(alpha = 0.5) blend_colors(x, y, alpha)
  550. hex2HCL <- function(x) {
  551. colorspace::coords(methods::as(colorspace::hex2RGB(x), "polarLUV"))
  552. }
  553. # Fonts -------------------------------------------------------------------
  554. get_theme_font <- function(element = c("text", "header", "code")) {
  555. element <- match.arg(element)
  556. element_family <- paste0(element, "_font_family")
  557. element_google <- paste0(element, "_font_google")
  558. element_url <- paste0(element, "_font_url")
  559. family <- xaringanthemer_env[[element_family]]
  560. is_google_font <- !is.null(xaringanthemer_env[[element_google]]) ||
  561. grepl("fonts.google", xaringanthemer_env[[element_url]], fixed = TRUE)
  562. register_font(family, google = is_google_font, fn = sys.calls()[[max(1, length(sys.calls()) - 1)]])
  563. }
  564. register_font <- function(
  565. family,
  566. google = TRUE,
  567. fn = sys.calls()[[max(1, length(sys.calls()) - 1)]][[1]],
  568. ...
  569. ) {
  570. if (is.null(family)) {
  571. return(NULL)
  572. }
  573. family <- gsub("['\"]", "", family)
  574. if (!identical(xaringanthemer_env$showtext_auto, TRUE)) {
  575. if (requires_package(pkg = "showtext", fn, required = FALSE)) {
  576. showtext::showtext_auto()
  577. } else {
  578. return(family)
  579. }
  580. xaringanthemer_env$showtext_auto <- TRUE
  581. }
  582. if (!requires_package(pkg = "sysfonts", fn, required = FALSE)) {
  583. return(family)
  584. } else if (!family %in% sysfonts::font_families()) {
  585. is_default_font <- family %in% c(
  586. "Roboto",
  587. "Source Code Pro",
  588. "Yanone Kaffeesatz"
  589. )
  590. if (identical(google, TRUE) || is_default_font) {
  591. tryCatch(
  592. sysfonts::font_add_google(family, ...),
  593. error = function(e) warning(e$message),
  594. warning = function(w) warning(w$message)
  595. )
  596. } else {
  597. warning(paste(
  598. "Please manually register fonts not served by Google Fonts.",
  599. "See `sysfonts::font_add()` for more information."
  600. ))
  601. }
  602. }
  603. family
  604. }
  605. requires_package <- function(pkg = "ggplot2", fn = "", required = TRUE) {
  606. raise <- if (required) stop else warning
  607. if (!requireNamespace(pkg, quietly = TRUE)) {
  608. msg <- paste0(
  609. "`",
  610. pkg,
  611. "` is ",
  612. if (required) "required " else "suggested ",
  613. if (fn != "") paste0("by ", fn, "() ")[1],
  614. "but is not installed."
  615. )
  616. raise(msg, call. = FALSE)
  617. invisible(FALSE)
  618. }
  619. invisible(TRUE)
  620. }
  621. requires_xaringanthemer_env <- function() {
  622. if (!exists("xaringanthemer_env") || is.null(xaringanthemer_env$header_color)) {
  623. stop("Please call a xaringanthemer theme function first.")
  624. }
  625. }
  626. #' Get the Value of xaringanthemer Style Setting
  627. #'
  628. #' A helper function to retrieve the value of style settings as set by a
  629. #' xaringanthemer style function, for use in plotting and other circumstances.
  630. #'
  631. #' @section Style Settings:
  632. #' Style settings used by xaringanthemer include:
  633. #'
  634. #' - `background_color`
  635. #' - `background_image`
  636. #' - `background_position`
  637. #' - `background_size`
  638. #' - `blockquote_left_border_color`
  639. #' - `code_font_family`
  640. #' - `code_font_family_fallback`
  641. #' - `code_font_google`
  642. #' - `code_font_size`
  643. #' - `code_font_url`
  644. #' - `code_highlight_color`
  645. #' - `code_inline_background_color`
  646. #' - `code_inline_color`
  647. #' - `code_inline_font_size`
  648. #' - `extra_css`
  649. #' - `extra_fonts`
  650. #' - `footnote_color`
  651. #' - `footnote_font_size`
  652. #' - `footnote_position_bottom`
  653. #' - `header_background_auto`
  654. #' - `header_background_color`
  655. #' - `header_background_content_padding_top`
  656. #' - `header_background_ignore_classes`
  657. #' - `header_background_padding`
  658. #' - `header_background_text_color`
  659. #' - `header_color`
  660. #' - `header_font_family`
  661. #' - `header_font_google`
  662. #' - `header_font_url`
  663. #' - `header_font_weight`
  664. #' - `header_h1_font_size`
  665. #' - `header_h2_font_size`
  666. #' - `header_h3_font_size`
  667. #' - `inverse_background_color`
  668. #' - `inverse_header_color`
  669. #' - `inverse_text_color`
  670. #' - `inverse_text_shadow`
  671. #' - `left_column_selected_color`
  672. #' - `left_column_subtle_color`
  673. #' - `link_color`
  674. #' - `padding`
  675. #' - `table_border_color`
  676. #' - `table_row_border_color`
  677. #' - `table_row_even_background_color`
  678. #' - `text_bold_color`
  679. #' - `text_color`
  680. #' - `text_font_base`
  681. #' - `text_font_family`
  682. #' - `text_font_family_fallback`
  683. #' - `text_font_google`
  684. #' - `text_font_size`
  685. #' - `text_font_url`
  686. #' - `text_font_weight`
  687. #' - `text_slide_number_color`
  688. #' - `text_slide_number_font_size`
  689. #' - `title_slide_background_color`
  690. #' - `title_slide_background_image`
  691. #' - `title_slide_background_position`
  692. #' - `title_slide_background_size`
  693. #' - `title_slide_text_color`
  694. #'
  695. #' @param setting A xaringanthemer style setting
  696. #' @export
  697. theme_xaringan_get_value <- function(setting) {
  698. requires_xaringanthemer_env()
  699. if (length(setting) > 1) {
  700. xaringanthemer_env[setting]
  701. } else {
  702. xaringanthemer_env[[setting]]
  703. }
  704. }
  705. web_to_point <- function(x, px_per_em = 16, scale = 1) {
  706. if (is.null(x)) {
  707. return(NULL)
  708. }
  709. if (grepl("pt$", x)) {
  710. return(as.numeric(sub("pt$", "", x)))
  711. } else if (grepl("px$", x)) {
  712. x <- as.numeric(sub("px$", "", x))
  713. return(x * 0.75)
  714. } else if (grepl("em$", x)) {
  715. x <- as.numeric(sub("em$", "", x))
  716. return(x * px_per_em * 0.75)
  717. } else {
  718. return()
  719. }
  720. }