diff options
| author | LLLL Colonq <llll@colonq> | 2024-03-26 23:34:28 -0400 |
|---|---|---|
| committer | LLLL Colonq <llll@colonq> | 2024-03-26 23:34:28 -0400 |
| commit | 782c667e824d426b5443591afeefc37d0ae17785 (patch) | |
| tree | ae5d232d598e2008bc2cadf32157a4d937b01951 /src/contrib | |
| parent | 8e9db9303fc5d72ddfdc9ab4a9adaa8299e6e21a (diff) | |
We streamed for 9 hours and (mostly) fixed everything.
Diffstat (limited to 'src/contrib')
| -rw-r--r-- | src/contrib/bezelea-muzak-old.el | 112 | ||||
| -rw-r--r-- | src/contrib/bezelea-muzak.el | 754 | ||||
| -rw-r--r-- | src/contrib/prod-bless-srfi.el | 29 |
3 files changed, 895 insertions, 0 deletions
diff --git a/src/contrib/bezelea-muzak-old.el b/src/contrib/bezelea-muzak-old.el new file mode 100644 index 00000000..6bc1e2c6 --- /dev/null +++ b/src/contrib/bezelea-muzak-old.el @@ -0,0 +1,112 @@ +;;; bezelea-muzak.el --- Musical shiznit -*- lexical-binding: t -*- +;;; Commentary: +;;; Code: +(require 's) +(require 'dash) + +(defvar muzak-music-alist '() "List of songs.") + +(setq muzak-music-alist '( + ("At Hell's Gate" . "EEeEEdEEcEEA#EEBc EEeEEdEEcEEA#A#A#A#/") + ("Beethoven's 5th" . "AAAF////GGGE////") + ("Coffin Dance" . "D/DAG/F/E/EFG/FED/DcBcBcDDDcBcBc") + ("Crazy Train" . "F#F#c#F#dF#c#F#BAG#ABAG#EF#F#c#F#dF#c#F#BAG#ABAG#E") + ("Do Re Mi 5" . "C//DE/C/E/C/E//D//EFFEDF//E//FG/E/G/E/G/G/F/GAAGFA////G/CDEFGA/A/DEFGABB") + ("Do Your Ears Hang Low" . "AGF/F/F/AAcdcAc/FGAAAAAAFGAGG/G/AGFFFFFFAAcdcAc/FGA///G///F") + ("Duvet" . "F/E/D/E/F/G//A//DDD/////C//////F/E/D/E/F/G//G//G///F///E") + ("Eye Of The Tiger" . "A/B/c///c/cc/B//A/G/G/A/B/A///A//B//c///c/cc/B//AG/B/A") + ("Fly Me To The Moon (Short)" . "c//BAG/E///EGc/B//AGF/EDE") + ("Fly Me To The Moon" . "c//BAG/E///EGc/B//AGF/EDE//////AGFE/D/E/F/A/G//FED/C//////DDAA///////c/B/G////////CCFF//////A/G/F//E/") + ("Frere Jacques (Slow)" . "C/D/E/C/C/D/E/C/E/F/G///E/F/G///GAGFE/C/GAGFE/C/G/C///C/G/C///") + ("Frere Jacques" . "CDECCDECEFG/EFG/") + ("Harry Potter" . "AcBA/ed//B//AcBG/AE///") + ("King of the Hill" . "C/CCCCCE/CCCCCF/FFFA/G///CCCCECCCF/E/D/DEDCCCCCECCCFFFAG//c/A/G/F/EEEFEDCcc") + ("Leaving on a Jet Plane" . "G///E///A/GF/G///G/E/G/F/GF/EC") + ("Major Scale" . "C/D/E/F/G/A/B/c/d/e/f/g/a/b/") + ("Mario (Fast)" . "AA/A/FA/c///C/") + ("Mario" . "A/A///A//F/A///c/////C/") + ("Megalovania" . "DDd/A//G#/G/F/DFG CCd/A//G#/G/F/DFG BBd/A//G#/G/F/DFG A#A#d/A//G#/G/F/DFG/") + ("Megalovania2" . "EEe/B//A#/A/G/EGA DDe/B//A#/A/G/EGA C#C#e/B//A#/A/G/EGA CCe/B//A#/A/G/EGA ") + ("Never Gonna Give You Up" . "CDFDA/A/G///CDFDG/G/G/F/ED///CDFD/F/G/E/DC/CC/G//F") + ("Pizza Tower 2" . "//A/E/G///A/E/G///ABABAGEDEE") + ("Pizza Tower" . "A/E/G///A/E/G///ABABAGEDE") + ("Santa Claus Is Coming To Town" . "EFG/G///ABc/c///EFG/G/G/AGF/F///E/G/C/E/D/F///B/c") + ("Saria's Song" . "FAB/FAB/FABed/BcBGE//DEGE/") + ("Silent Night" . "G//AG/E/////G//AG/E/////d///d/B/////c///c/G") + ("Smells Like Teen Spirit" . "E/EE//AAAAAG/GG//c/cccc") + ("Song of Healing" . "B//A//F//B//A//F//B//A//EDE/") + ("Song of Time" . "A/D///F/A/D///F/AcB/G/FGA/D/CED") + ("Star Spangled Banner" . "EDC/E/G/c//edc/E/F/G") + ("State Anthem of the Russian Federation" . "//G/c///G//AB///E/E/A///G//FG///C/C/D///D/E/F///F/G/A///B/c/dd") + ("Super Idol" . "ddd#dcA#G/cA#G/A#/c/c/dcA#cd/GGG/A#/G/ddd#dcA#dc/dG/A#A#A/AAd/d/A#/") + ("Take Me Out To The Ball Game" . "C/cAGEG//D//C/cAGEG") + ("Take Me Out" . "c/A///G/GA/////c/A///G/GA/////c/A/////G//G/A") + ("Take On Me" . "BBGE/E/A/A/ABBcdccGE/E/A/A/AGGAG") + ("Wish You Were Here" . "C/DEG/A///c/////A/c/A/G///////C/DEG/A///c//////A/c/A/G//////C/DEG/A//////A/G/E/D//////C/DEG/A//////A/G/E/D") + ("Zelda Secret" . "f#fdG#Gd#gb") + )) + +(defun muzak--note-to-half-step (note) + "Determine the step of NOTE in the C chromatic scale." + (when-let* ((step (-elem-index (upcase note) '("C" "C#" "D" "D#" "E" "F" "F#" "G" "G#" "A" "A#" "B")))) + (if (s-uppercase? note) + (- step 9) + (+ step 3)))) ; C is the 3rd semitone above A + +(defun muzak--note-to-freq (note) + "Calculate the frequency of NOTE." + (if-let ((step (muzak--note-to-half-step note))) + (round (* 440 (expt 2 (/ step 12.0)))) + 0)) + +(defun muzak--parse-notes (note-string) + "Parse notes from NOTE-STRING." + (append (mapcar #'car (s-match-strings-all "/\\|[A-Za-z]#?" note-string)) + '("/"))) + +(defun muzak--get-notes (song-name) + "Look up notes of SONG-NAME from `muzak-music-alist'." + (muzak--parse-notes + (alist-get song-name muzak-music-alist nil nil #'cl-equalp))) + +(defun muzak-add-song (name notes &optional author) + "Add a song to `muzak-music-alist'. +NAME specifies the name of the song. +NOTES is a string of notes and rests. +AUTHOR is the name of whoever the transcription can be attributed to." + (when author (message "%s added %s to the muzak list." author name)) + (add-to-list 'muzak-music-alist '(name . notes))) + +(defun muzak-stop () + "Fuck it, we ball." + (interactive) + (call-process-shell-command "killall ffplay")) + +(defun muzak-play-notes (notes &optional duration) + "Play notes. +NOTES should be a string or sequence of notes and rests. Each note is notated as +letters A-G in the chromatic scale, optionally followed by a # to denote a +sharp. Forward slashes are interpreted as rests. Uppercase letters are used for +the lower octave and lowercase letters are the higher octave. +DURATION is the length of each note in seconds." + (if (stringp notes) + (muzak-play-notes (muzak--parse-notes notes) duration) + (call-process-shell-command + (format " +for FREQ in %s; do + ffmpeg -strict experimental -loglevel quiet -f lavfi -i \"sine=frequency=${FREQ}:duration=%f\" -f oga -filter tremolo -filter aphaser=in_gain=0.4:out_gain=0.74:delay=0.1:decay=0.2:speed=0.2 -filter volume=1.5 - 2>/dev/null +done | ffplay -loglevel quiet -autoexit -nodisp - &" + (mapconcat (lambda (note)(format "%d" (muzak--note-to-freq note))) notes " ") + (or duration 0.2))))) + +(defun muzak-play-song (song-name) + "Play SONG-NAME from `muzak-music-alist'." + (interactive "sSong Name: ") + (message "Playing %s" song-name) + (when-let (song-data (muzak--get-notes song-name)) + (muzak-play-notes song-data))) + +;(muzak-play-notes (-flatten (cl-map 'list (lambda (x) (append (muzak--get-notes x) (-repeat 3 "/"))) '("Zelda Secret" "Song of Healing" "Saria's Song" "Song of Time"))) 0.15) + +(provide 'bezelea-muzak) +;;; bezelea-muzak.el ends here diff --git a/src/contrib/bezelea-muzak.el b/src/contrib/bezelea-muzak.el new file mode 100644 index 00000000..97f9e3be --- /dev/null +++ b/src/contrib/bezelea-muzak.el @@ -0,0 +1,754 @@ +;;; bezelea-muzak.el --- Musical shiznit -*- lexical-binding: t -*- +;;; Commentary: +;; +;; +;; A simple text notation player and music library. +;; Examples can be found in `muzak//song-table'. +;; For more information, see https://pub.colonq.computer/~bezelea/bells/ +;; +;; +;;; Code: + +(require 'cl-lib) +(require 'dash) +(require 'ht) +(require 's) +(require 'wasp-db) + +(defconst muzak//min-bpm 50 "Minimum beats per minute.") +(defconst muzak//max-bpm 200 "Maximum beats per minute.") +(defconst muzak//max-length 400 "Maximum number of notes in a song.") +(defconst muzak//max-duration 60 "Maximum song length in seconds.") +(defconst muzak//middle-octave 4 "Middle octave. Used as default.") +(defconst muzak//process-name "muzak-ffplay" "Name for FFplay processes.") +(defvar muzak//process nil "FFplay process for muzak.") +(defvar muzak//song-queue nil "Queued audio sources.") +(defvar muzak/note-duration 0.2 "Duration of each note in seconds.") +(defvar muzak/volume 0.4 "Amplitude used in FFplay invocations.") +(defvar muzak/instrument 'beep "Lead instrument.") + +(defconst muzak//note-string-regexp + (rx + (submatch (or "/" (any "A-G")) (? "#")) + (submatch (? digit)) + (submatch (0+ "~")))) + +(defconst muzak//notes-string-regexp + (rx (or (group "[" (* (not "]")) "]") + (group (or "/" (: (any "A-G") (? "#") (? digit) (0+ "~"))))))) + +(defconst muzak//waveforms + (list (cons 'sine (lambda (f) (format "sin(t*%.2f)" (* 2 pi f)))) + (cons 'square (lambda (f) (format "ceil(sin(t*%.2f))" (* 2 pi f)))) + (cons 'triangle (lambda (f) (format "asin(sin(t*%.2f))" (* 2 pi f)))) + (cons 'sawtooth (lambda (f) (format "(atan(tan(t*%.2f))/%.2f)" (* 2 pi f) (/ pi 2)))) + (cons 'sine-octaver (lambda (f) (format "(sin(t*%.2f)+sin(t*%.2f))" (* 2 pi f) (* pi f))))) + "List of formatting functions for generating FFmpeg aevalsrc strings.") + +(defconst muzak//waveform-effects + (list (cons 'dampen (lambda (s d) (format "pow(2.72,-10*%.1f*(t-%.1f))" muzak/note-duration s))) + (cons 'swell (lambda (s d) (format "((t-%.1f)/%.1f)" s (+ d)))) + (cons 'linear (lambda (s d) (format "(1-(t-%.1f)*%.1f)" s (/ 1.0 (* 2 d))))) + (cons 'noise (lambda (s d) (format "(sin(10*random(0)))"))) + (cons 'rotary (lambda (s d) (format "abs(1-mod(t,2))"))) + (cons 'rotaryslow (lambda (s d) (format "sin(%.2f*t)" (* 0.3 pi)))) + (cons 'rotaryfast (lambda (s d) (format "sin(%.2f*t)" (* 10 pi)))) + (cons 'rotarywtf (lambda (s d) (format "(sin(2*PI*178.75*t)+sin(2*PI*181.25*t))"))) + (cons 'horror (lambda (s d) (format "sin(2*PI*(360+2.5/2)*t)"))) + (cons 'aliens (lambda (s d) (format "(0.8*mod(t*100,2))")))) + "List of formatting functions for generating FFmpeg aevalsrc strings.") + +(cl-defstruct (muzak/instrument (:constructor muzak/make-instrument)) + "Instrument definition." + (waveform 'sine) + (effects '(dampen)) + (sustain 0)) + +(defconst muzak//instruments + (list + (cons 'beep (muzak/make-instrument :waveform 'sine :effects nil)) + (cons 'bells (muzak/make-instrument :waveform 'square :effects '(dampen) :sustain 4)) + (cons 'keyboard (muzak/make-instrument :waveform 'square :effects '(linear))) + (cons 'waterphone (muzak/make-instrument :waveform 'triangle :effects '(swell))) + (cons 'test (muzak/make-instrument :waveform 'sine :effects '(aliens) :sustain 0))) + "List of instruments.") + +(cl-defstruct (muzak/note (:constructor muzak/make-note)) + "Representation of a musical note. + +Each note's SYMBOL is notated as letters A-G in the chromatic scale, optionally +followed by a '#' to denote a sharp. +Forward slashes are interpreted as rests. +Uppercase and lowercase letters can be used in lieu of an OCTAVE for the middle +and higher octaves, respectively. + +OCTAVE can be any number. + +LENGTH determines the duration of the note when multiplied by `muzak/note-duration'. +" + symbol + (octave muzak//middle-octave) + (length 1)) + +(defconst muzak//chromatic-scale + (list "C" "C#" "D" "D#" "E" "F" "F#" "G" "G#" "A" "A#" "B") + "Chromatic scale.") + +(defconst muzak//degrees + `((major . (0 2 4 5 7 9 11 12)) ; Ionian mode + (minor . (0 2 3 5 7 8 10 12)) ; Aeolian mode + (dorian . (0 2 3 5 7 9 10 12)) + (phrygian . (0 1 3 5 7 8 10 12)) + (lydian . (0 2 4 6 7 9 11 12)) + (mixolydian . (0 2 4 5 7 9 10 12)) + (locrian . (0 1 3 5 6 8 10 12)) + (chromatic . (0 1 2 3 4 5 6 7 8 9 10 11 12)) + (pentatonic . (0 3 5 7 10 12))) + "Intervals of degrees within various scales.") + +(defconst muzak//qualities + `((major . (0 4 7)) ; Root, major 3rd, and perfect 5th + (minor . (0 3 7)) ; Root, minor 3rd, and perfect 5th + (maj7 . (0 4 7 11)) ; Major 3rd and 7th + (min7 . (0 3 7 10)) ; Minor 3rd and 7th + (dom7 . (0 4 7 10)) ; Major 3rd and minor 7th + (majmin7 . (0 4 7 10)) ; Major 3rd and minor 7th (alias: dom7) + (minmaj7 . (0 3 7 11)) ; Minor 3rd and major 7th + (dim . (0 3 6)) ; Minor 3rd, diminished 5th + (dim7 . (0 3 6 9)) ; Minor 3rd, diminished 5th, and diminished 7th + (halfdim7 . (0 3 6 10)) ; Minor 3rd, diminished 5th, and minor 7th + (aug . (0 4 8)) ; Major 3rd and augmented 5th + (aug7 . (0 4 8 11)) ; The MrBeast of music?! + (sus2 . (0 2 7)) ; Major 2nd and perfect 5th + (sus4 . (0 5 7)) ; Perfect 4th and perfect 5th + (power . (0 7 12))) ; Rock n' Roll + "Intervals describing various chord qualities.") + +(defvar muzak//song-table + (ht + ("All I Want For Christmas Is You" "gbd/f#g/f#/e/d//a/g/gf#/g/f#/d//dc//e/g/ab/a/g/e//c/d#/g/aa#/a/d#//a/g/f#f#/g/f#/e/d//G/B/df#/g/f#/e/d//bbba/b/a/g/e//c/d#/gaga#/a/fd#//ga/f#/g/e/f#/d#///ga/f#/g/e/f#/d#//D/E/G/d/c/dc//b/a/g/e/d#/a///b/ag//B///dB/B//A") + ("Among Us" "C/D#/F/F#/F/D#/C/A#/D/C//C/D#/F/F#/F/D#/F#/F#/F/D#/F#/F/D#/C//") ;DocMaho + ("At Hell's Gate" "|EEeEEdEEcEEA#EEBc EEeEEdEEcEE[EA#~~~]/") + ("Bad Apple" "DEFGA/dcA/D/AGFEDEFGA/GFEDEFEDCE DEFGA/dcA/D/AGFEDEFGA/GFE/F/G/A") + ("Beethoven's 5th" "GGGD#////FFFD////") + ("Billy Jean" "F#F#E/C#/F#F#/E/C#///F#F#E/C#/F#A/B/AG#F#////F#/F#c#/B/F#D/C#//") + ("Butterfly" "GGGA#c/GA#cd#cA#G///F/FGA#/GD#FGFD#C") + ("Canon in D" "dc#dDC#AEF#Ddc#Bc#f#abgf#egf#edc#BAGF#EGF#ED") + ("Coffin Dance" "D/DAG/F/E/EFG/FED/DcBcBcDDDcBcBc") + ("Crazy Train" "F#F#c#F#dF#c#F#BAG#ABAG#EF#F#c#F#dF#c#F#BAG#ABAG#E") + ("Cruel Angel's Thesis" "C~~~D#~~~F~~D#~~F~F~F~A#~G#~GF~G~~~/G~~~A#~~~c~~F~~D#~A#~A#~G~A#~A#~~c~~~~~~") + ("Deck The Halls" "c//A#A/G/F/G/A/F/GAA#GA//GF/E/F/") + ("Do Re Mi" "C//DE/C/E/C/E//D//EFFEDF//E//FG/E/G/E/G/G/F/GAAGFA////G/CDEFGA/A/DEFGABB") + ("Do Your Ears Hang Low" "AGF/F/F/AAcdcAc/FGAAAAAAFGAGG/G/AGFFFFFFAAcdcAc/FGA///G///F") + ("Duvet" "F/E/D/E/F/G//A//DDD/////C//////F/E/D/E/F/G//G//G///F///E") + ("Eye Of The Tiger" "A/B/c///c/cc/B//A/G/G/A/B/A///A//B//c///c/cc/B//AG/B/A") + ("Fly Me To The Moon" "c~~BAG~E~~/EGc~B~~AGF/EDE~/////AGFE/D/E/F/A/G~~FED/C~~////DDAA~~~////c~B~G~~~/////CCFF~~~///A~G~F~~E~~") + ("Frere Jacques" "C/D/E/C/C/D/E/C/E/F/G///E/F/G///GAGFE/C/GAGFE/C/C/G3/C///C/G3/C///") + ("Geiser's Tune" "c#Ag#A~c#g#Ac#G#g#G#~c#g#ec#F#g#F#~c#g#F#c#bag#f#~~~e~d#~B~~~c#bag#f#~~~e~d#~B~~|C#C#C#C#C#C#C#C#C#C#C#C#C#C#C#C#C#C#C#C#C#C#C#C#C#C#C#EC#C#C#C#C#EC#C#C#C#C#C#C#C#C#EC#C#C#C#C#EC#C#C#|AEAEEAEEG#D#G#D#D#G#D#G#F#EF#EEF#EEEG#G#G#G#G#EG#G#G#G#G#EG#G#EEAAAAAEAAAAAE") + ("God Save The King" "G/G/A/F#//GA/B/B/c/B//AG/A/G/F#/G///////////") + ("Good King Wenceslas" "FFFGFFC/DCDEF/F/FFFGFFC/DCDEF/F/cA#AGAGF/DCDEF/F/CCDEFFG/cA#AGF/A#/FCFCF/F/|F2~C3~F2~C3~A#2~C3~F2~~~F2~C3~F2~C3~A#2~C3~F2~~~F3~C#3~D3~~~A#2~C3~F2~~~F2~E2~D2~A#2~C3~~~D3~A#2~F2F2F2~F2~F2~") + ("Gremlins Theme" "d#d#d#d#/d#d/d#d#d#d#/d#d/c/cc/cdccB/B////") + ("Hacking To The Gate" "AG/F//D/A#A/G/FGGE//CC/A#A/EGGF////AGF/DD//DAG/AE///CCA/AG/C/D///") + ("Harry Potter" "AcBA~ed~~B~~AcBG~AE~~//") + ("Hedwig's Theme" "EGF#E/BA//F#//EGF#D#/FB3///") + ("Hino Nacional Brasileiro" "C/FEFGAGAA#B//cF/C/FEGFAGA#AF#/G///D/GF#GAA#AA#cc#//dG//CGF#AGA#AcA#G/A/") + ("Jingle Bells" "EEE/EEE/EGCDE///FFFFFEEEEDDED/G/EEE/EEE/EGCDE///FFFFFEEEGGEDC") + ("King of the Hill" "C/CCCCCE/CCCCCF/FFFA/G///CCCCECCCF/E/D/DEDCCCCCECCCFFFAG//c/A/G/F/EEEFEDCcc") + ("Leaving on a Jet Plane" "G///E///A/GF/G///G/E/G/F/GF/EC") + ("Littleroot Town" "60 CFGA//GAGAA#/c/dA/Ac#d/e/d/AGFEFAd/DEF///cA#A#AF///dAAGF/////EDE//FG~|///F2C3A3C3F2C3A3C3 A2G3CG3A2G3C#G3 D3F3DF3C#3F3C#F3 C3F3CF3B2F3B3F3 A#2F3A#3F3A#2F3A#3F3 G2F3A#3F3G2F3A#3F3 C3G3A#3G3C3G3A#3G3 C3E3A#3E3C") + ("Major Scale" "C0D0E0F0G0A0B0C1D1E1F1G1A1B1C2D2E2F2G2A2B2C3D3E3F3G3A3B3C4D4E4F4G4A4B4C5D5E5F5G5A5B5C6D6E6F6G6A6B6C7D7E7F7G7A7B7C8D8E8F8G8A8B8C9D9E9F9G9A9B9") + ("Mario" "AA/A/FA/c///C/") + ("Megalovania" "120DDd/A//G#/G/F/DFG CCd/A//G#/G/F/DFG B3B3d/A//G#/G/F/DFG A#3A#3d/A//G#/G/F/DFG/") + ("Money" "B~bf#B~F#~A~B~d~B~") + ("My Heart Will Go On" "F~~~~~~~G~~~~~C~c~~~A#~AG~~~~A~A#A~~~~G~FE~F~~E~~D~~~~~C~~~~~") + ("My Life Is Like A Video Game" "A/A/c/c/c/dcc/c///a/a/a/f/g/f/f///a/a/a/a/g/g/ga//f//") + ("Never Gonna Give You Up" "CDFDA//A//G/////CDFDG//G//F/ED//CDFDF//G//E/DC///C/G//F//") + ("Pizza Tower" "A/E/G///A/E/G///ABABAGEDEE") + ("Rudolph The Red-Nosed Reindeer" "FG/FD/B/A/G/////GAGAG/c/B///////FG/FD/B/A/G/////GAGAG/d/c/////|C4~~~G3~~~C4~~~G3~~~C~~~E3~D#3~D3~~~~~~~G3~~~D3~~~G3~~~D3~~~G3~~D3G3~B3/C4") + ("Santa Claus Is Coming To Town" "EFG/G///ABc/c///EFG/G/G/AGF/F///E/G/C/E/D/F///B/c") + ("Saria's Song" "FAB/FAB/FABed/BcBGE//DEGE/") + ("Silent Night" "G//AG/E/////G//AG/E/////d///d/B/////c///c/G") + ("Smells Like Teen Spirit" "E~EE//AAAAAG~GG//c/cccc") + ("Song of Healing" "B/A/F/B/A/F/B/A/EDE/") + ("Song of Time" "A/D///F/A/D///F/AcB/G/FGA/D/CED") + ("Star Spangled Banner" "dBG/B/d/g///bag/B/c#/d///ddb//ag/f#///ef#g/g/d/B/G///////") + ("State Anthem of the Russian Federation" "G/c///G//AB///E/E/A///G//FG///C/C/D///D/E/F///F/G/A///B/c/d~") + ("Super Idol" "ddd#dcA#G/cA#G/A#/c/c/dcA#cd/GGG/A#/G/ddd#dcA#dc/dG/A#A#A/AAd/d/A#/") + ("Super Idol Good" "gg[g#]gfg[CD#cG#][D#][CG#f][Cd#][Cc]C[Cd#]/[DFfd][FA#][DA#f]D[Dg][A#f][Dd#a#]f[GBgd]B[Gd#][GDc][Gd#]G[Gd#]/[D#Gc]G[D#cg][D#g][D#g#][dg][D#f][d#d#][D#Ggc]f[D#][D#Gg][D#c][D#][D#c][d#][DFdA#]F[DA#d][Dd][Dg]/[Da#g]/[D#d#][D#][D#][D#][D#][FD#][GA#][fd#][gA#]") + ("Sweet Child O' Mine" "DdAGgAf#A DdAGgAf#A EdAGgAf#A EdAGgAf#A GdAGgAf#A GdAGgAf#A DdAGgAf#A DdAGgAf#A D") + ("Take Me Home, Country Roads" "ABc#/////c#AB/////c#BA/////c#ef#/////f#f#ec#/////c#ABc#////c#BA////ABA") + ("Take Me Out To The Ball Game" "C/cAGEG//D//C/cAGEG") + ("Take Me Out" "c/A///G/GA/////c/A///G/GA/////c/A/////G//G/A") + ("Take On Me" "BBGE/E/A/A/ABBcdccGE/E/A/A/AGGAG") + ("The Entertainer" "gafe/gd/cdBA/cG/GAFE/GD///CEDG/CE/DG//EDGC/ED/CC//CEDG/CE/DG///DCDEGA/EDGAAA///CEDG/CE/DG//EDGC/ED/CC///EDEG/EDGEDEC/EDGEDEC/ED/CC") + ("The Pretender" "AAA/A/AA/A/AAG//AAA/A/AA/A/AAGA///A/A///AAAA/G//AGA/A/AA/A/AAG/") + ("Tubular Bells" (s-join "|" (list "/E5A5E5B5E5G5A5E5c6E5d6E5B5c6 E5A5E5B5E5G5A5E5c6E5d6E5B5c6 E5B5 E5A5E5B5E5G5A5E5c6E5d6E5B5c6 E5A5E5B5E5G5A5E5c6E5d6E5B5c6" + "[Bd~][Ac~][Bd~][GB][Ac~][ce~][df~][Bd][ce~] [Ac~][Bd~][GB][Ac~][ce~][df~][Bd][ce~][Bd~] [Ac~][Bd~][GB][Ac~][ce~][df~][Bd][ce~][Ac~][Bd~] [GB][Ac~][ce~][df~][Bd][ce~]"))) + ("Thomas The Tank Engine" "GABc/de/G#//////AF/AG//G#AF/AGF#GF#G//G//////") + ("Westminster Quarters - First Quarter" "G#4/F#4/E4/B3") + ("Westminster Quarters - Second Quarter" "E4/G#4/F#4/B3////E4/F#4/G#4/E4////") + ("Westminster Quarters - Third Quarter" "G#4/E4/F#4/B3////B3/F#4/G#4/E4////G#4/F#4/E4/B3////") + ("Westminster Quarters - Full Hour" "E4/G#4/F#4/B3////E4/F#4/G#4/E4////G#4/E4/F#4/B3////B3/F#4/G#4/E4////") + ("Wish You Were Here" "C/DEG/A///c/////A/c/A/G///////C/DEG/A///c//////A/c/A/G//////C/DEG/A//////A/G/E/D//////C/DEG/A//////A/G/E/D") + ("You're A Mean One, Mr. Grinch" "FGAD////FAG/////DA//AB//Bc#////AAdcA#AA#GGGcA#AGA/FED///c#Bc#Bc#Bc#B///Ac#Bc#/d//") + ("Zelda Secret" "110 f#fdG#Gd#gb~") + ("Ameno" "[f3a3][g3A3~]/////[f3a3][g3A3~~][f3a3][g3A3~~][f3a3][g3A3~]/////[c4a3][g3A3][g3A3]/[c4a3][g3A3~]/[g3A3][f3a3~]/////[g3A3][f3a3~]/[f3a3]///[f3a3][g3A3~]/////////[c5c4a4a3][d5d4A4A3~]/////[c5c4a4a3][d5d4A4A3~~][c5c4a4a3][d5d4A4A3~~][c5c4a4a3][d5d4A4A3][d5d4A4A3]/////[c5c4a4a3][A4g4g3A3~]/[c5c4a4a3][A4g4g3A3~]/[A4g4g3A3][a4f4f3a3~]/////[A4g4g3A3][a4f4f3a3~]/[a4f4f3a3]///[a4f4f3a3][A4g4g3A3~]/////////c4d4~~c4d4~~~D4D4~/g4d4D4c4d4~~c4d4~d4~D4~~/[g5g4][d5d4][D5d4]/////[g5g3][d5d3][D5D3][g5g3]/[g5g3]//////[f5f3~~][D5D3]/[g5g3]/[g5g3]////////[f5f4f3][f5f4][f5f4f3][D5D4D3]/[A5A4A3]/[A5A4A3]////[g5g3][d5d3][D5D3][g5g3]////[g5g3][d5d3][D5D3][g5g3]/[g5g3]//////[f5f3~~][D5D3]/[g5g3]/[g5g3]////////[f5f4f3][f5f4f3~][D5D4D3]/[A5A4A3]/[A5A4A3]///[G5G3][g5g3][f5f3][D5D3][g5g3]/////////////////////c5d5~d5c5d5~~~D5~~/g5d5D5[g5g3]/[g5g3]//////[f5f3~~][D5D3]/[g5g3]/[g5g3]////////[f5f4f3][f5f4][f5f4f3][D5D4D3]/[A5A4A3]/[A5A4A3]////[g5g3][d5d3][D5D3][g5g3]////[g5g3][d5d3][D5D3][g5g3]/[g5g3]//////[f5f3~~][D5D3]/[g5g3]/[g5g3]////////[f5f4f3~~][D5D4D3]/[A5A4A3]/[A5A4A3]///[G5G3][g5g3][f5f3][D5D3][g5g3]////////c5d5~~c5d5~d5d5D5~~/[g5g3][d5d3][D5D3]////g5////////////g5d5D5/////////////gdD///////") + ("SICP" "eABc#eddf#eeag#aec#ABc#def#edc#Bc#AG#AB/G#Bdc#B|A~~c#~~B~~c#~~f#~~c#~~B~~c#~~d~~e~~G#~~E~~") + ("Friend's First Song" "E4E4D4C4/G3G3G3~|A3~~A3C4E4~~~~|E4E4D4C4/G3G3G3~|A3~~A3C4E4~~~~|C4C4C4G3/A3A3A3~|F3~~F3A3C4~~~~|G3F3E3D3/C3C3C3~|G3~~G3E3C3~~~~|") + ("forsen's theme" "C/C/DEFGAGF/G/DC///C/C/DEFGAGFG/F/EDC///|A3~~~E4~~~A4~~~E4~~~C4~~~E4~D#4~D4~~~~~~~A3~~~E4~~~A4~~~E4~~~A3~~E4A4~E5/C5~") + ("blank" "157f~~g~~~~fg~~~~d#f~~d#~~d//f~~g~~~~a#g~~f//g~~//////d#~~f~~~~d#d~~~~d#d~~A#~~G~~A#~~c~~d~d#d//A#~~G~~//////A#~~c~~~~d#d~~~~gf~~d#~~d~~a#~~g~~~~~~~~d#~~f~/f~d#f~~g~~d#~~///G~~A#~~c~~~d~~~d#~~~f~~~~~~~~g~~g#~~~~~~~~|///[G#D#~~~]/[G#D#~~~~~~][BD~]/[BD~~~~~~~~][GD#~~~]/[GD#~~~~~~][FC~]/[FC~]///////[G#D#~~~]/[G#D#~~~~~~][FD~]/[FD~~~~~~~~][D#C~~~]/[D#C~~~~~~][ED~]/[ED~]///////[G#D#~~~]/[G#D#~~~~~~][BD~]/[BD~~][A#F~~~~~][GD#~~~]/[GD#~~~~~~][FE~]/[FE~~~~]/[FE~~][D#C~~~~~~~~~~]/[D#C~~]/[D#C~~]/[D#C~~]A#3[A#3C][A#3CD#][A#3CD#A#~~~~~~~~]G#3[G#3C][G#3CD#][G#3CD#G#~~~~~~~~]") + ("Rainy Capsule Paraphrase" "140[B3B2]F#Ac#[C#6ad~]F#[dc#F#B3]/[adc#FB3][adc#FB3][adc#FB3]F#3[dcAD#F3][A#3f][f#BG#E3~][BB3][f#D][gD#][F6D6g#BE][C#6C#][F#6bd][F6aE][E6f#]D6[f#B3F#3][dBG#F#E3]/[c#AE][ad][eF#3]/G3[f#BD][fA]e[f#c#G][D6adA3][C#6a#d#G3][bec#F#3]f#f[edBGC~][f#G3][gd#BAF#3][aF3][dc#G#E3][dc#G#E3g]F#6[E6c#GE3][bd][BF#E3][dAF3][eBF#3][f#c#][A#C#][D6D#A3][C#6D#G3][bA#GE][aF#3]c[c#A]|[bB~]//[B6b~]//[bB~]/[bB~~]/[bB~][bB][aA][aA][bB][c#C#][dD][f#F#][C#7C#6~][D7D6~][C#7C#6][B6b][A6a]///[bB]/[bB][aA][bB][aA][bB]/[F#6f#]/[E6e]//[bB][D6d]/[bB][C#6c#][D6d]/[bB][C#6c#~~~~]") + ("friend's alien song" "E3/G3/B3/D4/C4///A3/C4/E4/G4/F4///E3/G3/B3/D4/C4///G3/B3/D4/F4/E4///|C4~~~~/C4G3E3////B3~~~~/B3G3E3////A3~~~~/A3F3D3////G3~~~~/G3E3C3///") + ) + "List of songs.") + +;;; These functions assume that our piano's keyboard begins at C for convenience. +;;; This is typical for 61-key pianos. +;;; NOTE: A "piano key" here is different from a "key", or a musical scale. + +(defun muzak/piano-key-color (piano-key) + "Determine the color of KEY on a piano keyboard." + (if (-contains? (alist-get 'major muzak//degrees) (mod piano-key 12)) + 'white + 'black)) + +(defun muzak/piano-key-to-note (piano-key &optional l) + "Construct a note based on the position of KEY on a piano." + (let ((symbol (nth (mod (1- piano-key) 12) muzak//chromatic-scale)) + (octave (+ 2 (/ (1- piano-key) 12)))) + (muzak/make-note :symbol symbol :octave octave :length l))) + +(defun muzak/piano-key-61-to-88 (piano-key) + "Map a key number from a 61-key piano to an 88-key piano." + (when piano-key + (+ piano-key 15))) + +(defun muzak/piano-key-to-midi (piano-key) + "Map PIANO-KEY to a MIDI note number." + (when-let ((piano-key (muzak/piano-key-61-to-88 piano-key))) + (+ piano-key 20))) + +(defun muzak/midi-to-piano-key (midi-note) + "Map MIDI-NOTE to a piano key." + (when midi-note + (- midi-note 35))) + +(defun muzak/midi-to-freq (midi-note) + "Calculate the frequency of MIDI-NOTE." + (* 440 (expt 2 (/ (- midi-note 69) 12.0)))) + +(defun muzak/midi-to-note (midi-note &optional l) + "Construct a note that represents MIDI-NOTE." + (muzak/piano-key-to-note + (muzak/midi-to-piano-key midi-note) l)) + +(defun muzak/note-to-midi (note) + "Get the MIDI code that represents NOTE." + (muzak/piano-key-to-midi + (muzak/note-to-piano-key note))) + +(defun muzak/note-to-piano-key (note) + "Determine an appropriate piano key for NOTE." + (when (not (muzak/rest-p note)) + (+ 1 + (muzak//note-to-half-step note) + (-elem-index "A" muzak//chromatic-scale) + (muzak/octaves (- muzak//middle-octave 2))))) + +(defun muzak//note-to-half-step (note) + "Determine the step of NOTE relative to middle A." + (when-let* ((symbol (muzak/note-symbol note)) + (index (-elem-index (s-upcase symbol) muzak//chromatic-scale)) + (octave (or (muzak/note-octave note) muzak//middle-octave))) + (+ -9 + index + (muzak/octaves (- muzak//middle-octave)) + (muzak/octaves octave)))) + +(defun muzak/note-to-freq (note) + "Calculate the frequency of NOTE." + (if (muzak/rest-p note) + 0 + (let ((step (muzak//note-to-half-step note))) + (* 440 (expt 2 (/ step 12.0)))))) ; (min 4187 ...) + +(defun muzak/note-same-p (n1 n2) + "Is N1 equal to N2? + +This does not compare octaves or durations." + (let ((s1 (if (stringp n1) n1 (muzak/note-symbol n1))) + (s2 (if (stringp n1) n2 (muzak/note-symbol n2)))) + (cl-equalp s1 s2))) + +(defun muzak/note-equals-p (n1 n2) + "Is N1 equal to N2? + +This does not compare durations." + (and (muzak/note-same-p n1 n2) + (= (or (muzak/note-octave n1) 0) + (or (muzak/note-octave n2) 0)))) + +(defun muzak/note-compare (n1 n2) + "Compare notes N1 and N2." + (let ((k1 (muzak/note-to-piano-key n1)) + (k2 (muzak/note-to-piano-key n2))) + (cond ((> k1 k2) 1) + ((= k1 k2) 0) + ((< k1 k2) -1)))) + +(defun muzak/note-add (note &optional n) + "Increment NOTE by N half steps." + (if (and (muzak/note-p note) (not (muzak/rest-p note))) + (let* ((n (or n 1)) + (piano-key (+ n (muzak/note-to-piano-key note))) + (piano-note (muzak/piano-key-to-note piano-key))) + (muzak/make-note + :symbol (muzak/note-symbol piano-note) + :octave (muzak/note-octave piano-note) + :length (muzak/note-length note))) + note)) + +(defun muzak/note-sub (note &optional n) + "Decrement NOTE by N half steps." + (muzak/note-add note (- (or n 1)))) + +(defun muzak//notes-add (notes n) + "Shift NOTES up or down by N half steps." + (--tree-map (muzak/note-add it n) notes)) + +;; (defun muzak/note-p (note) +;; "Is NOTE a note?" +;; (cl-typep note 'muzak/note)) + +(defun muzak/rest-p (note) + "Is NOTE a rest?" + (s-equals? + "/" + (cond ((stringp note) note) + ((muzak/note-p note) (muzak/note-symbol note)) + ((null note) "/")))) + +(defun muzak/make-scale (tonic &optional mode) + "Make a list of note names of scale MODE where the root is TONIC." + (let ((tonic (if (stringp tonic) + (muzak/make-note :symbol tonic) + tonic))) + (--map + (muzak/note-symbol (muzak/note-add tonic it)) + (alist-get (or mode 'major) muzak//degrees)))) + +(defun muzak/nth-degree (scale degree) + "Get the note name at DEGREE in SCALE." + (nth (mod (1- degree) (1- (length scale))) scale)) + +(defun muzak/scale-contains-p (scale note) + "Determine if NOTE is contained within SCALE." + (-contains? + scale + (if (stringp note) + note + (muzak/note-symbol note)))) + +(defun muzak/make-chord (tonic &optional quality) + "Construct a triad chord whose root note is TONIC. + +QUALITY can be supplied to modify the quality of the chord." + (let ((root (if (stringp tonic) (muzak/make-note :symbol tonic) tonic)) + (intervals (alist-get (or quality 'major) muzak//qualities))) + (--map (muzak/note-add root it) intervals))) + +(defun muzak/make-power-chord (tonic) + "Construct a power chord. Just an example." + (muzak/make-chord tonic 'power)) + +(defun muzak/invert-chord (chord inversion) + "Invert CHORD INVERSION times." + (if (<= inversion 0) + chord + (muzak/invert-chord + (-snoc (cdr chord) (muzak/note-add (car chord) (muzak/octaves 1))) + (- inversion 1)))) + +(defun muzak/octaves (n) + "Steps of N octaves." + (* n 12)) + +(defun muzak/bpm-seconds (bpm) + "Determine the time of a quarter note in seconds according to BPM. + +This assumes that each note is a quarter note, and a beat is every 4 notes." + (/ 15.0 bpm)) + +(defun muzak/bpm () + "Get the current BPM. + +This assumes that each note is a quarter note, and a beat is every 4 notes. " + (/ 15.0 muzak/note-duration)) + +(defun muzak/set-bpm (bpm) + "Set `muzak/note-duration' according to BPM." + (let* ((bpm (if (> bpm muzak//max-bpm) muzak//max-bpm bpm)) + (bpm (if (< bpm muzak//min-bpm) muzak//min-bpm bpm))) + (setf muzak/note-duration (muzak/bpm-seconds bpm)))) + +(defun muzak/parse (tracks-string) + "Divine the notes within TRACKS-STRING by their stellar alignment. + +Use discount code LCOLONQ for 10% off on all GNU Emacs purchases. Offer expires 1/28." + (let ((tracks (-take 3 (s-split "|" tracks-string)))) + (--map (muzak/parse-notes it) tracks))) + +(defun muzak/parse-notes (notes-string) + "Parse a list of notes from NOTES-STRING." + (save-match-data + (let ((matches ()) + (idx 0)) + (while (and + (< idx (length notes-string)) + (string-match muzak//notes-string-regexp notes-string idx)) + (setq idx (cadr (match-data))) + (let ((match (match-string 0 notes-string))) + (if (s-starts-with? "[" match) + (when-let ((i (s-index-of "]" match))) + (let* ((chord + (-take 4 + (-uniq + (-flatten (muzak/parse-notes + (s-left (1- i) (s-chop-left 1 match))))))) + (longest (muzak//longest-length chord))) + (--each chord (setf (muzak/note-length it) longest)) + (push chord matches))) + (push match matches)))) + (-take muzak//max-length + (nreverse + (--tree-map + (if (muzak/note? it) + it + (let* ((match (if (stringp it) + (s-match muzak//note-string-regexp it) + (list "Z" nil nil nil))) + (grp (-first-item match)) + (sym (-second-item match)) + (oct (-third-item match)) + (dur (-fourth-item match))) + (muzak/make-note + :symbol (if (muzak/rest-p grp) grp (upcase sym)) + :octave (if (string-empty-p oct) + (when (s-lowercase? sym) + (1+ muzak//middle-octave)) + (string-to-number oct)) + :length (unless (string-empty-p dur) (1+ (length dur)))))) + matches)))))) + +(defun muzak/serialize (tracks) + "Serialize TRACKS as a string." + (s-join "|" (--map (muzak//serialize-notes it) tracks))) + +(defun muzak//serialize-notes (notes) + "Serialize NOTES as a string." + (--reduce-from + (concat + acc + (cond ((sequencep it) (concat "[" (muzak//serialize-notes it) "]")) + ((muzak/rest-p it) "/") + ((muzak/note-p it) + (concat + (muzak/note-symbol it) + (when-let ((oct (muzak/note-octave it))) + (if (= oct muzak//middle-octave) "" (number-to-string oct))) + (s-repeat (1- (or (muzak/note-length it) 1)) "~"))))) + "" + notes)) + +(defun muzak//add-song (title notes-string) + "Add a song to `muzak//song-table'. +TITLE specifies the name of the song. +NOTES-STRING is a string of notes and rests." + (let ((hash (md5 (s-downcase title)))) + (w/db-hset "songnames" hash title) + (w/db-hset "songnotes" hash notes-string))) + +(defun muzak//get-song (song-name k) + "Look up notes of SONG-NAME from `muzak//song-table'. +Pass the resulting notes to K." + (let ((hash (md5 (s-downcase song-name)))) + (w/db-hget + "songnotes" hash + (lambda (notes) + (if (and notes (stringp notes) (s-present? notes)) + (funcall k notes) + (funcall k nil)))))) + +(defun muzak//push-song (audio-src) + "Add AUDIO-SRC to `muzak//song-queue'" + (add-to-list 'muzak//song-queue audio-src t (lambda (_ _) nil))) + +(defun muzak//pop-song () + "Pop from `muzak//song-queue'" + (pop muzak//song-queue)) + +(defun muzak//longest-length (notes) + "Find the longest length among a list of notes." + (--reduce-from + (let ((len (cond ((sequencep it) (muzak//longest-length it)) + ((muzak/note-p it) (or (muzak/note-length it) 1)) + (t 1)))) + (max len acc)) + 0 + notes)) + +(defun muzak//notes-length (notes) + "Sum the lengths of NOTES." + (--reduce-from + (+ acc + (cond ((muzak/note-p it) + (or (muzak/note-length it) 1)) + ((muzak/rest-p it) 1) + ((sequencep it) + (muzak//longest-length it)) + (t 1))) + 0 + notes)) + +(defun muzak//notes-duration (notes) + "Get the duration of NOTES in seconds." + (min muzak//max-duration + (+ (* (muzak//notes-length notes) muzak/note-duration) + ;; (* muzak/note-duration 4) + muzak/note-duration ; prevents stuttering at the end + (muzak/instrument-sustain + (alist-get muzak/instrument muzak//instruments))))) + +(defun muzak/note-duration (note) + "Determine the duration of NOTE in seconds. + +The length of a chord, represented as a list of notes, is the length of its +longest constituent note." + (cond ((muzak/note-p note) + (* (or (muzak/note-length note) 1) muzak/note-duration)) + ((sequencep note) + (let ((longest (muzak//longest-length note))) + (* longest muzak/note-duration))) + (t muzak/note-duration))) + +(defun muzak//build-note-source (note start dur &optional instrument) + "Format a note as an FFmpeg aevalsrc string." + (let ((instrument (or instrument (alist-get muzak/instrumenet muzak//instruments)))) + (cond ((sequencep note) + (mapconcat + (lambda (n) (muzak//build-note-source n start dur instrument)) + note + "+")) + ((muzak/note-p note) + (format "%s%.2f*between(t,%.2f,%.2f)*%s" + (mapconcat + (lambda (it) + (concat (funcall (alist-get it muzak//waveform-effects) start dur) "*")) + (muzak/instrument-effects instrument)) + muzak/volume + start + (+ start dur (or (muzak/instrument-sustain instrument) 0)) + (funcall + (alist-get (muzak/instrument-waveform instrument) muzak//waveforms) + (muzak/note-to-freq note))))))) + +(defun muzak//build-notes-source (notes &optional instrument) + "Build an FFmpeg aevalsrc string from NOTES." + (let ((instrument (or instrument (alist-get muzak/instrument muzak//instruments))) + (cur-time 0)) + (s-join + "+" + (-non-nil + (--mapcat + (let* ((dur (muzak/note-duration it)) + (src (muzak//build-note-source it cur-time dur instrument))) + (cl-incf cur-time dur) + (list src)) + notes))))) + +(defun muzak/play-tracks (tracks &optional k) + "Play TRACKS, a list of lists of notes. + +Calls callback K when the process exits." + (if (stringp tracks) + (muzak/play-tracks (muzak/parse tracks)) + (let ((song-duration + (-max (--map + (muzak//notes-duration it) + tracks))) + (audio-source + (s-join "+" + (--map-indexed + (let ((muzak/instrument + (if (= it-index 0) + muzak/instrument + 'keyboard))) + (muzak//build-notes-source it)) + (--filter it tracks))))) + (muzak/play-audio-source + (format "aevalsrc='%s:d=%.2f'" audio-source song-duration) + k)))) + +(defun muzak/play-notes (notes &optional k) + "Play NOTES, a list of notes. + +Calls callback K when the process exits." + (muzak/play-tracks + (if (stringp notes) + (list (muzak/parse-notes notes)) + (list notes)) + k)) + +(defun muzak/play-audio-source (audio-src &optional k) + "Play AUDIO-SRC. + +Calls callback K when the process exits." + (if muzak//process + (muzak//push-song audio-src) + (setq + muzak//process + (make-process + :name muzak//process-name + :buffer nil + :noquery t + :command + (list + ;; "ffplay" + ;; "-loglevel" "error" + ;; "-autoexit" + ;; "-nodisp" + ;; "-af" "lowpass=f=540" + ;; "-f" "lavfi" + "playfilter" + audio-src) + :sentinel + (lambda (_ _) + (setq muzak//process nil) + (when k (funcall k)) + (when-let ((next-song (muzak//pop-song))) + (muzak/play-audio-source next-song)))))) + nil) + +(defun muzak/play-notes-old (notes &optional duration) + "Play notes. + +This is nonblocking and does not use the song queue." + (if (stringp notes) + (muzak/play-notes-old + (muzak/parse-notes (concat notes "/")) + duration) + (call-process-shell-command + (format " +for FREQ in %s; do + ffmpeg -strict experimental -loglevel quiet -f lavfi -i \"sine=frequency=${FREQ}:duration=%f\" -f oga -filter tremolo -filter aphaser=in_gain=0.4:out_gain=0.74:delay=0.1:decay=0.2:speed=0.2 -filter volume=%.1f - 2>/dev/null +done | ffplay -loglevel quiet -autoexit -nodisp - &" + (mapconcat (lambda (note)(format "%d" (muzak/note-to-freq note))) notes " ") + (or duration muzak/note-duration) + (* 6 muzak/volume))))) + +(defun muzak/stop () + "Terminate `muzak//process' and clear `muzak//song-queue'." + (interactive) + (setq muzak//song-queue nil) + (when muzak//process + (kill-process muzak//process))) + +(defun muzak/play-song (song-name &optional k) + "Play SONG-NAME from `muzak//song-table'. + +Calls callback K when the process exits." + (interactive "sSong Name: ") + (muzak//get-song + song-name + (lambda (notes-string) + (when notes-string + (message "Playing %s" song-name) + (let* ((n (string-to-number notes-string)) + (muzak/note-duration + (if (and (> n muzak//min-bpm) + (< n muzak//max-bpm)) + (muzak/bpm-seconds n) + muzak/note-duration))) + (muzak/play notes-string k)))))) + +(defmacro muzak/with-volume (vol &rest body) + `(let ((muzak/volume ,vol)) + ,@body)) + +(defmacro muzak/with-instrument (instrument &rest body) + `(let ((muzak/instrument ,instrument)) + ,@body)) + +(defmacro muzak/with-duration (dur &rest body) + `(let ((muzak/note-duration ,dur)) + ,@body)) + +(defmacro muzak/with-bpm (bpm &rest body) + `(let ((muzak/note-duration (muzak/bpm-seconds ,bpm))) + ,@body)) + +(defalias 'muzak/play 'muzak/play-tracks) +(defalias 'muzak/kill 'muzak/stop) +(defalias 'muzak-stop 'muzak/stop) +(defalias 'muzak-play-notes 'muzak/play-notes) +(defalias 'muzak-play-song 'muzak/play-song) +(defalias 'muzak-add-song 'muzak/add-song) + +(defalias 'muzak/scale-contains? 'muzak/scale-contains-p) +(defalias 'muzak/note-same? 'muzak/note-same-p) +(defalias 'muzak/note-equals? 'muzak/note-equals-p) +(defalias 'muzak/note? 'muzak/note-p) +(defalias 'muzak/rest? 'muzak/rest-p) + +;;; Demos + +(defun muzak/westminster-quarters () + (when (boundp 'muzak/westminster-timer) + (cancel-timer westminster-timer)) + (setq + westminster-timer + (run-with-timer + 1 + 1 + (lambda () + (let ((now (decode-time (current-time))) + (muzak/note-duration 0.3) + (muzak/instrument 'bells)) + (when (zerop (decoded-time-second now)) + (cl-case (decoded-time-minute now) + (0 (let ((hour (mod (decoded-time-hour now) 12))) + (muzak/play-notes + (append + (car (muzak//get-tracks "Westminster Quarters - Full Hour")) + (muzak/parse-notes (s-repeat + (if (zerop hour) 12 hour) + "G#////")))))) + (15 (muzak/play-song "Westminster Quarters - First Quarter")) + (30 (muzak/play-song "Westminster Quarters - Second Quarter")) + (45 (muzak/play-song "Westminster Quarters - Third Quarter"))))))))) + +;; (when (featurep 'fig-geiser) +;; (defun fig/announce-geiser () +;; "All rise." +;; (unless (zerop (fig//geiser-counter)) +;; (muzak/play-song "Geiser's Tune")))) +;; +;; (when (featurep 'fig-piano) +;; (defun fig/play-user-note-fake (user) +;; "Play a user's note." +;; (when-let* ((midi-note (fig//get-chatter-note user)) +;; (note (muzak/midi-to-note midi-note))) +;; (muzak/play-notes (list note))))) + +;; (when (featurep 'fig) +;; (defun fig/show-real-face-in-4k-and-also-ssn-and-tax-info-and-embarrassing-baby-photos () +;; "TODO." +;; ;; (let ((muzak/instrument 'keyboard) (muzak/note-duration 0.12)) (muzak/play-notes "C/A3F3e")) +;; (muzak/with-instrument 'bells +;; (muzak/with-bpm 250 +;; (muzak/play-notes +;; (muzak/make-chord "F" 'sus2)))) +;; nil)) +;; (muzak/with-instrument 'keyboard (muzak/play-song "Zelda Secret")) +(provide 'bezelea-muzak) +;;; bezelea-muzak.el ends here diff --git a/src/contrib/prod-bless-srfi.el b/src/contrib/prod-bless-srfi.el new file mode 100644 index 00000000..7511eb5f --- /dev/null +++ b/src/contrib/prod-bless-srfi.el @@ -0,0 +1,29 @@ +;;; prod-bless-sfri --- Super Required Free Ideas -*- lexical-binding: t; -*-
+;;; Commentary:
+;;; Code:
+
+(require 'fig-bless)
+(require 'dash)
+(require 's)
+
+(defvar prod-bless-sfri
+ (list
+ ; irreplacable (within reasonable fuel) functions
+ (cons 'reverse (fig//bless-helper-unary 'reverse))
+ (cons 'concat (fig//bless-helper-binary (lambda (a b) (concat a b))))
+ (cons 'substring (lambda (s) (fig//bless-manage-fuel) (cons (substring (nth 2 s) (cadr s) (car s)) (nthcdr 3 s))))
+ (cons 'contains (fig//bless-helper-binary (lambda (a b) (s-contains? b a)))) ; car needle, cadr haystack
+ (cons 'number (fig//bless-helper-unary 'string-to-number))
+ (cons 'string (fig//bless-helper-unary 'number-to-string))
+ (cons 'random (fig//bless-helper-unary 'random))
+ ; semi-replacable functions
+ (cons 'length (fig//bless-helper-unary 'length))
+ (cons 'bundle (lambda (s) (fig//bless-manage-fuel) (cons (-take (car s) (-drop 1 s)) (-drop (+ (car s) 1) s))))
+ (cons 'split (fig//bless-helper-binary (lambda (a b) (s-split b a))))
+ (cons 'join (fig//bless-helper-binary (lambda (a b) (s-join b a))))
+ (cons 'filter (fig//bless-helper-binary (lambda (a b) (-filter b a))))
+ (cons 'any (fig//bless-helper-binary (lambda (a b) (-any? b a))))
+ (cons 'all (fig//bless-helper-binary (lambda (a b) (-all? b a))))
+ ; replacable (but forthy) functions
+ (cons 'rot (lambda (s) (fig//bless-manage-fuel) (cons (-last-item s) (-butlast s))))
+ (cons 'over (lambda (s) (fig//bless-manage-fuel) (cons (cadr s) s)))))
\ No newline at end of file |
