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)
}