Nothing
#'Play a drum sound
#'
#'\code{beat} plays a drum beat.
#'
#'
#'@param drum character string or number specifying which drum is to be played by
#' specifying one of the built in sounds. The default is "snare". Every kit includes at
#' least four pieces:
#' \enumerate{ \item \code{"kick"} \item \code{"snare"} \item \code{"hihat"}
#' \item \code{"crash"}}
#' If \code{drum} does not match any
#' of the options in this list, a random sound will be played.
#'
#'@param kit character string specifying which kit is to be used. The default is "acoustic."
#' Possible kits are:
#' \enumerate{ \item \code{"acoustic"} \item \code{"hiphop"} \item \code{"electro"}
#' \item \code{"beatbox"} \item \code{"world"} \item \code{"r2d2"}}
#' If \code{kit} does not match any
#' of the options in this list, a random sound will be played.
#'
#'@param expr An optional expression to be executed before the sound.
#'@import audio
#'@import stringr
#'
#'
#'@return NULL
#'
#' @examples
#' # Play a "snare" sound from the "acoustic" kit
#' beat()
#'
#' # Play a bass sound from the hiphop kit.
#' beat(drum="kick", kit="hiphop")
#'
#'@export
beat <- function(drum="snare", kit="acoustic", expr=NULL) {
expr
drums <- c(snare = "snare.wav",
kick = "kick.wav",
hihat = "hihat.wav",
crash = "crash.wav")
kits <- c(acoustic = "acoustic/",
electro = "electro/",
hiphop = "hiphop/",
beatbox = "beatbox/",
world = "world/",
r2d2 = "r2d2/")
drum_path <- NULL
if(is.na(drums[drum]) || length(drums[drum]) != 1 || is.na(kits[kit]) || length(kits[kit]) != 1) {
if(is.character(drum)) {
drum <- stringr::str_trim(drum)
if(is.character(kit)){
kit <- stringr::str_trim(kit)
if(file.exists(system.file(paste("sounds/", kits[kit], drums[drum], sep=""), package="drumr"))){
drum_path <- system.file(paste("sounds/", kits[kit], drums[drum], sep=""), package="drumr")
} else {
warning(paste("Either ", '"', kit, '"', " is not a valid kit, or ", '"', drum, '"', " is not a valid drum. Playing a random sound instead.", sep = ""))
}
}
}
} else if(!file.exists(system.file(paste("sounds/", kits[kit], drums[drum], sep=""), package="drumr"))){
warning(paste("Either ", '"', kit, '"', " is not a valid kit, or ", '"', drum, '"', " is not a valid drum. Playing a random sound instead.", sep = ""))
} else {
drum_path <- system.file(paste("sounds/", kits[kit], drums[drum], sep=""), package="drumr")
}
if(is.null(drum_path)) { # play a random sound
drum_path <- system.file(paste("sounds/", sample(kits, size=1), sample(drums, size=1), sep=""), package="drumr")
}
tryCatch(play_file(drum_path), error = function(ex) {
warning("beat() could not play the sound due to the following error:\n", ex)
})
}
is_wav_fname <- function(fname) {
stringr::str_detect(fname, regex("\\.wav$", ignore_case = TRUE))
}
escape_spaces <- function(s) {
stringr::str_replace_all(s, " ", "\\\\ ")
}
play_vlc <- function(fname) {
fname <- escape_spaces(fname)
system(paste0("vlc -Idummy --no-loop --no-repeat --playlist-autostart --no-media-library --play-and-exit ", fname),
ignore.stdout = TRUE, ignore.stderr=TRUE,wait = FALSE)
invisible(NULL)
}
play_paplay <- function(fname) {
fname <- escape_spaces(fname)
system(paste0("paplay ", fname), ignore.stdout = TRUE, ignore.stderr=TRUE,wait = FALSE)
invisible(NULL)
}
play_aplay <- function(fname) {
fname <- escape_spaces(fname)
system(paste0("aplay --buffer-time=48000 -N -q ", fname), ignore.stdout = TRUE, ignore.stderr=TRUE,wait = FALSE)
invisible(NULL)
}
play_audio <- function(fname) {
sfx <- audio::load.wave(fname)
audio::play(sfx)
}
play_file <- function(fname) {
if(Sys.info()["sysname"] == "Linux") {
if(is_wav_fname(fname) && nchar(Sys.which("paplay")) >= 1) {
play_paplay(fname)
} else if(is_wav_fname(fname) && nchar(Sys.which("aplay")) >= 1) {
play_aplay(fname)
} else if(nchar(Sys.which("vlc")) >= 1) {
play_vlc(fname)
} else {
play_audio(fname)
}
} else {
play_audio(fname)
}
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.