Nothing
#' Convert raw vectors into a character string
#'
#' A function that converts `raw` data into a `character` string.
#'
#' The function `rawToChar()` will fail on vectors of `raw` data
#' with embedded `0x00` data. This function will not fail on embedded `0x00` values.
#' Instead, it will replace embedded `0x00` data with white spaces. Note that
#' leading and trailing `0x00` data will be omitted from the result.
#'
#' @param raw_dat A vector of class `raw` to be converted into a `character`.
#' @returns A `character` string based on the `raw` data
#' @examples
#' ## generate some raw data with an embedded 0x00:
#' some.raw.data <- as.raw(c(0x68, 0x65, 0x6c, 0x6c, 0x6f, 0x00,
#' 0x77, 0x6f, 0x72, 0x6c, 0x64, 0x21))
#' \dontrun{
#' ## this will fail:
#' try(rawToChar(some.raw.data))
#' }
#'
#' ## this will succeed:
#' rawToCharNull(some.raw.data)
#'
#' @family raw.operations
#' @family character.operations
#' @author Pepijn de Vries
#' @export
rawToCharNull <- function(raw_dat) {
result <- ""
if (length(raw_dat) < 3) try(result <- (rawToChar(raw_dat)), silent = T) else
{
result <- raw_dat
runlength <- rle(result)$lengths
if (length(runlength) > 2)
{
rel_range <- (runlength[1] + 1):(length(result) - runlength[length(runlength)])
if (result[[1]] != raw(1)) rel_range <- 1:rel_range[length(rel_range)]
if (result[[length(result)]] != raw(1)) rel_range <- rel_range[1]:length(result)
result[rel_range][result[rel_range] == as.raw(0x00)] <- as.raw(0x20)
result <- result[result != raw(1)]
}
try(result <- rawToChar(result), silent = T)
if ("raw" %in% class(result)) result <- ""
}
return(result)
}
#' Convert raw vector into a single unsigned integer value
#'
#' This function converts `raw` data into an unsigned integer
#'
#' This function converts a vector of raw data into a single unsigned integer.
#' for conversion of raw data into a vector of unsigned integers `\[0,255\`] use
#' `as.integer()`. For an inverse of this function
#' see `unsignedIntToRaw()`.
#'
#' @param raw_dat A vector of class `raw` to be converted into an unsigned integer
#' @returns A single unsigned integer value based on the provided `raw` data
#' @examples
#' ## generate some raw data:
#' some.raw.data <- as.raw(c(0x01, 0x1e, 0x3f))
#'
#' ## convert raw data into an unsigned integer:
#' rawToUnsignedInt(some.raw.data)
#'
#' ## note the difference with
#' as.integer(some.raw.data)
#'
#' @family raw.operations
#' @family integer.operations
#' @author Pepijn de Vries
#' @export
rawToUnsignedInt <-
function(raw_dat)
{
if (!("raw" %in% class(raw_dat))) stop ("This function requires raw data as input")
result <- as.integer(raw_dat)
return(as.integer(sum(result*(256^((length(result):1) - 1)))))
}
#' Convert unsigned integer into a raw vector
#'
#' This function converts an unsigned integer into a vector of `raw` data.
#'
#' This function converts an unsigned integer value into a vector (with
#' a specified length, namely `length.out`) of `raw` data. For the
#' inverse of this function use `rawToUnsignedInt()`.
#'
#' @param int_dat A single integer value. If a list or vector of values.
#' is provided, only the first element is evaluated. Input data are converted
#' to absolute integer values.
#' @param length.out Required length of the vector that will hold the resulting.
#' `raw` data. Defaults to 1. If the value of `int_dat` is to large to convert into
#' `raw` data of length `length.out`, data will be clipped.
#' @returns A vector of length `length.out`, holding `raw` data.
#' @examples
#' ## generate some unsigned integer:
#' some.integer <- 43251
#'
#' ## convert the unsigned integer into raw data:
#' unsignedIntToRaw(some.integer, length.out = 4)
#'
#' \dontrun{
#' ## note that the integer is too large to store as raw with length.out = 1:
#' unsignedIntToRaw(some.raw.data, length.out = 1)
#' }
#'
#' @family raw.operations
#' @family integer.operations
#' @author Pepijn de Vries
#' @export
unsignedIntToRaw <-
function(int_dat, length.out = 1)
{
if (length(int_dat) > 1) warning ("Argument 'int_dat' has more than 1 element. Only first element converted")
if (int_dat < 0) warning ("Argument 'int_dat' is signed, taking absolute value")
int_dat <- abs(as.integer(int_dat[[1]]))
if (int_dat >= 256^length.out)
{
int_dat <- 256^length.out - 1
warning ("Argument 'in_dat' is out of range, proceeding with clipped value")
}
result <- NULL
remaining <- int_dat
repeat
{
result <- c(remaining%%256, result)
remaining <- floor(remaining/256)
if(remaining <= 0) break
}
result <- as.raw(result)
if (length(result) < length.out) result <- c(raw(length.out - length(result)), result)
return(result)
}
#' Convert signed integers (short) into a raw vector
#'
#' This function converts signed integer values into a vector of `raw` data.
#'
#' This function converts signed integer values \[-128,127\] into a vector of
#' `raw` data. The function
#' will fail on values that are out of range (< -128 or > 127). To convert
#' raw data into a vector of unsigned integers use `as.integer()`.
#' For the inverse of this function see `rawToSignedInt()`.
#'
#' @param int_dat A vector of integer values, ranging from -128 up to 127.
#' @returns A vector of the same length as `int_dat`, holding `raw` data.
#' @examples
#' ## generate some signed integers:
#' some.integers <- c(-100, 40, 0, 30, -123)
#'
#' ## convert the signed integers into a vector of raw data:
#' signedIntToRaw(some.integers)
#'
#' @family raw.operations
#' @family integer.operations
#' @author Pepijn de Vries
#' @export
signedIntToRaw <-
function(int_dat)
{
int_dat <- as.integer(int_dat)
if(any(int_dat < -128)) stop("Some or all values out of range")
if(any(int_dat > 127)) stop("Some or all values out of range")
result <- int_dat
result[result < 0] <- result[result < 0] + 256
return(as.raw(result))
}
#' Convert a raw vector into signed integers (short)
#'
#' This function converts a vector of `raw` data into signed integer values.
#'
#' This function converts a vector of `raw` data into signed integer values
#' \[-128,127\]. To convert unsigned integers into raw data use `as.raw()`.
#' For the inverse of this function see `signedIntToRaw()`.
#'
#' @param raw_dat A vector of `raw` data.
#' @returns A vector of the same length as `raw_dat`, holding signed integer values.
#' @examples
#' ## generate some raw data:
#' some.raw.data <- as.raw(c(0x68, 0x65, 0x6c, 0x6c, 0x6f, 0x90))
#'
#' ## convert the raw data into a vector of signed intgers:
#' rawToSignedInt(some.raw.data)
#'
#' @family raw.operations
#' @family integer.operations
#' @author Pepijn de Vries
#' @export
rawToSignedInt <-
function(raw_dat)
## function that converts raw data into a signed (short) integers
{
if (!("raw" %in% class(raw_dat))) stop("Argument 'raw_dat' is not of class 'raw'")
result <- as.integer(raw_dat)
result[result > 127] <- result[result > 127] - 256
return(as.integer(result))
}
.getPeriodIndex <-
function(period)
## use internally only to convert period numbers to note and octave
## get the row index of the period table based on a period value
## it doesn't work perfectly can rely on this 100%!
{
return(128 - round(logb(period, 1.060199)))
}
#' Get the note and octave from period table
#'
#' These functions return the note and octave that is closest to the provided period value.
#'
#' ProTracker uses a [period_table] to link period values to certain
#' octaves and notes. This function serves to look up corresponding
#' notes and octaves for specific period values.
#'
#' @rdname periodToChar
#' @name periodToChar
#' @param period `integer` value of a period value.
#' @returns `periodToChar` returns a `character` representing the combination
#' of octave and note that is closest to
#' `period` in the ProTracker period table.
#' @examples
#' ## Note C# in octave 3 is closest to a period of 200 in the table:
#' periodToChar(200)
#' ## try with a range of period values:
#' periodToChar(200:400)
#'
#' @family character.operations
#' @family period.operations
#' @family note.and.octave.operations
#' @author Pepijn de Vries
#' @export
periodToChar <-
function(period)
## get note and octave character that corresponds with a specific period value
{
oct <- as.character(octave(period))
oct[oct == "0"] <- "-"
paste(note(period), oct, sep = "")
}
#' Extract period value for a specific note
#'
#' Extracts the ProTracker period value for a specific note.
#'
#' ProTracker uses a [period_table] to link period values to certain
#' octaves and notes. This function serves to look up corresponding
#' period values for specific notes and octaves.
#'
#' @rdname noteToPeriod
#' @name noteToPeriod
#' @param note `character` string representing a note and octave for which the
#' ProTracker period value needs to be determined
#' @param finetune `integer` value ranging from -8 up to 7. A value used to
#' tune an audio sample.
#' @returns Returns the `numeric` ProTracker period value for a corresponding
#' note, octave and `fineTune()`. Returns 0 if a note could not be found in the
#' table.
#' @examples
#' ## Determine the period value corresponding with note 'A-3':
#' noteToPeriod("A-3")
#'
#' ## get the period values for notes 'A-3' and 'A#3' with finetune at -1:
#' noteToPeriod(c("A-3", "A#3"), -1)
#'
#' ## get the period values for note 'A-3' with finetune at 0 and 1:
#' noteToPeriod("A-3", 0:1)
#'
#' @family period.operations
#' @family note.and.octave.operations
#' @author Pepijn de Vries
#' @export
noteToPeriod <-
function(note = "C-3", finetune = 0)
{
if (length(note) != length(finetune) &&
(length(note) > 1 && length(finetune) > 1))
stop("note and finetune should have the same length,
or either should have length 1!")
note <- toupper(as.character(note))
note[nchar(note) == 2] <- paste(substr(note[nchar(note) == 2], 1, 1),
substr(note[nchar(note) == 2], 2, 2), sep = "-")
finetune <- as.integer((finetune))
if (length(note) > length(finetune)) finetune <- rep(finetune, length(note))
if (length(note) < length(finetune)) note <- rep(note, length(finetune))
if (any(finetune > 7))
{
warning("finetune is out of range. Value clipped")
fintune[finetune > 7] <- 7
}
if (any(finetune < -8))
{
warning("finetune is out of range. Value clipped")
fintune[finetune < -8] <- 8
}
r_index <- suppressWarnings(apply(outer(ProTrackR::period_table$octave, as.numeric(substr(note, 3,3)), "==") &
outer(ProTrackR::period_table$tuning, finetune, "=="),
2, which))
r_index <- unlist(lapply(as.list(r_index), function(x) ifelse(length(x) == 0, NA, x)))
index <- cbind(r_index, match(substr(note, 1, 2), names(ProTrackR::period_table)))
if (ncol(index) != 2) return (0)
period <- ProTrackR::period_table[index]
period[is.na(period)] <- 0
return(period)
}
#' Calculate the sample rate for a note or period value
#'
#' Calculate the sample rate for a note or a ProTracker period value.
#'
#' The timing on a Commodore Amiga depends on the video mode, which could be
#' either '[PAL](https://en.wikipedia.org/wiki/PAL)'
#' or '[NTSC](https://en.wikipedia.org/wiki/NTSC)'. Therefore sample
#' rates also depend on these modes. As the PAL is mostly used in Europe, and
#' the Amiga was most popular in Europe, PAL is used by default.
#'
#' @rdname sampleRate
#' @name sampleRate
#' @aliases periodToSampleRate
#' @aliases noteToSampleRate
#' @param period A ProTracker `integer` value of a period value for which the sample rate
#' is to be calculated.
#' @param note A `character` string representing a note for which the sample
#' rate is to be calculated.
#' @param finetune An `integer` value ranging from -8 up to 7. A value used to
#' tune an audio sample.
#' @param video The video mode used to calculate the sample rate. A `character`
#' string that can have either the value '[PAL](https://en.wikipedia.org/wiki/PAL)'
#' or '[NTSC](https://en.wikipedia.org/wiki/NTSC)'. PAL is used by default.
#' @returns Returns the sample rate in samples per seconds.
#' @examples
#' ## calculate the sample rate for a ProTracker period value of 200
#' periodToSampleRate(200)
#'
#' ## calculate the sample rate for a sample at note 'A-3'
#' noteToSampleRate("A-3")
#'
#' ## note that the NTSC video system gives a slightly different rate:
#' noteToSampleRate("A-3", video = "NTSC")
#'
#' ## fine tuning a sample will also give a slightly different rate:
#' noteToSampleRate("A-3", finetune = -1)
#'
#' @family character.operations
#' @family period.operations
#' @family sample.rate.operations
#' @family note.and.octave.operations
#' @author Pepijn de Vries
#' @export
noteToSampleRate <-
function(note = "C-3", finetune = 0, video = c("PAL", "NTSC"))
## get the sample rate that corresponds with a specific note
{
rate <- periodToSampleRate(noteToPeriod(note, finetune), match.arg(video))
if (is.infinite(rate)) stop ("Note not in ProTracker period table.")
return (rate)
}
#' @rdname sampleRate
#' @name sampleRate
#' @export
periodToSampleRate <-
function(period, video = c("PAL", "NTSC"))
## get the sample rate that corresponds with a specific period value
## based on the most common Amiga clock speed
{
ProTrackR::paula_clock$frequency[ProTrackR::paula_clock$video == match.arg(video)]/period
}
#' Get the high or low nybble of a raw value
#'
#' Get the high or low nybble of a raw value and return as integer value \[0,15\].
#'
#' A `raw` is basically a byte, composed of 8 bits (zeros and ones).
#' A nybble is a 4 bit value. Hence, a raw value (or byte) is composed of
#' two nybbles. The leftmost nybble of a raw value is refered to as the
#' high nybble, the rightmost nybble is referred to as the low nybble.
#' These functions return either the high or low nybbles of raw data as integer
#' values \[0,15\].
#' As ProTracker stores some information as nybbles this function can be
#' used to retrieve this info.
#'
#' @rdname nybble
#' @name nybble
#' @param raw_dat A vector of class `raw` from which the high or low nybble value
#' needs to be extracted.
#' @param which A character string indicating whether the high or low nybble should
#' be returnd. It should either be `"low"` (default) or `"high"`.
#' @returns A vector of the same length as `raw_dat` holding integer values.
#' @examples
#' ## this will return 0x0f:
#' hiNybble(as.raw(0xf3))
#'
#' ## which is the same as:
#' nybble(as.raw(0xf3), "high")
#'
#' ## this will return 0x03:
#' loNybble(as.raw(0xf3))
#'
#' ## which is the same as:
#' nybble(as.raw(0xf3), "low")
#' @author Pepijn de Vries
#' @family nybble.functions
#' @family raw.operations
#' @family integer.operations
#' @export
nybble <-
function(raw_dat, which = c("low", "high"))
{
if (match.arg(which) == "low") return (loNybble(raw_dat))
if (match.arg(which) == "high") return (hiNybble(raw_dat))
# stop ("No valid argument 'which' provided. Should be 'low' or 'high'.")
}
#' @rdname nybble
#' @export
loNybble <-
function(raw_dat)
## function that gets the value [0,16] of the 4 low bits of a raw byte
{
if (!("raw" %in% class(raw_dat))) stop ("Only raw data is accepted as input")
return(as.integer(raw_dat)%%16)
}
#' @rdname nybble
#' @export
hiNybble <-
function(raw_dat)
## function that gets the value [0,16] of the 4 high bits of a raw byte
{
if (!("raw" %in% class(raw_dat))) stop ("Only raw data is accepted as input")
return(as.integer(as.integer(raw_dat)/16))
}
#' Get signed integer values from nybbles
#'
#' Get signed integer values from one or more nybble.
#'
#' Nybbles are 4 bit values, where each byte (8 bits) holds two nybbles.
#' A high nybble (left-hand side of a byte) and a low nybble (right-hand
#' side of a byte). This function extracts a nybble from `raw` data
#' and converts it into a signed `integer` value ranging from -8 up to 7.
#' @rdname nybbleToSignedInt
#' @name nybbleToSignedInt
#' @param raw_dat `raw` data (either a single value or a `vector`),
#' from which a nybble will be extracted and converted.
#' @param which A `character` string indicating whether the `"low"` (default)
#' or `"high"` nybble of `raw_dat` needs to be converted into a signed
#' `integer`.
#' @returns Returns `integer` values of the same length as `raw_dat`,
#' ranging from -8 up to 7.
#' @examples
#' ## generate some raw data:
#'
#' rdat <- as.raw(255*runif(100))
#'
#' ## get signed integers of low nybbles:
#'
#' sintl <- nybbleToSignedInt(rdat)
#'
#' ## get signed integers of high nybbles:
#'
#' sinth <- nybbleToSignedInt(rdat, "high")
#'
#' @family nybble.functions
#' @family raw.operations
#' @family integer.operations
#' @author Pepijn de Vries
#' @export
nybbleToSignedInt <- function(raw_dat, which = c("low", "high"))
{
nb <- nybble(raw_dat, which)
nb[nb > 7] <- nb[nb > 7] - 16
return(nb)
}
#' Convert a signed integer to a nybble in raw data.
#'
#' This function converts a signed integer ranging from -8 up to 7 into
#' either the high or low nybble of a byte, represented by `raw` data.
#'
#' Nybbles are 4 bit values, where each byte (8 bits) holds two nybbles.
#' A high nybble (left-hand side of a byte) and a low nybble (right-hand
#' side of a byte). This function converts a signed `integer` value
#' ranging from -8 up to 7 to a nybble and sets it as either a high or a low
#' nybble in `raw` data.
#' @rdname signedIntToNybble
#' @name signedIntToNybble
#' @param int_dat A single `integer` value or a `vector` of
#' `integer` data ranging from -8 up to 7.
#' @param which A character string indicating whether the nybble should
#' be set to the `"low"` (default) or `"high"` position of the
#' raw data that is returned.
#' @returns Returns `raw` data of the same length as `int_dat`.
#' The returned raw data holds either low or high nybbles (as specified
#' by `which`) based on the provided signed `integer`s.
#' @examples
#' ## generate some integers in the right range:
#'
#' dati <- sample(-8:7, 100, replace = TRUE)
#'
#' ## Set the low nybbles of rawl based on dati:
#'
#' rawl <- signedIntToNybble(dati)
#'
#' ## Set the high nybbles of rawl based on dati:
#'
#' rawh <- signedIntToNybble(dati, "high")
#' @family nybble.functions
#' @family raw.operations
#' @family integer.operations
#' @author Pepijn de Vries
#' @export
signedIntToNybble <- function(int_dat, which = c("low", "high"))
{
int_dat <- as.integer(int_dat)
if (any(int_dat < -8) || any(int_dat > 7)) stop("int_dat out of range [-8,7]!")
int_dat[int_dat < 0] <- int_dat[int_dat < 0] + 16
fact <- ifelse(match.arg(which) == "low", 1, 16)
return(as.raw(fact*int_dat))
}
#' Get the vibrato table used by ProTracker
#'
#' Gets the vibrato table as used by ProTracker in vibrato effects.
#'
#' As the old Commodore Amiga computer didn't have built-in mathematical functions,
#' many programs on that machine used their own data tables. As did ProTracker
#' for vibrato effects for which a sine function was used. As there was no sine
#' function that could be called, sine values were stored in a table.
#'
#' This function returns the `integer` sine values (ranging from 0 up
#' to 255) as a function of the table index (ranging from 0 up to 31).
#'
#' @rdname proTrackerVibrato
#' @name proTrackerVibrato
#' @param x `integer` representing the table index ranging from 0
#' up to 31. Values outside this range can be used, but will produce
#' results that are not valid in the context of ProTracker.
#' @returns Returns an `integer` sine value ranging from 0 up to 255
#' when a valid table index (`x`) is provided. It will otherwise return
#' a sine value ranging from -255 up to 255.
#' @examples
#' ## this will return the table as used in ProTracker
#' proTrackerVibrato(0:31)
#' @author Pepijn de Vries
#' @export
proTrackerVibrato <- function(x)
{
return(as.integer(255*sin(pi*(as.integer(x))/32)))
}
.unpackFibonacciDelta <-
function(raw_data)
## function to decompress audio data (used by read.sample())
## based on following specs:
## http://amigadev.elowar.com/read/ADCD_2.1/Devices_Manual_guide/node02D6.html
{
if (!("raw" %in% class(raw_data))) stop ("Only raw data is accepted as input")
fibonacci <- c(-34, -21, -13, -8, -5, -3, -2, -1, 0, 1, 2, 3, 5, 8, 13, 21)
result <- as.raw(rep(0, 2*length(raw_data) - 2))
result[1] <- raw_data[2]
for (i_byte in 2:length(result))
{
nybble <- ifelse((i_byte%%2) == 0, c(hiNybble), c(loNybble))
work_byte <- raw_data[1 + (i_byte/2)]
result_val <- rawToSignedInt(result[i_byte - 1]) + fibonacci[1 + nybble[[1]](work_byte)]
## Not entirely sure if I handle values out of range correctly here.
## I choose to cut values of, while it is also possible to use a modulus
result_val <- ifelse(result_val > 127, 127, result_val)
result_val <- ifelse(result_val < -128, -128, result_val)
result[i_byte] <- signedIntToRaw(result_val)
}
return(result)
}
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.