😎 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.

849 lines
25KB

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