😎 Give your xaringan slides some style
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

784 line
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 \pkg{ggplot2} themes to match the xaringanthemer theme used in the
  8. #' \pkg{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 \pkg{ggplot2} xaringanthemer plot theme to seamlessly match the "inverse"
  62. #' \pkg{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 \pkg{ggplot2} to match the \pkg{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. #' \pkg{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 \pkg{ggplot2} geom
  130. #' defaults.
  131. #' @param set_ggplot_defaults Should defaults be set for \pkg{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 \pkg{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. #' @inheritParams theme_xaringan_base
  274. #' @return Invisibly returns a list of the current ggplot2 geom defaults
  275. #' @export
  276. theme_xaringan_set_defaults <- function(
  277. text_color = NULL,
  278. background_color = NULL,
  279. accent_color = text_color,
  280. accent_secondary_color = accent_color,
  281. text_font = NULL
  282. ) {
  283. requires_package("ggplot2")
  284. blend <- color_blender(text_color, background_color)
  285. xaringan_theme_defaults <- list(
  286. "line" = list(color = text_color),
  287. "vline" = list(color = accent_secondary_color),
  288. "hline" = list(color = accent_secondary_color),
  289. "abline" = list(color = accent_secondary_color),
  290. "segment" = list(color = text_color),
  291. "bar" = list(fill = accent_color),
  292. "col" = list(fill = accent_color),
  293. "boxplot" = list(color = text_color),
  294. "contour" = list(color = text_color),
  295. "density" = list(color = text_color,
  296. fill = text_color,
  297. alpha = 0.1),
  298. "dotplot" = list(color = accent_color),
  299. "errorbarh" = list(color = text_color),
  300. "crossbar" = list(color = text_color),
  301. "errorbar" = list(color = text_color),
  302. "linerange" = list(color = text_color),
  303. "pointrange" = list(color = text_color),
  304. "map" = list(color = text_color),
  305. "path" = list(color = text_color),
  306. "line" = list(color = text_color),
  307. "step" = list(color = text_color),
  308. "point" = list(color = accent_color),
  309. "polygon" = list(color = accent_color,
  310. fill = accent_color),
  311. "quantile" = list(color = text_color),
  312. "rug" = list(color = blend(0.5)),
  313. "segment" = list(color = text_color),
  314. "smooth" = list(fill = blend(0.75),
  315. color = accent_secondary_color),
  316. "spoke" = list(color = text_color),
  317. "label" = list(color = text_color,
  318. family = text_font %||% get_theme_font("text")),
  319. "text" = list(color = text_color,
  320. family = text_font %||% get_theme_font("text")),
  321. "rect" = list(fill = text_color),
  322. "tile" = list(fill = text_color),
  323. "violin" = list(fill = text_color),
  324. "sf" = list(color = text_color)
  325. )
  326. geom_names <- purrr::set_names(names(xaringan_theme_defaults))
  327. previous_defaults <- lapply(
  328. geom_names,
  329. function(geom) safely_set_geom(geom, xaringan_theme_defaults[[geom]])
  330. )
  331. if (is.null(xaringanthemer_env$old_ggplot_defaults)) {
  332. xaringanthemer_env$old_ggplot_defaults <- previous_defaults
  333. }
  334. invisible(previous_defaults)
  335. }
  336. #' @describeIn theme_xaringan_set_defaults Restore previous or standard
  337. #' \pkg{ggplot2} _geom_ defaults.
  338. #' @return Invisibly returns a list of the current ggplot2 geom defaults
  339. #' @export
  340. theme_xaringan_restore_defaults <- function() {
  341. requires_package("ggplot2")
  342. requires_xaringanthemer_env()
  343. if (is.null(xaringanthemer_env$old_ggplot_defaults)) {
  344. return(invisible())
  345. }
  346. old_default <- xaringanthemer_env$old_ggplot_defaults
  347. old_default_not_std <- vapply(old_default, function(x) length(x) > 0, logical(1))
  348. old_default <- old_default[old_default_not_std]
  349. restore_default <- utils::modifyList(xaringanthemer_env$std_ggplot_defaults, old_default)
  350. geom_names <- purrr::set_names(names(restore_default))
  351. previous_defaults <- lapply(
  352. geom_names,
  353. function(geom) safely_set_geom(geom, restore_default[[geom]])
  354. )
  355. invisible(previous_defaults)
  356. }
  357. safely_set_geom <- function(geom, new) {
  358. tryCatch(
  359. {
  360. ggplot2::update_geom_defaults(geom, new)
  361. },
  362. error = function(e) invisible(),
  363. warning = function(w) invisible()
  364. )
  365. }
  366. # Color Scales ------------------------------------------------------------
  367. #' Xaringan Themer ggplot2 Scales
  368. #'
  369. #' @description
  370. #'
  371. #' **Lifecycle:** [Experimental](https://www.tidyverse.org/lifecycle/#experimental).
  372. #'
  373. #' Color and fill single-color scales for discrete and continuous values,
  374. #' created using the primary accent color of the xaringanthemer styles.
  375. #'
  376. #' @param ... Arguments passed on to either the \pkg{colorspace} scale
  377. #' functions — one of [colorspace::scale_color_discrete_sequential],
  378. #' [colorspace::scale_color_continuous_sequential],
  379. #' [colorspace::scale_fill_discrete_sequential], or
  380. #' [colorspace::scale_fill_continuous_sequential] — or to
  381. #' [ggplot2::continuous_scale] or [ggplot2::discrete_scale].
  382. #' @param color A color value, in hex, to override the default color. Otherwise,
  383. #' the primary color of the resulting scale is chosen from the xaringanthemer
  384. #' slide styles.
  385. #' @param inverse If `color` is not supplied and `inverse = TRUE`, a primary
  386. #' color is chosen to work well with the inverse slide styles, namely the
  387. #' value of `inverse_header_color`
  388. #' @param direction Direction of the discrete scale. Use values less than 0 to
  389. #' reverse the direction, e.g. `direction = -1`.
  390. #' @inheritParams colorspace::scale_color_continuous_sequential
  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. }