1library(unitizer)
2library(fansi)
3
4unitizer_sect('colors', {
5  style <- "width: 16px; height: 16px; display: inline-block;"
6  span <- '<span style="background-color: %s; %s"></span>'
7
8  colors.8 <- fansi:::esc_color_code_to_html(rbind(c(0:7), 0L, 0L, 0L, 0L))
9  colors.8
10
11  # error
12  fansi:::esc_color_code_to_html(matrix(c(9L, 0L, 0L, 0L, 0L)))
13
14  colors.255 <- fansi:::esc_color_code_to_html(rbind(8L, 5L, 0:255, 0L, 0L))
15  colors.255
16
17  # Small sampling of tru color colors
18
19  vals <- c(0L, 127L, 255L)
20  colors.tru <- fansi:::esc_color_code_to_html(
21    do.call(rbind, c(list(8L, 2L), expand.grid(vals, vals, vals)))
22  )
23  colors.tru
24
25  # ## The following is some code to display all the colors in an HTML page for
26  # ## review
27
28  # cells.8 <- sprintf(span, colors.8, style)
29
30  # cells.255 <- sprintf(span, colors.255, style)
31  # cells.255.color <- sapply(
32  #   split(head(tail(cells.255, -16), 216), rep(1:6, each=36)),
33  #   function(x) sprintf('<div>%s</div>', paste0(x, collapse=""))
34  # )
35
36  # vals <- as.integer(255 / 15 * 0:15)
37  # vals.tru.raw <- expand.grid(vals, vals, vals)
38  # vals.tru.raw <- vals.tru.raw[with(vals.tru.raw, order(Var1, Var2, Var3)),]
39  # vals.tru.mx <- do.call(rbind, c(list(8L, 2L), vals.tru.raw))
40  # colors.tru <- fansi:::esc_color_code_to_html(vals.tru.mx)
41  # cells.tru <- sprintf(span, colors.tru, style)
42
43  # cells.tru.rows <- sapply(
44  #   split(cells.tru, rep(1:64, each=64)),
45  #   function(x) sprintf('<div>%s</div>', paste0(x, collapse=""))
46  # )
47  # tmp <- tempfile()
48  # writeLines(
49  #   c(
50  #     '<html>',
51  #     '<h3>8 colors</h3>',
52  #     '<div>', paste0(cells.8, collapse=""), '</div>',
53  #     '<h3>255 colors</h3>',
54  #     '<div>', paste0(cells.255[1:16], collapse=""), '</div>',
55  #     cells.255.color,
56  #     '<div>', paste0(cells.255[(256-23):256], collapse=""), '</div>',
57  #     '<h3>True Color</h3>',
58  #     cells.tru.rows,
59  #     '</html>'
60  #   ),
61  #   tmp
62  # )
63  # browseURL(tmp)
64})
65unitizer_sect("simple html conversion", {
66  as_html_page <- function(x) {
67    # note this will clutter temp directory, but needed so we can examine source
68    tmp <- tempfile()
69    writeLines(c("<html><pre>", as.character(x), "</pre></html>"), tmp)
70    browseURL(tmp)
71  }
72  sgr_to_html("hello \033[31;42;1mworld\033[0m")
73  sgr_to_html("hello \033[31;48;5;23;1mworld\033[m")
74
75  # this turned out to be a good corner case, italic is not actually
76  # italicized
77
78  sgr_to_html(
79    "\033[1mbold\033[22m \033[2mfaint\033[22m \033[mitalic\033[24m\n"
80  )
81  # similarly, we mistakenly seem to have thought below that 24 turns off
82  # italic, when it actually doesn't.
83
84  csi_string <- c(
85    "\033[1mbold\033[22m \033[2mfaint\033[22m \033[3mitalic\033[24m",
86    "\033[4munderline\033[24m \033[5mslow-blink\033[25m",
87    "\033[6mfast-blink\033[25m",
88    "\033[31;42mred-fg-green-bg\033[7minverse \033[7minverse-off\033[39;49m",
89    "\033[8mconceal\033[28m reveal \033[9mcrossed-out\033[29mclear\033[m",
90    "\033[1;41mbold\033[22m \033[2;42mfaint\033[22m \033[3;43mitalic\033[23m",
91    "\033[4;44munderline\033[24m \033[5;45mslow-blink\033[25m",
92    "\033[6;46mfast-blink\033[25m",
93    "\033[31;42mred-fg-green-bg\033[7minverse \033[7minverse-off\033[39;49m",
94    "\033[8mconceal\033[28m reveal \033[9mcrossed-out\033[29mclear\033[m",
95    "\033[3mitalic again\033[24m not italic?\033[m"
96  )
97  html_string <- sgr_to_html(csi_string)
98  html_string
99  # tmp <- tempfile()
100  # writeLines(c("<html><pre>", html_string, "</pre></html>"))
101})
102unitizer_sect("Bright Colors", {
103  sgr_to_html("hello\033[94;101m world\033[39m yow\033[49mza")
104  # oob color (!98 %in% 90:97)
105  sgr_to_html("hello\033[98;101m world\033[39m yow\033[49mza")
106})
107unitizer_sect("Corner cases", {
108  sgr_to_html("hello\033[0m")
109  sgr_to_html("hello\033[31m")
110
111  # A string that shrinks; multiple repeated SGRs reduced to a single span
112  sgrs <- paste0(rep("\033[31m", 20), collapse="")
113  sgr_to_html(sprintf("%shello world\033[m", sgrs))
114
115  # non character inputs
116  sgr_to_html(1:3)
117
118  # Sequential escape sequences
119  sgr_to_html("\033[31mhello\033[m\033[42m world\033[m")
120
121  # Sequences in various spots
122
123  sgr_to_html("\033[33mhello")
124  sgr_to_html("he\033[33mllo")
125  sgr_to_html("hello\033[33m")
126
127  sgr_to_html(c("\033[33mhello", "world"))
128  sgr_to_html(c("\033[33mhello", "\033[44mworld"))
129  sgr_to_html(c("\033[33mhello", "wor\033[44mld"))
130  sgr_to_html(c("\033[33mhello", "world\033[44m"))
131  sgr_to_html(c("he\033[33mllo", "world"))
132  sgr_to_html(c("he\033[33mllo", "\033[44mworld"))
133  sgr_to_html(c("he\033[33mllo", "wor\033[44mld"))
134  sgr_to_html(c("he\033[33mllo", "world\033[44m"))
135  sgr_to_html(c("hello\033[33m", "world"))
136  sgr_to_html(c("hello\033[33m", "\033[44mworld"))
137  sgr_to_html(c("hello\033[33m", "wor\033[44mld"))
138  sgr_to_html(c("hello\033[33m", "world\033[44m"))
139})
140unitizer_sect("Bad inputs", {
141  fansi:::esc_color_code_to_html(matrix(1:12, 4))
142
143  sgr_to_html(1:3)
144  sgr_to_html("a", warn=1:3)
145  sgr_to_html("a", term.cap=1:3)
146  sgr_to_html("a", term.cap="hello")
147})
148unitizer_sect("issue54", {
149  string <- c("\033[31m", "\033[39m")
150  fansi::sgr_to_html(string)
151
152  string1 <- c("\033[31mhello", "world\033[39m moon")
153  fansi::sgr_to_html(string1)
154
155  string2 <- c("\033[3mhello\033[24m", "world\033[23m moon")
156  fansi::sgr_to_html(string2)
157})
158unitizer_sect("Colors as classes (#65)", {
159  sgr_to_html("\033[94mhello\033[31;42;1mworld\033[m", classes=TRUE)
160
161  class.8 <-
162    do.call(paste, c(expand.grid(c("fg", "bg"), 0:7), sep="-"))
163  class.16 <-
164    do.call(paste, c(expand.grid(c("fg", "bg"), 0:15), sep="-"))
165  class.256 <-
166    do.call(paste, c(expand.grid(c("fg", "bg"), 0:255), sep="-"))
167
168  x <- c(
169    "\033[94mhe\033[107mllo\033[31;42;1mworld\033[m",
170    "\033[48;5;11;38;5;70mgood\033[7mbye\033[39;49m super \033[48;2;235;0;20mmoon\033[m",
171    NULL
172  )
173  term.cap <- c('bright', '256', 'truecolor')
174  sgr_to_html(x, classes=class.8, term.cap=term.cap)
175  sgr_to_html(x, classes=class.16, term.cap=term.cap)
176  sgr_to_html(x, classes=class.256, term.cap=term.cap)
177
178  make_styles(class.8)
179  make_styles(class.8, matrix(c(0,1,0,0,0,1,1,0,0), 3)) # shift channels
180
181  # in_html(sgr_to_html(sgr_256()))
182  sgr_to_html(sgr_256())
183  # in_html(sgr_to_html(sgr_256(), classes=make_styles(class.256)))
184  sgr_to_html(sgr_256(), classes=class.256)
185
186  # errors
187  sgr_to_html("\033[31mhello\033[31m", classes=NULL)
188  sgr_to_html("\033[31mhello\033[31m", classes=character(7L))
189  sgr_to_html("\033[31mhello\033[31m", classes=rep(NA_character_, 16))
190  sgr_to_html("\033[31mhello\033[31m", classes=rep("bad class", 16))
191
192  make_styles(class.8, c(1,1,0,0,0,1,1,0,0))
193  make_styles(class.8, matrix(c(0,1,0,0,0,1,1,0,NA), 3))
194  make_styles(class.8, "hello")
195  make_styles(letters, matrix(c(0,1,0,0,0,1,1,0,0), 3))
196  make_styles(NULL)
197
198  ## see examples for visual testing
199})
200unitizer_sect("helpers", {
201  html <- sgr_to_html("\033[42mHello")
202  f <- in_html(html, css="span {background-color: #CCC;}", display=FALSE)
203  readLines(f)
204  unlink(f)
205  in_html(html, css="span {background-color: #CCC;}", display=FALSE, clean=TRUE)
206})
207