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

893 lines
27KB

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