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

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