/
utils_css.R
150 lines (144 loc) · 4.55 KB
/
utils_css.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
#' CSS creation helper
#'
#' It allows specifying individual styles for various SVG elements.
#'
#' @param css The generic css style
#' @param text Override style for text elements (svg:text)
#' @param point Override style for point elements (svg:circle)
#' @param line Override style for line elements (svg:line, svg:polyline)
#' @param area Override style for area elements (svg:rect, svg:polygon, svg:path)
#' @param image Override style for image elements (svg:image)
#'
#' @return css as scalar character
#' @seealso [girafe_css_bicolor()], [girafe()]
#' @examples
#' library(ggiraph)
#'
#' girafe_css(
#' css = "fill:orange;stroke:gray;",
#' text = "stroke:none; font-size: larger",
#' line = "fill:none",
#' area = "stroke-width:3px",
#' point = "stroke-width:3px",
#' image = "outline:2px red"
#' )
#' @export
girafe_css <- function(css,
text = NULL,
point = NULL,
line = NULL,
area = NULL,
image = NULL) {
css <- c(
paste0("/*GIRAFE CSS*/", validate_css(css, "css")),
validate_css(text, "text", "text"),
validate_css(point, "point", "circle"),
validate_css(line, "line", c("line", "polyline")),
validate_css(area, "area", c("rect", "polygon", "path")),
validate_css(image, "image", "image")
)
paste(css[nzchar(css)], collapse = "\n")
}
#' @export
#' @title Helper for a 'girafe' css string
#'
#' @description It allows the creation of a css set of individual
#' styles for animation of 'girafe' elements. The used model is
#' based on a simple pattern that works *most of the time* for
#' girafe hover effects and selection effects.
#'
#' It sets properties based on a primary and a secondary color.
#'
#' @param primary,secondary colors used to define animations of
#' fill and stroke properties with text, lines, areas, points
#' and images in 'girafe' outputs.
#' @examples
#' library(ggplot2)
#' library(ggiraph)
#'
#' dat <- mtcars
#' dat$id <- "id"
#' dat$label <- "a line"
#' dat <- dat[order(dat$wt), ]
#'
#' p <- ggplot(
#' data = dat,
#' mapping = aes(
#' x = wt, y = mpg, data_id = id, tooltip = label)) +
#' geom_line_interactive(color = "white", size = .75,
#' hover_nearest = TRUE) +
#' theme_dark() +
#' theme(plot.background = element_rect(fill="black"),
#' panel.background = element_rect(fill="black"),
#' text = element_text(colour = "white"),
#' axis.text = element_text(colour = "white")
#' )
#'
#' x <- girafe(
#' ggobj = p,
#' options = list(
#' opts_hover(
#' css = girafe_css_bicolor(
#' primary = "yellow", secondary = "black"))
#' ))
#' if (interactive()) print(x)
#' @seealso [girafe_css()], [girafe()]
girafe_css_bicolor <- function(primary = "orange", secondary = "gray"){
girafe_css(
css = sprintf("fill:%s;stroke:%s;cursor:pointer;", primary, secondary),
text = sprintf("stroke:none;fill:%s;", primary),
line = sprintf("fill:none;stroke:%s;", primary),
area = sprintf("fill:%s;stroke:none;", primary),
point = sprintf("fill:%s;stroke:%s;", primary, secondary),
image = sprintf("stroke:%s;", primary)
)
}
#' Helper to check girafe_css argument
#' @noRd
#' @importFrom rlang is_scalar_character
validate_css <- function(css,
name,
tag = NULL) {
if (is.null(css) || any(is.na(css)))
css <- ""
if (!is_string(css))
abort(paste0("Argument `", name, "` must be a scalar character"), call = NULL)
css <- trimws(css)
if (nchar(css) > 0) {
tag <- paste0(tag, "._CLASSNAME_", collapse = ", ")
css <- paste(tag, "{", css, "}")
}
css
}
#' Helper to check css argument, given in other functions
#' @noRd
#' @importFrom rlang is_scalar_character
check_css <- function(css,
default,
cls_prefix,
name = cls_prefix,
canvas_id = "SVGID_",
filter = NULL) {
if (is.null(css)) {
css <- default
} else if (!is_string(css)) {
abort(name, ": css must be a scalar character", call = NULL)
}
pattern = "\\/\\*GIRAFE CSS\\*\\/"
if (!grepl(pattern, css)) {
css <- girafe_css(css)
}
css <- gsub("_CLASSNAME_", paste0(cls_prefix, canvas_id, filter), css)
css <- gsub(pattern, "", css)
css
}
#' Helper to check css interactive parameter (vectorized)
#' @noRd
check_css_attr <- function(css) {
pattern = "\\/\\*GIRAFE CSS\\*\\/"
unlist(lapply(css, function(x) {
if (!grepl(pattern, x))
x <- girafe_css(x)
gsub(pattern, "", x)
}))
}