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