1 2## This is how the RDS file is created: 3 4' 5json <- "https://raw.githubusercontent.com/sindresorhus/cli-spinners/dac4fc6571059bb9e9bc204711e9dfe8f72e5c6f/spinners.json" 6parsed <- jsonlite::fromJSON(json, simplifyVector = TRUE) 7pasis <- lapply(parsed, function(x) { x$frames <- I(x$frames); x }) 8pdt <- as.data.frame(do.call(rbind, pasis)) 9pdt$name <- rownames(pdt) 10rownames(pdt) <- NULL 11spinners <- pdt[, c("name", "interval", "frames")] 12usethis::use_data(spinners, internal = TRUE) 13' 14 15#' Character vector to put a spinner on the screen 16#' 17#' `cli` contains many different spinners, you choose one according to your 18#' taste. 19#' 20#' ```{asciicast get-spinner, R.options = list(asciicast_at = NULL)} 21#' options(cli.spinner = "hearts") 22#' fun <- function() { 23#' cli_progress_bar("Spinning") 24#' for (i in 1:100) { 25#' Sys.sleep(4/100) 26#' cli_progress_update() 27#' } 28#' } 29#' fun() 30#' options(cli.spinner = NULL) 31#' ``` 32#' 33#' @param which The name of the chosen spinner. If `NULL`, then the default 34#' is used, which can be customized via the `cli.spinner_unicode`, 35#' `cli.spinner_ascii` and `cli.spinner` options. (The latter applies to 36#' both Unicode and ASCII displays. These options can be set to the name 37#' of a built-in spinner, or to a list that has an entry called `frames`, 38#' a character vector of frames. 39#' @return A list with entries: `name`, `interval`: the suggested update 40#' interval in milliseconds and `frames`: the character vector of the 41#' spinner's frames. 42#' 43#' @family spinners 44#' @export 45 46get_spinner <- function(which = NULL) { 47 stopifnot(is.null(which) || is_string(which) || is.list(which)) 48 49 if (is.null(which)) { 50 if (is_utf8_output()) { 51 which <- 52 getOption("cli.spinner_unicode") %||% 53 getOption("cli.spinner") %||% 54 "dots" 55 } else { 56 which <- 57 getOption("cli.spinner_ascii") %||% 58 getOption("cli.spinner") %||% 59 "line" 60 } 61 } 62 63 if (is.character(which)) { 64 row <- match(which, spinners$name) 65 which <- list( 66 name = which, 67 interval = spinners$interval[[row]], 68 frames = spinners$frames[[row]]) 69 } 70 71 if (!is.character(which$frames)) { 72 stop("Spinner frames must be a character vector") 73 } 74 75 which$name <- which$name %||% NA_character_ 76 which$interval <- which$interval %||% 100L 77 78 which 79} 80 81#' List all available spinners 82#' 83#' @return Character vector of all available spinner names. 84#' 85#' @family spinners 86#' @export 87#' @examples 88#' list_spinners() 89#' get_spinner(list_spinners()[1]) 90 91list_spinners <- function() { 92 spinners$name 93} 94 95#' Create a spinner 96#' 97#' @param template A template string, that will contain the spinner. The 98#' spinner itself will be substituted for `{spin}`. See example below. 99#' @param stream The stream to use for the spinner. Typically this is 100#' standard error, or maybe the standard output stream. 101#' It can also be a string, one of `"auto"`, `"message"`, `"stdout"`, 102#' `"stderr"`. `"auto"` will select `stdout()` if the session is 103#' interactive and there are no sinks, otherwise it will select 104#' `stderr()`. 105#' @param static What to do if the terminal does not support dynamic 106#' displays: 107#' * `"dots"`: show a dot for each `$spin()` call. 108#' * `"print"`: just print the frames of the spinner, one after another. 109#' * `"print_line"`: print the frames of the spinner, each on its own line. 110#' * `"silent"` do not print anything, just the `template`. 111#' @inheritParams get_spinner 112#' @return A `cli_spinner` object, which is a list of functions. See 113#' its methods below. 114#' 115#' `cli_spinner` methods: 116#' * `$spin()`: output the next frame of the spinner. 117#' * `$finish()`: terminate the spinner. Depending on terminal capabilities 118#' this removes the spinner from the screen. Spinners can be reused, 119#' you can start calling the `$spin()` method again. 120#' 121#' All methods return the spinner object itself, invisibly. 122#' 123#' The spinner is automatically throttled to its ideal update frequency. 124#' 125#' @section Examples: 126#' 127#' ## Default spinner 128#' 129#' ```{asciicast make-spinner-default, R.options = list(asciicast_at = NULL)} 130#' sp1 <- make_spinner() 131#' fun_with_spinner <- function() { 132#' lapply(1:100, function(x) { sp1$spin(); Sys.sleep(0.05) }) 133#' sp1$finish() 134#' } 135#' ansi_with_hidden_cursor(fun_with_spinner()) 136#' ``` 137#' 138#' ## Spinner with a template 139#' 140#' ```{asciicast make-spinner-template, R.options = list(asciicast_at = NULL)} 141#' sp2 <- make_spinner(template = "Computing {spin}") 142#' fun_with_spinner2 <- function() { 143#' lapply(1:100, function(x) { sp2$spin(); Sys.sleep(0.05) }) 144#' sp2$finish() 145#' } 146#' ansi_with_hidden_cursor(fun_with_spinner2()) 147#' ``` 148#' 149#' ## Custom spinner 150#' 151#' ```{asciicast make-spinner-custom, R.options = list(asciicast_at = NULL)} 152#' sp3 <- make_spinner("simpleDotsScrolling", template = "Downloading {spin}") 153#' fun_with_spinner3 <- function() { 154#' lapply(1:100, function(x) { sp3$spin(); Sys.sleep(0.05) }) 155#' sp3$finish() 156#' } 157#' ansi_with_hidden_cursor(fun_with_spinner3()) 158#' ``` 159#' 160#' @family spinners 161#' @export 162 163make_spinner <- function(which = NULL, stream = "auto", template = "{spin}", 164 static = c("dots", "print", "print_line", 165 "silent")) { 166 167 stopifnot( 168 inherits(stream, "connection") || is_string(stream), 169 is_string(template)) 170 171 c_stream <- get_real_output(stream) 172 c_spinner <- get_spinner(which) 173 c_template <- template 174 c_static <- match.arg(static) 175 c_state <- 1L 176 c_first <- TRUE 177 c_col <- 1L 178 c_width <- 0L 179 c_last <- Sys.time() - as.difftime(1, units = "secs") 180 c_int <- as.difftime(c_spinner$interval / 1000, units = "secs") 181 182 c_res <- list() 183 184 throttle <- function() Sys.time() - c_last < c_int 185 clear_line <- function() { 186 str <- paste0(c("\r", rep(" ", c_width), "\r"), collapse = "") 187 cat(str, file = c_stream) 188 } 189 inc <- function() { 190 c_state <<- c_state + 1L 191 c_first <<- FALSE 192 if (c_state > length(c_spinner$frames)) c_state <<- 1L 193 c_last <<- Sys.time() 194 invisible(c_res) 195 } 196 197 c_res$finish <- function() { 198 c_state <<- 1L 199 c_first <<- TRUE 200 c_col <<- 1L 201 c_last <<- Sys.time() 202 if (is_dynamic_tty(c_stream)) clear_line() else cat("\n", file = c_stream) 203 invisible(c_res) 204 } 205 206 if (is_dynamic_tty(c_stream)) { 207 c_res$spin <- function(template = NULL) { 208 if (!is.null(template)) c_template <<- template 209 if (throttle()) return() 210 line <- sub("{spin}", c_spinner$frames[[c_state]], c_template, 211 fixed = TRUE) 212 line_width <- ansi_nchar(line) 213 if (is_ansi_tty(c_stream)) { 214 cat("\r", line, ANSI_EL, sep = "", file = c_stream) 215 } else { 216 # extra padding in case the line width has changed 217 # so that we don't get any garbage in the output 218 padding <- if (line_width < c_width) { 219 paste0(rep(" ", line_width), collapse = "") 220 } else { 221 "" 222 } 223 cat("\r", line, padding, sep = "", file = c_stream) 224 } 225 # save the new line width 226 c_width <<- line_width 227 inc() 228 } 229 230 } else { 231 if (c_static == "dots") { 232 c_res$spin <- function(template = NULL) { 233 if (!is.null(template)) c_template <<- template 234 if (c_first) cat(template, "\n", sep = "", file = c_stream) 235 if (throttle()) return() 236 cat(".", file = c_stream) 237 c_col <<- c_col + 1L 238 if (c_col == console_width()) { 239 cat("\n", file = c_stream) 240 c_col <<- 1L 241 } 242 inc() 243 } 244 } else if (c_static == "print") { 245 c_res$spin <- function(template = NULL) { 246 if (!is.null(template)) c_template <<- template 247 if (throttle()) return() 248 line <- sub("{spin}", c_spinner$frames[[c_state]], c_template, 249 fixed = TRUE) 250 cat(line, file = c_stream) 251 inc() 252 } 253 } else if (c_static == "print_line") { 254 c_res$spin <- function(template = NULL) { 255 if (!is.null(template)) c_template <<- template 256 if (throttle()) return() 257 line <- sub("{spin}", c_spinner$frames[[c_state]], c_template, 258 fixed = TRUE) 259 cat(line, "\n", sep = "", file = c_stream) 260 inc() 261 } 262 } else if (c_static == "silent") { 263 c_res$spin <- function(template = NULL) { 264 if (!is.null(template)) c_template <<- template 265 if (throttle()) return() 266 inc() 267 } 268 } 269 } 270 271 class(c_res) <- "cli_spinner" 272 c_res 273} 274 275#' @export 276 277print.cli_spinner <- function(x, ...) { 278 cat("<cli_spinner>\n") 279 invisible(x) 280} 281 282## nocov start 283 284#' Show a demo of some (by default all) spinners 285#' 286#' Each spinner is shown for about 2-3 seconds. 287#' 288#' @details 289#' 290#' ```{asciicast demo-spinners, R.options =list(asciicast_at = NULL)} 291#' demo_spinners("clock") 292#' ``` 293#' 294#' @param which Character vector, which spinners to demo. 295#' 296#' @family spinners 297#' @export 298 299demo_spinners <- function(which = NULL) { 300 stopifnot(is.null(which) || is.character(which)) 301 302 all <- list_spinners() 303 which <- which %||% all 304 305 if (length(bad <- setdiff(which, all))) { 306 stop("Unknown spinners: ", paste(bad, collapse = ", ")) 307 } 308 309 for (w in which) { 310 sp <- get_spinner(w) 311 interval <- sp$interval / 1000 312 frames <- sp$frames 313 cycles <- max(round(2.5 / ((length(frames) - 1) * interval)), 1) 314 for (i in 1:(length(frames) * cycles) - 1) { 315 fr <- unclass(frames[i %% length(frames) + 1]) 316 cat("\r", rpad(fr, width = 10), w, sep = "") 317 Sys.sleep(interval) 318 } 319 cat("\n") 320 } 321} 322 323demo_spinners_terminal <- function(ticks = 100 * 3000) { 324 up <- function(n) cat(paste0("\u001B[", n, "A")) 325 show <- function() cat("\u001b[?25h") 326 hide <- function() cat("\u001b[?25l") 327 328 on.exit(show(), add = TRUE) 329 330 names <- unlist(spinners$name) 331 frames <- spinners$frames 332 intervals <- unlist(spinners$interval) 333 num_frames <- viapply(frames, length) 334 spin_width <- viapply(frames, function(x) max(nchar(x, type = "width"))) 335 name_width <- nchar(names, type = "width") 336 col_width <- spin_width + max(name_width) + 3 337 col1_width <- max(col_width[1:(length(col_width)/2)]) 338 339 frames <- mapply( 340 frames, 341 names, 342 FUN = function(f, n) { 343 rpad(paste(lpad(n, max(name_width) + 2), f), col1_width) 344 } 345 ) 346 347 hide() 348 349 for (tick in 0:ticks) { 350 tic <- Sys.time() 351 wframe <- trunc(tick / intervals) %% num_frames + 1 352 sp <- mapply(frames, wframe, FUN = "[") 353 354 sp2 <- paste( 355 sep = " ", 356 sp[1:(length(sp) / 2)], 357 sp[(length(sp) / 2 + 1):length(sp)] 358 ) 359 360 cat(sp2, sep = "\n") 361 up(length(sp2)) 362 took <- Sys.time() - tic 363 togo <- as.difftime(1/1000, units = "secs") - took 364 if (togo > 0) Sys.sleep(togo) 365 } 366 367} 368 369## nocov end 370