ourMELONS/R/questdlg.R

#' @title Prompt for multiple-choice
#' @param quest Question
#' @param dlgtitle Title of question
#' @param btn Vector of alternatives
#' @param defbtn Scalar with the name of the default option
#' @param accepted_ans Vector containing accepted answers
#' @description This function aims to loosely mimic the behavior of the
#' questdlg function on Matlab
#' @export
questdlg <- function(quest,
                     dlgtitle = "",
                     btn = c("y", "n"),
                     defbtn = "n",
                     accepted_ans = c("y", "yes", "n", "no")) {
  message(dlgtitle)
  # ==========================================================================
  # Replacing the default option with a capitalized version on btn
  # ==========================================================================
  btn[match(tolower(defbtn), tolower(btn))] <- toupper(defbtn)
  # ==========================================================================
  # Creating prompt
  # ==========================================================================
  option_char <- paste0(" [", paste(btn, collapse = ", "), "]")
  answer <- readline(paste0(quest, option_char, ": "))
  # ==========================================================================
  # Processing answer
  # ==========================================================================
  answer <- tolower(answer)
  if (!(answer %in% tolower(c(btn, accepted_ans)))) {
    if (answer != "") {
      warning(
        "'", answer, "' is not a valid alternative. Defaulting to ",
        defbtn
      )
    }
    answer <- defbtn
  }
  return(answer)
}