😎 Give your xaringan slides some style
您最多选择25个主题 主题必须以字母或数字开头,可以包含连字符 (-),并且长度不得超过35个字符

947 行
29KB

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