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

919 lines
28KB

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