├── R ├── sysdata.rda ├── data.R ├── aaa.R ├── tweet.R └── tr808.R ├── data ├── demo_songs.rda └── sample_names.rda ├── man ├── figures │ ├── blank.png │ ├── compose.mp4 │ ├── demo1.mp4 │ ├── playback.png │ ├── schematic.png │ ├── tweetable.mp4 │ ├── logo-tr808r.png │ └── schematic.graffle ├── tr808_init.Rd ├── sample_names.Rd ├── tr808_func.Rd ├── demo_songs.Rd ├── tr808.Rd └── text_to_tr808_state.Rd ├── data-raw ├── samples │ ├── Clap.wav │ ├── Cabasa.wav │ ├── Claves.wav │ ├── Cowbell.wav │ ├── Rimshot.wav │ ├── Tom H.wav │ ├── Tom L.wav │ ├── Tom M.wav │ ├── Crash-01.wav │ ├── Crash-02.wav │ ├── Hat Open.wav │ ├── Snaredrum.wav │ ├── Bassdrum-01.wav │ ├── Bassdrum-02.wav │ ├── Bassdrum-03.wav │ ├── Bassdrum-04.wav │ ├── Bassdrum-05.wav │ └── Hat Closed.wav ├── New Order - Confusion.rds ├── Marvin Gaye - Sexual Healing.rds ├── Michael Jackson - Beat It Intro.rds └── prep-samples.R ├── .Rbuildignore ├── .gitignore ├── NEWS.md ├── NAMESPACE ├── DESCRIPTION ├── LICENSE ├── README.md └── README.Rmd /R/sysdata.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/coolbutuseless/tr808r/HEAD/R/sysdata.rda -------------------------------------------------------------------------------- /data/demo_songs.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/coolbutuseless/tr808r/HEAD/data/demo_songs.rda -------------------------------------------------------------------------------- /data/sample_names.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/coolbutuseless/tr808r/HEAD/data/sample_names.rda -------------------------------------------------------------------------------- /man/figures/blank.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/coolbutuseless/tr808r/HEAD/man/figures/blank.png -------------------------------------------------------------------------------- /man/figures/compose.mp4: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/coolbutuseless/tr808r/HEAD/man/figures/compose.mp4 -------------------------------------------------------------------------------- /man/figures/demo1.mp4: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/coolbutuseless/tr808r/HEAD/man/figures/demo1.mp4 -------------------------------------------------------------------------------- /data-raw/samples/Clap.wav: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/coolbutuseless/tr808r/HEAD/data-raw/samples/Clap.wav -------------------------------------------------------------------------------- /man/figures/playback.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/coolbutuseless/tr808r/HEAD/man/figures/playback.png -------------------------------------------------------------------------------- /man/figures/schematic.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/coolbutuseless/tr808r/HEAD/man/figures/schematic.png -------------------------------------------------------------------------------- /man/figures/tweetable.mp4: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/coolbutuseless/tr808r/HEAD/man/figures/tweetable.mp4 -------------------------------------------------------------------------------- /data-raw/samples/Cabasa.wav: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/coolbutuseless/tr808r/HEAD/data-raw/samples/Cabasa.wav -------------------------------------------------------------------------------- /data-raw/samples/Claves.wav: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/coolbutuseless/tr808r/HEAD/data-raw/samples/Claves.wav -------------------------------------------------------------------------------- /data-raw/samples/Cowbell.wav: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/coolbutuseless/tr808r/HEAD/data-raw/samples/Cowbell.wav -------------------------------------------------------------------------------- /data-raw/samples/Rimshot.wav: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/coolbutuseless/tr808r/HEAD/data-raw/samples/Rimshot.wav -------------------------------------------------------------------------------- /data-raw/samples/Tom H.wav: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/coolbutuseless/tr808r/HEAD/data-raw/samples/Tom H.wav -------------------------------------------------------------------------------- /data-raw/samples/Tom L.wav: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/coolbutuseless/tr808r/HEAD/data-raw/samples/Tom L.wav -------------------------------------------------------------------------------- /data-raw/samples/Tom M.wav: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/coolbutuseless/tr808r/HEAD/data-raw/samples/Tom M.wav -------------------------------------------------------------------------------- /man/figures/logo-tr808r.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/coolbutuseless/tr808r/HEAD/man/figures/logo-tr808r.png -------------------------------------------------------------------------------- /data-raw/samples/Crash-01.wav: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/coolbutuseless/tr808r/HEAD/data-raw/samples/Crash-01.wav -------------------------------------------------------------------------------- /data-raw/samples/Crash-02.wav: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/coolbutuseless/tr808r/HEAD/data-raw/samples/Crash-02.wav -------------------------------------------------------------------------------- /data-raw/samples/Hat Open.wav: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/coolbutuseless/tr808r/HEAD/data-raw/samples/Hat Open.wav -------------------------------------------------------------------------------- /data-raw/samples/Snaredrum.wav: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/coolbutuseless/tr808r/HEAD/data-raw/samples/Snaredrum.wav -------------------------------------------------------------------------------- /man/figures/schematic.graffle: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/coolbutuseless/tr808r/HEAD/man/figures/schematic.graffle -------------------------------------------------------------------------------- /data-raw/samples/Bassdrum-01.wav: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/coolbutuseless/tr808r/HEAD/data-raw/samples/Bassdrum-01.wav -------------------------------------------------------------------------------- /data-raw/samples/Bassdrum-02.wav: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/coolbutuseless/tr808r/HEAD/data-raw/samples/Bassdrum-02.wav -------------------------------------------------------------------------------- /data-raw/samples/Bassdrum-03.wav: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/coolbutuseless/tr808r/HEAD/data-raw/samples/Bassdrum-03.wav -------------------------------------------------------------------------------- /data-raw/samples/Bassdrum-04.wav: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/coolbutuseless/tr808r/HEAD/data-raw/samples/Bassdrum-04.wav -------------------------------------------------------------------------------- /data-raw/samples/Bassdrum-05.wav: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/coolbutuseless/tr808r/HEAD/data-raw/samples/Bassdrum-05.wav -------------------------------------------------------------------------------- /data-raw/samples/Hat Closed.wav: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/coolbutuseless/tr808r/HEAD/data-raw/samples/Hat Closed.wav -------------------------------------------------------------------------------- /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^.*\.Rproj$ 2 | ^\.Rproj\.user$ 3 | ^README.Rmd$ 4 | ^README.md$ 5 | ^working$ 6 | ^data-raw$ 7 | ^.*\.rds$ 8 | -------------------------------------------------------------------------------- /data-raw/New Order - Confusion.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/coolbutuseless/tr808r/HEAD/data-raw/New Order - Confusion.rds -------------------------------------------------------------------------------- /data-raw/Marvin Gaye - Sexual Healing.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/coolbutuseless/tr808r/HEAD/data-raw/Marvin Gaye - Sexual Healing.rds -------------------------------------------------------------------------------- /data-raw/Michael Jackson - Beat It Intro.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/coolbutuseless/tr808r/HEAD/data-raw/Michael Jackson - Beat It Intro.rds -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .DS_Store 2 | .Rhistory 3 | *.Rproj 4 | .Rproj.user 5 | *.swp 6 | *.txt 7 | inst/doc 8 | doc 9 | Meta 10 | pkgdown 11 | working 12 | tr*.rds 13 | -------------------------------------------------------------------------------- /NEWS.md: -------------------------------------------------------------------------------- 1 | # tr808r 0.1.1 2022-05-14 2 | 3 | * Fixed pattern length bug when loading pattern from a tweet 4 | 5 | 6 | # tr808r 0.1.0 2022-05-13 7 | 8 | * Initial release 9 | -------------------------------------------------------------------------------- /R/data.R: -------------------------------------------------------------------------------- 1 | 2 | 3 | #' Demo songs to load in as the \code{state} argument to \code{tr808()} 4 | "demo_songs" 5 | 6 | #' Names of all instrument samples 7 | "sample_names" 8 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | export(text_to_tr808_state) 4 | export(tr808) 5 | export(tr808_func) 6 | export(tr808_init) 7 | import(audio) 8 | import(eventloop) 9 | import(grid) 10 | importFrom(utils,packageVersion) 11 | -------------------------------------------------------------------------------- /man/tr808_init.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/tr808.R 3 | \name{tr808_init} 4 | \alias{tr808_init} 5 | \title{Initialise function for eventloop} 6 | \usage{ 7 | tr808_init() 8 | } 9 | \value{ 10 | None 11 | } 12 | \description{ 13 | Initialise function for eventloop 14 | } 15 | -------------------------------------------------------------------------------- /man/sample_names.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/data.R 3 | \docType{data} 4 | \name{sample_names} 5 | \alias{sample_names} 6 | \title{Names of all instrument samples} 7 | \format{ 8 | An object of class \code{character} of length 11. 9 | } 10 | \usage{ 11 | sample_names 12 | } 13 | \description{ 14 | Names of all instrument samples 15 | } 16 | \keyword{datasets} 17 | -------------------------------------------------------------------------------- /man/tr808_func.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/tr808.R 3 | \name{tr808_func} 4 | \alias{tr808_func} 5 | \title{Main TR808 eventloop callback} 6 | \usage{ 7 | tr808_func(event, mouse_x, mouse_y, event_env, ...) 8 | } 9 | \arguments{ 10 | \item{event, mouse_x, mouse_y, event_env, ...}{eventloop args} 11 | } 12 | \description{ 13 | Main TR808 eventloop callback 14 | } 15 | -------------------------------------------------------------------------------- /man/demo_songs.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/data.R 3 | \docType{data} 4 | \name{demo_songs} 5 | \alias{demo_songs} 6 | \title{Demo songs to load in as the \code{state} argument to \code{tr808()}} 7 | \format{ 8 | An object of class \code{list} of length 3. 9 | } 10 | \usage{ 11 | demo_songs 12 | } 13 | \description{ 14 | Demo songs to load in as the \code{state} argument to \code{tr808()} 15 | } 16 | \keyword{datasets} 17 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: tr808r 2 | Type: Package 3 | Title: Interactive TR-808 Drum Machine 4 | Version: 0.1.1 5 | Author: mikefc 6 | Maintainer: mikefc 7 | Description: Interactive TR-808 drum machine. 8 | License: MIT + file LICENSE 9 | Encoding: UTF-8 10 | LazyData: true 11 | RoxygenNote: 7.1.2 12 | Imports: 13 | audio, 14 | eventloop (>= 0.1.1) 15 | Remotes: 16 | coolbutuseless/eventloop 17 | Depends: 18 | R (>= 2.10) 19 | Suggests: 20 | clipr 21 | -------------------------------------------------------------------------------- /man/tr808.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/tr808.R 3 | \name{tr808} 4 | \alias{tr808} 5 | \title{TR-808} 6 | \usage{ 7 | tr808(bpm = 96, width = 12, height = 8, state = NULL, ...) 8 | } 9 | \arguments{ 10 | \item{bpm}{beats per minute. default: 96} 11 | 12 | \item{width, height, ...}{arguments passed to \code{eventloop::run_loop()}} 13 | 14 | \item{state}{a \code{tr808_state} object or the path of a saved object in 15 | an RDS file. Note: Pressing 's' within the interactive drum machine 16 | window will save the current state to a time stamped RDS file.} 17 | } 18 | \description{ 19 | TR-808 20 | } 21 | -------------------------------------------------------------------------------- /R/aaa.R: -------------------------------------------------------------------------------- 1 | 2 | env <- new.env() 3 | 4 | 5 | RED <- rgb(222, 105, 78, maxColorValue = 255) 6 | ORANGE <- rgb(238, 170, 102, maxColorValue = 255) 7 | YELLOW <- rgb(243, 212, 102, maxColorValue = 255) 8 | WHITE <- rgb(241, 243, 245, maxColorValue = 255) 9 | BLACK <- rgb( 30, 30, 30, maxColorValue = 255) 10 | 11 | ROLAND_RED <- rgb(230, 102, 48, maxColorValue = 255) 12 | 13 | LABEL_YELLOW <- rgb(243, 234, 202, maxColorValue = 255) 14 | 15 | # colorspace::darken(c(RED, ORANGE, YELLOW, WHITE), 0.9) -> col 16 | DRED <- '#2a0700' 17 | DORANGE <- '#241300' 18 | DYELLOW <- '#1f1800' 19 | DWHITE <- '#0e1c26' 20 | 21 | 22 | pattern_ui_light_cols <- c(rep( RED, 4), rep( ORANGE, 4), rep( YELLOW, 4), rep( WHITE, 4)) 23 | pattern_ui_dark_cols <- c(rep(DRED, 4), rep(DORANGE, 4), rep(DYELLOW, 4), rep(DWHITE, 4)) 24 | 25 | pattern_ui_light_cols <- rep(pattern_ui_light_cols, 18) 26 | pattern_ui_dark_cols <- rep(pattern_ui_dark_cols , 18) 27 | -------------------------------------------------------------------------------- /man/text_to_tr808_state.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/tweet.R 3 | \name{text_to_tr808_state} 4 | \alias{text_to_tr808_state} 5 | \title{Convert a text representation into a \code{tr808_state} object with a single pattern} 6 | \usage{ 7 | text_to_tr808_state(txt, bpm = 96) 8 | } 9 | \arguments{ 10 | \item{txt}{Single string must contain 11 strings of length 16 characters consisting of 11 | only \code{_} and \code{x}. All other characters will be ignored.} 12 | 13 | \item{bpm}{bpm. default: 96} 14 | } 15 | \value{ 16 | \code{tr808_state} object 17 | } 18 | \description{ 19 | The returned object can be loaded into the drum machine using 20 | \code{tr808(state = ...)} 21 | } 22 | \examples{ 23 | text_to_tr808_state( 24 | '#RStats #tr808r 25 | BD xx____xx__x_____ 26 | SD ____x_______x___ 27 | LT ________________ 28 | MT xx______________ 29 | HT ______xx__x__x__ 30 | RS ________________ 31 | CP xx_xx_xx_______x 32 | CB xx__x_xx_x_x_xx_ 33 | CY ________________ 34 | OH ________________ 35 | CH x_xxx_xxx_xxx_xx' 36 | ) 37 | } 38 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2022 mikefc@coolbutuseless.com 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in 13 | all copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 21 | THE SOFTWARE. 22 | -------------------------------------------------------------------------------- /data-raw/prep-samples.R: -------------------------------------------------------------------------------- 1 | ## code to prepare `prep-samples` dataset goes here 2 | 3 | files <- list.files("data-raw/samples/", full.names = TRUE) 4 | sample_names <- basename(tools::file_path_sans_ext(files)) 5 | names(files) <- sample_names 6 | samples <- lapply(files, audio::load.wave) 7 | 8 | 9 | samples <- samples[c( 10 | 'Bassdrum-01', 11 | 'Snaredrum', 12 | 'Tom L', 13 | 'Tom M', 14 | 'Tom H', 15 | 'Rimshot', 16 | 'Clap', 17 | 'Cowbell', 18 | 'Crash-01', 19 | 'Hat Open', 20 | 'Hat Closed' 21 | )] 22 | 23 | sample_names <- c( 24 | 'Bass Drum', 25 | 'Snare Drum', 26 | 'Low Tom', 27 | 'Mid Tom', 28 | 'Hi Tom', 29 | 'Rimshot', 30 | 'Hand Clap', 31 | 'Cowbell', 32 | 'Cymbal', 33 | 'Open Hat', 34 | 'Closed Hat' 35 | ) 36 | 37 | 38 | samples <- rev(samples) 39 | sample_names <- rev(sample_names) 40 | 41 | names(samples) <- sample_names 42 | 43 | 44 | 45 | usethis::use_data(samples, internal = TRUE, overwrite = TRUE) 46 | 47 | 48 | 49 | demo_songs <- list() 50 | demo_songs[[1]] <- readRDS("data-raw/New Order - Confusion.rds") 51 | demo_songs[[2]] <- readRDS("data-raw/Marvin Gaye - Sexual Healing.rds") 52 | demo_songs[[3]] <- readRDS("data-raw/Michael Jackson - Beat It Intro.rds") 53 | usethis::use_data(demo_songs, sample_names, internal = FALSE, overwrite = TRUE) 54 | -------------------------------------------------------------------------------- /R/tweet.R: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 5 | #' Convert a single pattern to a text representation 6 | #' 7 | #' @param pat single pattern 8 | #' 9 | #' @return text representation. Also copies to clipboard if \code{clipr} 10 | #' package is installed. 11 | #' 12 | #' @noRd 13 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 14 | pattern_to_text <- function(pat) { 15 | # pat <- pattern$pattern[[1]] 16 | txt <- rep('_', nrow(pat)) 17 | txt[pat$active] <- 'x' 18 | mat <- matrix(txt, nrow=11, ncol=16, byrow = TRUE) 19 | mat <- mat[11:1,] 20 | 21 | # Add instrument names as first column 22 | mat <- cbind( 23 | c('BD ', 'SD ', 'LT ', 'MT ', 'HT ', 'RS ', 'CP ', 'CB ', 'CY ', 'OH ', 'CH '), 24 | mat 25 | ) 26 | 27 | res <- paste(apply(mat, 1, paste, collapse = ""), collapse = "\n") 28 | 29 | res <- paste("#RStats #tr808r", res, sep = "\n") 30 | 31 | if (requireNamespace('clipr', quietly = TRUE)) { 32 | message("Pattern copied to clipboard in text format") 33 | clipr::write_clip(res) 34 | } 35 | 36 | res 37 | } 38 | 39 | 40 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 41 | #' Check if a snippet of text appears to be a text repreentation of a pattern 42 | #' 43 | #' @param txt single string 44 | #' 45 | #' @return TRUE if this is parseable as a valid pattern 46 | #' 47 | #' @noRd 48 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 49 | is_text_pattern <- function(txt) { 50 | 51 | res <- is.character(txt) && length(txt) == 1 && !is.na(txt) 52 | if (!res) { 53 | return(FALSE) 54 | } 55 | 56 | matches <- gregexpr("[x_]{16}", txt) 57 | 58 | return(length(matches[[1]]) == 11) 59 | } 60 | 61 | 62 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 63 | #' Convert a text representation into a \code{tr808_state} object with a single pattern 64 | #' 65 | #' The returned object can be loaded into the drum machine using 66 | #' \code{tr808(state = ...)} 67 | #' 68 | #' @param txt Single string must contain 11 strings of length 16 characters consisting of 69 | #' only \code{_} and \code{x}. All other characters will be ignored. 70 | #' @param bpm bpm. default: 96 71 | #' 72 | #' @return \code{tr808_state} object 73 | #' 74 | #' @export 75 | #' 76 | #' 77 | #' @examples 78 | #' text_to_tr808_state( 79 | #' '#RStats #tr808r 80 | #' BD xx____xx__x_____ 81 | #' SD ____x_______x___ 82 | #' LT ________________ 83 | #' MT xx______________ 84 | #' HT ______xx__x__x__ 85 | #' RS ________________ 86 | #' CP xx_xx_xx_______x 87 | #' CB xx__x_xx_x_x_xx_ 88 | #' CY ________________ 89 | #' OH ________________ 90 | #' CH x_xxx_xxx_xxx_xx' 91 | #') 92 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 93 | text_to_tr808_state <- function(txt, bpm = 96) { 94 | 95 | stopifnot(is.character(txt), length(txt) == 1, !is.na(txt)) 96 | 97 | matches <- gregexpr("[x_]{16}", txt) 98 | 99 | if (length(matches[[1]]) != 11) { 100 | stop("Expected 11 sequences of [x|_]") 101 | } 102 | 103 | strings <- regmatches(txt, matches)[[1]] 104 | 105 | mat <- do.call(rbind, rev(strsplit(strings, ""))) 106 | 107 | res <- as.vector(t(mat)) 108 | 109 | blank_pattern <- expand.grid(x=1:16, y=1:11, active = FALSE) 110 | 111 | first_pattern <- blank_pattern 112 | first_pattern$active <- res == 'x' 113 | 114 | pattern <- rep(list(blank_pattern), NPAT) 115 | pattern[[1]] <- first_pattern 116 | 117 | pattern_set <- logical(NPAT) 118 | pattern_set[[1]] <- TRUE 119 | 120 | list( 121 | pattern_set = pattern_set, 122 | pattern = pattern, 123 | bpm = bpm 124 | ) 125 | 126 | } 127 | 128 | 129 | if (FALSE) { 130 | text <- '#RStats {tr808r} 131 | BD xx____xx__x_____ 132 | SD ____x_______x___ 133 | LT ________________ 134 | MT xx______________ 135 | HT ______xx__x__x__ 136 | RS ________________ 137 | CP xx_xx_xx_______x 138 | CB xx__x_xx_x_x_xx_ 139 | CY ________________ 140 | OH ________________ 141 | CH x_xxx_xxx_xxx_xx' 142 | } 143 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | # tr808r (pronounced ‘traitor’) 5 | 6 | 7 | 8 | ![](https://img.shields.io/badge/cool-useless-green.svg) 9 | 10 | 11 | `{tr808r}` is a tiny sound-a-like for [Roland’s TR-808 drum 12 | machine](https://en.wikipedia.org/wiki/Roland_TR-808). 13 | 14 | This is a tech demo for how 15 | [`eventloop}`](https://github.com/coolbutuseless/eventloop) allows you 16 | to write complex interactive applications using just R. 17 | 18 | ## What’s in the box 19 | 20 | - `tr808()` Start an interactive TR-808 session. 21 | 22 | ## Limitations/Future possibilities 23 | 24 | - No current support for pre-scale selection or accents. 25 | - No support for any level/tone decay tuning of any instrument. 26 | - Base instruments only. No congas, claves or maracas. 27 | 28 | ## Installation 29 | 30 | Note that `{tr808r}` relies on the `{eventloop}` package for handling 31 | the interactivity on macOS and unix-like platforms. 32 | 33 | Windows OS is not supported by `{eventloop}` as R on Windows does not 34 | (currently) support the `onIdle` callback. 35 | 36 | You can install from [GitHub](https://github.com/coolbutuseless/tr808r) 37 | with: 38 | 39 | ``` r 40 | # install.package('remotes') 41 | remotes::install_github('coolbutuseless/eventloop') # >= v0.1.1 42 | remotes::install_github('coolbutuseless/tr808r') 43 | ``` 44 | 45 | ## Compose your own 46 | 47 | - Press SPACE to play/pause. 48 | - Click boxes to toggle playback of that instrument at that time. 49 | - There are 8 editable patterns. 50 | - Use keys ‘1’ to ‘8’ to toggle that pattern as active. This will let 51 | you compose longer rhythms by chaining together multiple patterns. 52 | - Use SHIFT ‘1’ - ‘8’ to immediately jump to a particular pattern. 53 | - UP and DOWN arrows will change BPM (Beats Per Minute). 54 | - Pressing ‘s’ will save the machine state in the current directory in 55 | a time-stamped file. 56 | - This file can be reloaded with `tr808(state = ...)` 57 | - Pressing ‘t’ will output a text representatin of the current pattern 58 | which you can tweet! 59 | - You can play back a tweeted pattern by copying the text from twitter 60 | and passing it in to `tr808(state = ...)` 61 | 62 | ``` r 63 | tr808() 64 | ``` 65 | 66 | #### Watch video with sound 67 | 68 | 69 | 70 | ## Play back an existing song pattern 71 | 72 | Open the drum machine with an existing song. 73 | 74 | ``` r 75 | tr808(state = demo_songs[[1]]) 76 | ``` 77 | 78 | #### Watch video with sound 79 | 80 | ## Tweeting patterns and playing back tweeted patterns 81 | 82 | This is an easy, fun(?) way to share patterns on twitter! 83 | 84 | #### Create your own tweetable 85 | 86 | Press `t` (for twitter) within the application to print a text 87 | representation to your R console. 88 | 89 | If you have [`{clipr}`](https://cran.r-project.org/package=clipr) 90 | installed then the text will also be copied to your clipboard for easy 91 | pasting into twitter! 92 | 93 | #RStats #tr808r 94 | BD xx____xx__x_____ 95 | SD ____x_______x___ 96 | LT ________________ 97 | MT xx______________ 98 | HT ______xx__x__x__ 99 | RS ________________ 100 | CP xx_xx_xx_______x 101 | CB xx__x_xx_x_x_xx_ 102 | CY ________________ 103 | OH ________________ 104 | CH x_xxx_xxx_xxx_xx 105 | 106 | #### Playback a tweet 107 | 108 | If you’d like to play a pattern that someone has tweeted, copy the text 109 | and pass it to `tr808()` as the initial `state` 110 | 111 | ``` r 112 | tr808(state = ' 113 | #RStats #tr808r 114 | BD xx____xx__x_____ 115 | SD ____x_______x___ 116 | LT ________________ 117 | MT xx______________ 118 | HT ______xx__x__x__ 119 | RS ________________ 120 | CP xx_xx_xx_______x 121 | CB xx__x_xx_x_x_xx_ 122 | CY ________________ 123 | OH ________________ 124 | CH x_xxx_xxx_xxx_xx') 125 | ``` 126 | 127 | ## Related Software 128 | 129 | - [Roland’s online version of the TR-808](https://roland50.studio/) 130 | - [Another web TR-808](https://io808.com/) 131 | - [Some classic drum patterns for the 132 | TR-808](http://808.pixll.de/index.php%20patterns) 133 | - [TB-303 Bass 134 | synthesizer](https://en.wikipedia.org/wiki/Roland_TB-303) 135 | 136 | ## Acknowledgements 137 | 138 | - R Core for developing and maintaining the language. 139 | - CRAN maintainers, for patiently shepherding packages onto CRAN and 140 | maintaining the repository 141 | -------------------------------------------------------------------------------- /README.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | output: github_document 3 | --- 4 | 5 | 6 | 7 | ```{r, include = FALSE} 8 | knitr::opts_chunk$set( 9 | collapse = TRUE, 10 | comment = "#>", 11 | fig.path = "man/figures/README-", 12 | out.width = "100%" 13 | ) 14 | 15 | library(tr808r) 16 | 17 | # Convert a video to tweetable format 18 | # ffmpeg -i drummachine-a.mov -vcodec libx264 -vf "pad=ceil(iw/2)*2:ceil(ih/2)*2" -pix_fmt yuv420p -strict experimental -r 30 -t 2:20 -acodec aac -vb 1024k -minrate 1024k -maxrate 1024k -bufsize 1024k -ar 44100 -ac 2 drum-a.mp4 19 | 20 | 21 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 22 | # Generate the pkgdown documentation 23 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 24 | if (FALSE) { 25 | pkgdown::build_site(override = list(destination = "../coolbutuseless.github.io/package/tr808r")) 26 | } 27 | ``` 28 | 29 | # tr808r (pronounced 'traitor') 30 | 31 | 32 | ![](https://img.shields.io/badge/cool-useless-green.svg) 33 | 34 | 35 | `{tr808r}` is a tiny sound-a-like for 36 | [Roland's TR-808 drum machine](https://en.wikipedia.org/wiki/Roland_TR-808). 37 | 38 | This is a tech demo for how 39 | [`eventloop}`](https://github.com/coolbutuseless/eventloop) allows you to 40 | write complex interactive applications using just R. 41 | 42 | ## What's in the box 43 | 44 | * `tr808()` Start an interactive TR-808 session. 45 | 46 | ## Limitations/Future possibilities 47 | 48 | * No current support for pre-scale selection or accents. 49 | * No support for any level/tone decay tuning of any instrument. 50 | * Base instruments only. No congas, claves or maracas. 51 | 52 | ## Installation 53 | 54 | Note that `{tr808r}` relies on the `{eventloop}` package for handling the 55 | interactivity on macOS and unix-like platforms. 56 | 57 | Windows OS is not supported by `{eventloop}` as R on Windows does not 58 | (currently) support the `onIdle` callback. 59 | 60 | You can install from [GitHub](https://github.com/coolbutuseless/tr808r) with: 61 | 62 | ``` r 63 | # install.package('remotes') 64 | remotes::install_github('coolbutuseless/eventloop') # >= v0.1.1 65 | remotes::install_github('coolbutuseless/tr808r') 66 | ``` 67 | 68 | 69 | 70 | ## Compose your own 71 | 72 | * Press SPACE to play/pause. 73 | * Click boxes to toggle playback of that instrument at that time. 74 | * There are 8 editable patterns. 75 | * Use keys '1' to '8' to toggle that pattern as active. This will let you compose 76 | longer rhythms by chaining together multiple patterns. 77 | * Use SHIFT '1' - '8' to immediately jump to a particular pattern. 78 | * UP and DOWN arrows will change BPM (Beats Per Minute). 79 | * Pressing 's' will save the machine state in the current directory in a time-stamped file. 80 | * This file can be reloaded with `tr808(state = ...)` 81 | * Pressing 't' will output a text representatin of the current pattern which you can tweet! 82 | * You can play back a tweeted pattern by copying the text from twitter and passing 83 | it in to `tr808(state = ...)` 84 | 85 | 86 | 87 | ```{r compose, eval = FALSE} 88 | tr808() 89 | ``` 90 | 91 | #### Watch video with sound 92 | 93 | 94 | 95 | 96 | 97 | 98 | ## Play back an existing song pattern 99 | 100 | Open the drum machine with an existing song. 101 | 102 | ```{r demo, eval = FALSE} 103 | tr808(state = demo_songs[[1]]) 104 | ``` 105 | 106 | #### Watch video with sound 107 | 108 | 109 | 110 | 111 | ## Tweeting patterns and playing back tweeted patterns 112 | 113 | This is an easy, fun(?) way to share patterns on twitter! 114 | 115 | #### Create your own tweetable 116 | 117 | Press `t` (for twitter) within the application to print a text representation to 118 | your R console. 119 | 120 | If you have [`{clipr}`](https://cran.r-project.org/package=clipr) installed then 121 | the text will also be copied to your clipboard for easy pasting into twitter! 122 | 123 | ``` 124 | #RStats #tr808r 125 | BD xx____xx__x_____ 126 | SD ____x_______x___ 127 | LT ________________ 128 | MT xx______________ 129 | HT ______xx__x__x__ 130 | RS ________________ 131 | CP xx_xx_xx_______x 132 | CB xx__x_xx_x_x_xx_ 133 | CY ________________ 134 | OH ________________ 135 | CH x_xxx_xxx_xxx_xx 136 | ``` 137 | 138 | #### Playback a tweet 139 | 140 | If you'd like to play a pattern that someone has tweeted, copy the text and pass 141 | it to `tr808()` as the initial `state` 142 | 143 | ```{r eval=FALSE} 144 | tr808(state = ' 145 | #RStats #tr808r 146 | BD xx____xx__x_____ 147 | SD ____x_______x___ 148 | LT ________________ 149 | MT xx______________ 150 | HT ______xx__x__x__ 151 | RS ________________ 152 | CP xx_xx_xx_______x 153 | CB xx__x_xx_x_x_xx_ 154 | CY ________________ 155 | OH ________________ 156 | CH x_xxx_xxx_xxx_xx') 157 | ``` 158 | 159 | 160 | 161 | ## Related Software 162 | 163 | * [Roland's online version of the TR-808](https://roland50.studio/) 164 | * [Another web TR-808](https://io808.com/) 165 | * [Some classic drum patterns for the TR-808](http://808.pixll.de/index.php patterns) 166 | * [TB-303 Bass synthesizer](https://en.wikipedia.org/wiki/Roland_TB-303) 167 | 168 | ## Acknowledgements 169 | 170 | * R Core for developing and maintaining the language. 171 | * CRAN maintainers, for patiently shepherding packages onto CRAN and maintaining 172 | the repository 173 | -------------------------------------------------------------------------------- /R/tr808.R: -------------------------------------------------------------------------------- 1 | 2 | globalVariables(c('x', 'active')) 3 | 4 | 5 | 6 | PATTERN_UI_OFFSET <- 0.2 7 | PATTERN_UI_SCALE <- 0.8 8 | NPAT <- 8 # 8 patterns 9 | 10 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 11 | # Draw the tempo/tracer across the top 12 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 13 | draw_tracer <- function(i) { 14 | cols <- rep('grey30', 16) 15 | cols[i] <- 'grey80' 16 | grid::grid.rect( 17 | x = (seq(0, 1, length.out = 17)[-17] + 1/32) * PATTERN_UI_SCALE + PATTERN_UI_OFFSET, 18 | y = 0.975, 19 | width = 0.045, height = 0.05, 20 | just = c(0.5, 1), 21 | gp = grid::gpar(fill = cols) 22 | ) 23 | } 24 | 25 | 26 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 27 | # Draw the pattern editor UI 28 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 29 | draw_current_pattern <- function() { 30 | 31 | pattern <- env$pattern[[env$current_pattern_idx]] 32 | 33 | fill <- pattern_ui_dark_cols 34 | fill[pattern$active] <- pattern_ui_light_cols[pattern$active] 35 | 36 | grid.rect( 37 | width = 0.04, 38 | height = 0.065, 39 | x = (pattern$x / 16 - 1/32) * PATTERN_UI_SCALE + PATTERN_UI_OFFSET, # 16 beats 40 | y = pattern$y / 12 - 1/24, # 11 instruments 41 | gp = gpar(fill = fill) 42 | ) 43 | 44 | } 45 | 46 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 47 | # Update the state of the pattern based upon mouse click position 48 | # Thic function is called when mouse is clicked, and if it corresponds 49 | # to an element in the pattern deck, then set this value to active 50 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 51 | update_current_pattern <- function(mouse_x, mouse_y) { 52 | 53 | # Instrument pattern 54 | pattern <- env$pattern[[env$current_pattern_idx]] 55 | 56 | x <- ceiling((mouse_x - PATTERN_UI_OFFSET) / PATTERN_UI_SCALE * 16) 57 | y <- ceiling(mouse_y * 11 / (1 - 0.065)) 58 | 59 | idx <- pattern$x == x & pattern$y == y 60 | 61 | pattern[idx, 'active'] <- !pattern[idx, 'active'] 62 | 63 | env$pattern[[env$current_pattern_idx]] <- pattern 64 | } 65 | 66 | 67 | 68 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 69 | # Draw Pattern Select UI 70 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 71 | draw_pattern_selection <- function() { 72 | 73 | fills <- c('grey20', 'dodgerblue3')[env$pattern_set + 1L] 74 | 75 | cols <- rep(BLACK, NPAT) 76 | cols[env$current_pattern_idx] <- 'WHITE' 77 | 78 | y <- c( 79 | 0.95, 0.95, 0.95, 0.95, 80 | 0.92, 0.92, 0.92, 0.92 81 | ) + 0.014 82 | 83 | grid::grid.rect( 84 | x = seq_len(NPAT/2) / 48 + 4/48, 85 | y = y, 86 | width = 1/55, 87 | height = 1/36, 88 | gp = gpar(col = cols, fill = fills, lwd = 3) 89 | ) 90 | 91 | grid::grid.text( 92 | label = seq_len(NPAT), 93 | x = seq_len(NPAT/2) / 48 + 4/48, 94 | y = y, 95 | gp = gpar( 96 | fontfamily = 'sans', 97 | col = 'white', 98 | cex = 1 99 | ) 100 | ) 101 | } 102 | 103 | 104 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 105 | # Update pattern select 106 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 107 | update_pattern_selection <- function(idx) { 108 | # user has pressed a key in "1" - NPAT 109 | idx <- as.integer(idx) 110 | env$pattern_set[idx] <- !env$pattern_set[idx] 111 | 112 | # If the user turned off the last valid pattern, 113 | # then turn on pattern #1 114 | if (!any(env$pattern_set)) env$pattern_set[1] <- TRUE 115 | } 116 | 117 | 118 | 119 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 120 | # Render the names of the instruments somehow 121 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 122 | draw_instrument_names <- function() { 123 | y <- (1:11) / 12 - 1/24 124 | 125 | for (yi in y) { 126 | grid::grid.roundrect( 127 | x = 0.02, 128 | y = yi, 129 | width = 0.16, 130 | height = 0.05, 131 | just =c(0, 0.5), 132 | r = unit(0.2, 'snpc'), 133 | gp = gpar(col = NA, fill = LABEL_YELLOW) 134 | ) 135 | } 136 | 137 | grid::grid.text( 138 | tr808r::sample_names, 139 | x = 0.03, y = y, 140 | hjust = -0.1, 141 | gp = gpar( 142 | fontfamily = 'sans', 143 | col = 'black', 144 | cex = 1.75 145 | ) 146 | ) 147 | } 148 | 149 | 150 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 151 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 152 | reset_current_pattern <- function() { 153 | 154 | pattern <- expand.grid(x=1:16, y=1:11, active = FALSE) 155 | 156 | env$pattern[[env$current_pattern_idx]] <- pattern 157 | 158 | draw_current_pattern() 159 | } 160 | 161 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 162 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 163 | reset_all_patterns <- function() { 164 | 165 | pattern <- expand.grid(x=1:16, y=1:11, active = FALSE) 166 | 167 | env$pattern <- rep(list(pattern), NPAT) 168 | 169 | draw_current_pattern() 170 | } 171 | 172 | 173 | 174 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 175 | # Render the BPM info 176 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 177 | draw_bpm <- function() { 178 | 179 | # Rectangle underneath 180 | grid::grid.roundrect( 181 | x = 0.01, y = 0.95, 182 | r = unit(0.1, 'snpc'), 183 | width = 0.06, 184 | height = 0.05, 185 | just = c(0, 0.5), 186 | gp = gpar( 187 | col = NA, 188 | fill = 'pink' 189 | ) 190 | ) 191 | 192 | # BPM text on top 193 | grid::grid.text( 194 | env$bpm, 195 | x = 0.06, 196 | y = 0.95, 197 | hjust = 1, 198 | gp = gpar( 199 | fontfamily = 'sans', 200 | col = 'black', 201 | cex = 1.75 202 | ) 203 | ) 204 | } 205 | 206 | 207 | 208 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 209 | #' Initialise function for eventloop 210 | #' 211 | #' @return None 212 | #' @export 213 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 214 | tr808_init <- function() { 215 | 216 | env$playing <- TRUE 217 | env$count <- 0L 218 | env$pattern <- NULL 219 | env$pattern_set <- logical(NPAT) 220 | env$pattern_set[1] <- TRUE 221 | env$current_pattern_idx <- 1L 222 | 223 | reset_all_patterns() 224 | 225 | if (!is.null(env$init_state)) { 226 | env$pattern <- env$init_state$pattern 227 | env$pattern_set <- env$init_state$pattern_set 228 | env$current_pattern_idx <- which(env$pattern_set)[[1]] 229 | 230 | env$init_state <- NULL 231 | } 232 | 233 | # Set background 234 | grid.rect(gp = gpar(col = NA, fill = BLACK)) 235 | 236 | # Draw components 237 | draw_pattern_selection() 238 | draw_current_pattern() 239 | draw_instrument_names() 240 | draw_bpm() 241 | } 242 | 243 | 244 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 245 | # Run the frame rate at a faster multiple of the BPM so that the UI 246 | # is more responsive. 247 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 248 | FPS_MULT <- 4 249 | SHIFT <- log2(FPS_MULT) 250 | 251 | 252 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 253 | #' Main TR808 eventloop callback 254 | #' 255 | #' @param event,mouse_x,mouse_y,event_env,... eventloop args 256 | #' 257 | #' @import grid 258 | #' @import audio 259 | #' @export 260 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 261 | tr808_func <- function(event, mouse_x, mouse_y, event_env, ...) { 262 | 263 | i <- ( bitwShiftR(env$count, SHIFT) %% 16L) + 1L 264 | 265 | # Only 'play' audio every n'th frame 266 | play_audio <- (env$count %% FPS_MULT) == 0 267 | 268 | 269 | # Update patterns on first note of first beat 270 | if (play_audio && env$playing && i == 1 && env$count != 0) { 271 | all_pattern_indices <- which(env$pattern_set) 272 | pattern_indices <- all_pattern_indices[all_pattern_indices > env$current_pattern_idx] 273 | if (length(pattern_indices) == 0) { 274 | # Loop around to first index 275 | next_pattern_idx <- all_pattern_indices[1] 276 | if (next_pattern_idx != env$current_pattern_idx) { 277 | env$current_pattern_idx <- next_pattern_idx 278 | draw_current_pattern() 279 | draw_pattern_selection() 280 | } 281 | } else { 282 | # Move to next pattern, and update the pattern 283 | env$current_pattern_idx <- pattern_indices[1] 284 | draw_current_pattern() 285 | draw_pattern_selection() 286 | } 287 | } 288 | 289 | 290 | 291 | if (play_audio && env$playing) { 292 | draw_tracer(i) 293 | 294 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 295 | # Find instruments active at this time step and play them 296 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 297 | now <- subset(env$pattern[[env$current_pattern_idx]], x == i & active) 298 | for (sample_idx in now$y) { 299 | sample_name <- tr808r::sample_names[[sample_idx]] 300 | audio::play(samples[[sample_name]]) 301 | } 302 | } 303 | 304 | if (env$playing) { 305 | env$count <- env$count + 1L 306 | } 307 | 308 | 309 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 310 | # Mouse clicks update the active state of the instrument pattern 311 | # Keys: 312 | # c - clear pattern 313 | # SPACE = play/pause 314 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 315 | shifted_nums <- c('!', '@', '#', '$', '%', '^', '&', '*') 316 | if (!is.null(event)) { 317 | if (event$type == 'key_press') { 318 | if (event$str == 'c') { 319 | reset_current_pattern() 320 | draw_pattern_selection() 321 | } else if (event$str == ' ') { 322 | env$playing <- !env$playing 323 | } else if (event$str %in% seq_len(NPAT)) { 324 | update_pattern_selection(event$str) 325 | draw_pattern_selection() 326 | } else if (event$str %in% shifted_nums) { 327 | idx <- which(shifted_nums == event$str) 328 | env$pattern_set[idx] <- TRUE 329 | env$current_pattern_idx <- idx 330 | draw_pattern_selection() 331 | draw_current_pattern() 332 | } else if (event$str %in% c('-', '_', 'Down')) { 333 | env$bpm <- env$bpm - 1L 334 | event_env$fps_target <- bpm_to_fps(env$bpm) 335 | draw_bpm() 336 | } else if (event$str %in% c('+', '=', 'Up')) { 337 | env$bpm <- env$bpm + 1L 338 | event_env$fps_target <- bpm_to_fps(env$bpm) 339 | draw_bpm() 340 | } else if (event$str == 's') { 341 | datestamp <- strftime(Sys.time(), "%Y%m%d-%H:%M:%S") 342 | filename <- paste0('tr808-', datestamp, ".rds") 343 | message("Saved to: ", filename) 344 | save_obj <- list( 345 | pattern_set = env$pattern_set, 346 | pattern = env$pattern, 347 | bpm = env$bpm 348 | ) 349 | saveRDS(save_obj, file = filename) 350 | } else if (event$str == 't') { 351 | cat(pattern_to_text(env$pattern[[env$current_pattern_idx]])) 352 | } 353 | } else if (event$type == 'mouse_down') { 354 | update_current_pattern(mouse_x, mouse_y) 355 | draw_current_pattern() 356 | } 357 | 358 | } 359 | 360 | 361 | } 362 | 363 | 364 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 365 | # Run the FPS at a multiple of the BPM 366 | # E.g. 96 BPM is only 6.4Hz 367 | # Having a framerate of 6.4Hz makes the UI feel really unresponsive 368 | # So just multiply by a factor, and divide by this factor later on 369 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 370 | bpm_to_fps <- function(bpm) { 371 | bpm * 4 / 60 * FPS_MULT 372 | } 373 | 374 | 375 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 376 | # Is this object a valid pattern of 11instruments * 16 notes 377 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 378 | is_pattern <- function(pattern) { 379 | is.data.frame(pattern) && 380 | nrow(pattern) == 176 && 381 | !anyNA(pattern) && 382 | all(pattern$x %in% 1:16) && 383 | all(pattern$y %in% 1:11) && 384 | all(pattern$active %in% c(TRUE, FALSE)) 385 | } 386 | 387 | 388 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 389 | # Is this a valid list of patterns? 390 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 391 | is_pattern_list <- function(pattern) { 392 | is.list(pattern) && 393 | length(pattern) == NPAT && 394 | !anyNA(pattern) && 395 | all( 396 | vapply(pattern, is_pattern, logical(1)) 397 | ) 398 | } 399 | 400 | 401 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 402 | # Is this a valid tr808 state? 403 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 404 | is_tr808_state <- function(state) { 405 | is.list(state) && 406 | is.logical(state$pattern_set) && 407 | !anyNA(state$pattern_set) && 408 | any(state$pattern_set) && 409 | is_pattern_list(state$pattern) && 410 | is.numeric(state$bpm) && 411 | !is.na(state$bpm) 412 | } 413 | 414 | 415 | 416 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 417 | #' TR-808 418 | #' 419 | #' @param width,height,... arguments passed to \code{eventloop::run_loop()} 420 | #' @param bpm beats per minute. default: 96 421 | #' @param state a \code{tr808_state} object or the path of a saved object in 422 | #' an RDS file. Note: Pressing 's' within the interactive drum machine 423 | #' window will save the current state to a time stamped RDS file. 424 | #' 425 | #' @importFrom utils packageVersion 426 | #' @import eventloop 427 | #' @export 428 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 429 | tr808 <- function(bpm = 96, width = 12, height = 8, state = NULL, ...) { 430 | 431 | if (!interactive()) { 432 | stop("Running this app only makes sense when R is interactive") 433 | } 434 | 435 | if (packageVersion('eventloop') < "0.1.1") { 436 | stop("Need {eventloop} v0.1.1\nremotes::install_github('coolbutuseless/eventloop')") 437 | } 438 | 439 | 440 | if (!is.null(state)) { 441 | if (is_tr808_state(state)) { 442 | # do nothing 443 | } else if (file.exists(state)) { 444 | state <- readRDS(state) 445 | if (!is_tr808_state(state)) { 446 | stop("File specified does not contain a tr808 state object") 447 | } 448 | } else if (is_text_pattern(state)) { 449 | state <- text_to_tr808_state(state) 450 | } else { 451 | stop("'state' argument must be a tr808 state object, a file path to a ", 452 | "saved object in RDS format, or a text string coercible to a", 453 | " pattern") 454 | } 455 | env$init_state <- state 456 | 457 | # Use BPM of the loaded object rather than function argument 458 | bpm <- state$bpm 459 | } 460 | 461 | 462 | env$bpm <- as.integer(bpm) 463 | 464 | fps <- bpm_to_fps(bpm) 465 | message("BPM: ", bpm, " FPS: ", fps) 466 | message("SPACE to play/pause") 467 | message("'c' to clear current pattern") 468 | message("'s' to save tr808 state (load with 'state = ...' argument)") 469 | message("'t' to copy tweetable text to clipboard/print to console") 470 | message("'1'-'8' to toggle pattern for playback") 471 | message("SHIFT + '1'-'8' to jump immediately to this pattern (usually best when PAUSED)") 472 | message("+/- Up/Down to adjust BPM") 473 | 474 | 475 | eventloop::run_loop( 476 | tr808_func, init_func = tr808_init, 477 | width = width, height = height, 478 | fps_target = fps, ..., double_buffer = FALSE 479 | ) 480 | } 481 | 482 | 483 | 484 | if (FALSE) { 485 | library(eventloop) 486 | run_loop(tr808_func, init_func = tr808_init, bpm = 96) 487 | } 488 | --------------------------------------------------------------------------------