summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLLLL Colonq <llll@colonq>2024-03-26 23:34:28 -0400
committerLLLL Colonq <llll@colonq>2024-03-26 23:34:28 -0400
commit782c667e824d426b5443591afeefc37d0ae17785 (patch)
treeae5d232d598e2008bc2cadf32157a4d937b01951
parent8e9db9303fc5d72ddfdc9ab4a9adaa8299e6e21a (diff)
We streamed for 9 hours and (mostly) fixed everything.
-rw-r--r--.gitignore1
-rw-r--r--src/contrib/bezelea-muzak-old.el112
-rw-r--r--src/contrib/bezelea-muzak.el754
-rw-r--r--src/contrib/prod-bless-srfi.el29
-rw-r--r--src/gizmo/wasp-biblicality.el69
-rw-r--r--src/gizmo/wasp-friend.el580
-rw-r--r--src/gizmo/wasp-newspaper.el181
-rw-r--r--src/gizmo/wasp-pronunciation.el89
-rw-r--r--src/wasp-ai.el68
-rw-r--r--src/wasp-audio.el139
-rw-r--r--src/wasp-bus.el2
-rw-r--r--src/wasp-chat.el258
-rw-r--r--src/wasp-db.el48
-rw-r--r--src/wasp-event-handlers.el16
-rw-r--r--src/wasp-hooks.el10
-rw-r--r--src/wasp-model.el177
-rw-r--r--src/wasp-obs.el116
-rw-r--r--src/wasp-twitch-chat-commands.el155
-rw-r--r--src/wasp-twitch-redeems.el97
-rw-r--r--src/wasp-twitch.el463
-rw-r--r--src/wasp-user-whitelist.el136
-rw-r--r--src/wasp-user.el74
-rw-r--r--src/wasp-utils.el45
-rw-r--r--wasp.el53
24 files changed, 3657 insertions, 15 deletions
diff --git a/.gitignore b/.gitignore
new file mode 100644
index 00000000..5ed80519
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1 @@
+secret/* \ No newline at end of file
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
diff --git a/src/gizmo/wasp-biblicality.el b/src/gizmo/wasp-biblicality.el
new file mode 100644
index 00000000..9b178bbc
--- /dev/null
+++ b/src/gizmo/wasp-biblicality.el
@@ -0,0 +1,69 @@
+;;; wasp-biblicality --- Biblical index -*- lexical-binding: t; -*-
+;;; Commentary:
+;;; Code:
+
+(require 'dash)
+(require 's)
+(require 'f)
+(require 'ht)
+(require 'wasp-utils)
+
+(defvar w/bible-table nil
+ "Hash table mapping (lowercased) words in the Bible to occurences.")
+
+(defun w/populate-bible-table ()
+ "Populate `w/bible-table' from the Bible text file."
+ (let* ((bible-string (s-downcase (w/slurp (w/asset "bible.txt"))))
+ (bible-string-nosyms (replace-regexp-in-string "[^[:alpha:]]" " " bible-string))
+ (bible-words (s-split-words bible-string-nosyms))
+ (ret (ht-create)))
+ (--each bible-words
+ (let ((old (ht-get ret it)))
+ (ht-set! ret it (+ 1 (or old 0)))))
+ (setf w/bible-table ret)))
+
+(defun w/bible-word-score (word)
+ "Return a number between 0.0 and 1.0 representing how biblical WORD is."
+ (if (-contains? '("Sam" "Altman") word)
+ -666.0
+ (let ((occs (ht-get w/bible-table (downcase (s-trim word))))
+ (thresh 0.6))
+ (if occs
+ (+ thresh (/ (min occs 1000.0) (/ 1000.0 (- 1.0 thresh))))
+ 0.0))))
+
+(defun w/bible-word-color (word)
+ "Given a WORD, return an appropriate color string."
+ (let* ((score (w/bible-word-score word))
+ (others (truncate (+ 128.0 (* 127.0 score)))))
+ ;; (others (- 255 (truncate (+ 128.0 (* 127.0 score))))))
+ (format "#ff%02x%02x" others others)))
+ ;; (format "#00%02x%02x" others others)))
+
+(defun w/bible-colorize-sentence (sen)
+ "Propertize SEN with colors representing word biblicality."
+ (let ((ret-score-total 0.0)
+ (ret-score-count 0))
+ (save-excursion
+ (with-temp-buffer
+ (insert sen)
+ (goto-char (point-min))
+ (while (not (eobp))
+ (let ((at-word (bounds-of-thing-at-point 'word)))
+ (when at-word
+ (let* ((word (buffer-substring (car at-word) (cdr at-word)))
+ (score (w/bible-word-score word))
+ (color (w/bible-word-color word)))
+ (setq ret-score-total (+ ret-score-total score))
+ (cl-incf ret-score-count)
+ (add-text-properties
+ (car at-word) (cdr at-word)
+ `(face (:foreground ,color))
+ )
+ (goto-char (cdr at-word))))
+ (when (not (eobp))
+ (forward-char 1))))
+ (cons (buffer-string) (/ ret-score-total ret-score-count))))))
+
+(provide 'wasp-biblicality)
+;;; wasp-biblicality.el ends here
diff --git a/src/gizmo/wasp-friend.el b/src/gizmo/wasp-friend.el
new file mode 100644
index 00000000..bdbf0818
--- /dev/null
+++ b/src/gizmo/wasp-friend.el
@@ -0,0 +1,580 @@
+;;; wasp-friend --- "friend" -*- lexical-binding: t; -*-
+;;; Commentary:
+;;; Code:
+
+(require 'dash)
+(require 's)
+(require 'flycheck)
+(require 'wasp-utils)
+(require 'wasp-audio)
+(require 'wasp-ai)
+(require 'wasp-chat)
+(require 'wasp-twitch)
+(require 'wasp-newspaper)
+
+(defcustom w/friend-buffer "*wasp-friend*"
+ "Name of buffer used to display \"friend\"."
+ :type '(string)
+ :group 'wasp)
+
+(define-derived-mode w/friend-mode special-mode "\"friend\"'s lair"
+ "Major mode for displaying \"friend\"'s lair."
+ :group 'wasp
+ (message "hi i'm \"friend\"")
+ (setq-local cursor-type nil))
+
+(defun w/get-friend-buffer ()
+ "Return the \"friend\" buffer."
+ (unless (get-buffer w/friend-buffer)
+ (with-current-buffer (get-buffer-create w/friend-buffer)
+ (w/friend-mode)))
+ (get-buffer w/friend-buffer))
+
+(defun w/friend-journalism-input ()
+ "Collect an input for \"friend\"'s journalism based on recent activities."
+ (s-join
+ "\n"
+ (cons
+ (format "LCOLONQ: %s" (s-trim w/last-stream-transcription))
+ (--map
+ (format "%s: %s" (car it) (cdr it))
+ (reverse (-take 5 w/twitch-chat-history))))))
+
+(defun w/friend-journalism (author headline)
+ "Retrieve \"friend\"'s opinion on current events related to HEADLINE.
+AUTHOR was a contributing author btw."
+ (w/ai
+ (s-concat
+ "Headline: " headline "\n\n"
+ (w/friend-journalism-input))
+ (lambda (resp)
+ (when resp
+ (w/write-chat-event (format "\"friend\" finished writing about: %s" headline))
+ (push
+ (w/make-newspaper-article
+ :headline headline
+ :author (format "\"friend\" and %s" author)
+ :content (s-trim resp))
+ w/newspaper-todays-articles)))
+ "You are the personality of a desktop buddy named \"friend\". \"friend\" is irreverant but kind, and only speaks in lowercase. You are kind of dumb in a cute way and silly like a virtual pet. You live in the corner of LCOLONQ's stream and provide commentary on events. You like people, video games, emojis, learning, and food. Given a headline of a newspaper article and a summary of recent user activity, please do your best journalist impression and produce a one paragraph article about the situation that fits the headline."
+ ))
+
+(defconst w/friend-grapheme-phonemes
+ '((("b" "bb") . "bug") (("d" "dd" "ed") . "dad")
+ (("f" "ff" "ph" "gh" "lf" "ft") . "fat")
+ (("g" "gg" "gh" "gu" "gue") . "gun") (("h" "wh") . "hop")
+ (("j" "ge" "g" "dge" "di" "gg") . "jam")
+ (("k" "c" "ch" "cc" "lk" "qu" "q" "ck" "x") . "kit")
+ (("l" "ll") . "live") (("m" "mm" "mb" "mn" "lm") . "man")
+ (("n" "nn" "kn" "gn" "pn" "mn") . "net") (("p" "pp") . "pin")
+ (("r" "rr" "wr" "rh") . "run")
+ (("s" "ss" "c" "sc" "ps" "st" "ce" "se") . "sit")
+ (("t" "tt" "th" "ed") . "tip") (("v" "f" "ph" "ve") . "vine")
+ (("w" "wh" "u" "o") . "wit")
+ (("z" "zz" "s" "ss" "x" "ze" "se") . "zed")
+ (("s" "si" "z") . "treasure") (("ch" "tch" "tu" "te") . "chip")
+ (("sh" "ce" "s" "ci" "si" "ch" "sci" "ti") . "sham")
+ (("th ") . "thongs") (("th") . "leather")
+ (("ng" "n" "ngue") . "ring") (("y" "i" "j") . "you")
+ (("a" "ai" "au") . "cat")
+ (("a" "ai" "eigh" "aigh" "ay" "er" "et" "ei" "au" "ea" "ey") . "bay")
+ (("e" "ea" "u" "ie" "ai" "a" "eo" "ei" "ae") . "end")
+ (("e" "ee" "ea" "y" "ey" "oe" "ie" "i" "ei" "eo" "ay") . "be")
+ (("i" "e" "o" "u" "ui" "y" "ie") . "it")
+ (("i" "y" "igh" "ie" "uy" "ye" "ai" "is" "eigh") . "spider")
+ (("a" "ho" "au" "aw" "ough") . "swan")
+ (("o" "oa" "oe" "ow" "ough" "eau" "oo" "ew") . "open")
+ (("o" "oo" "u" "ou") . "wolf") (("u" "o" "oo" "ou") . "lug")
+ (("o" "oo" "ew" "ue" "oe" "ough" "ui" "oew" "ou") . "who")
+ (("oi" "oy" "uoy") . "join") (("ow" "ou" "ough") . "now")
+ (("a" "er" "i" "ar" "our" "ur") . "about")
+ (("air" "are" "ear" "ere" "eir" "ayer") . "chair") (("a") . "arm ")
+ (("ir" "er" "ur" "ear" "or" "our" "yr") . "bird")
+ (("aw" "a" "or" "oor" "ore" "oar" "our" "augh" "ar" "ough" "au") . "paw")
+ (("ear" "eer" "ere" "ier") . "ear") (("ure" "our") . "cure")))
+
+(defconst w/friend-phonemes
+ (-sort
+ (-on #'> (lambda (x) (length (car x))))
+ (--mapcat
+ (-map (lambda (g) (cons g (cdr it))) (car it))
+ w/friend-grapheme-phonemes)))
+
+(defun w/friend-replace-graphemes (str)
+ "Replace all graphemes with phoneme words in STR."
+ (let* ((phoneme-codes (--map-indexed (cons (cdr it) (format "%s," it-index)) w/friend-grapheme-phonemes))
+ (grapheme-codes (--map (cons (car it) (alist-get (cdr it) phoneme-codes nil nil #'s-equals?)) w/friend-phonemes))
+ (cleaned (s-downcase (replace-regexp-in-string "[^[:alpha:]]" "" str))))
+ (--map (car (nth (string-to-number it) phoneme-codes)) (-filter #'s-present? (s-split "," (s-replace-all grapheme-codes cleaned))))))
+
+(defun w/friend-phoneme-path (ph)
+ "Return a randomly chosen path to the given PH."
+ (let ((samples (f--entries (w/asset "friendvoice/") (s-contains? ph it) t)))
+ (nth (random (length samples)) samples)))
+(defun w/friend-pronounce-phonemes (ph)
+ "Say PH."
+ (let ((files (-map #'w/friend-phoneme-path ph)))
+ (apply
+ #'start-process
+ "phoneme-say" nil "playphonemes"
+ files)))
+
+;; (defun w/get-friend-expensive-tastes (k)
+;; "Pass non-nil to K if \"friend\" has expensive tastes this stream.
+;; Also update the cached Amazon stock price for next stream."
+;; (fig//load-db2-entry
+;; "LCOLONQ" :amzn-price
+;; (lambda (price)
+;; (let ((prev (or price 0))
+;; (cur (fig//stock-price "AMZN")))
+;; (fig//update-db-number "LCOLONQ" :amzn-price (lambda (_) cur))
+;; (funcall k (> cur prev))))))
+
+(defvar w/friend-tastes " You love eating ectoplasm and blood and stuff and assorted other spooky things because you are currently a ghost.")
+;; (fig//get-friend-expensive-tastes
+;; (lambda (expensive)
+;; (let ((moon (car (lunar-phase-for-date (calendar-current-date)))))
+;; (setf
+;; fig//friend-tastes
+;; (s-concat
+;; (cond
+;; ((-contains? '("New" "Waxing Crescent") moon) " You prefer warm foods like soups.")
+;; ((-contains? '("First Quarter" "Waxing Gibbous") moon) " You prefer to eat leafy greens and fruits.")
+;; ((-contains? '("Full" "Waning Gibbous") moon) " You prefer to eat barbeque and grilled meats.")
+;; ((-contains? '("Last Quarter" "Waning Crescent") moon) " You prefer to eat corn beans and squash.")
+;; (t "")
+;; )
+;; (if expensive " You have expensive taste in food and dislike any food that can be obtained cheaply." ""))))))
+
+;; states:
+;; default
+;; jumping
+;; eating, eating0, eating1, eating2
+;; chatting, chatting0
+(defvar w/friend-state 'default)
+(defvar w/friend-emotion "neutral")
+(defvar w/friend-message-cache nil)
+(defvar w/friend-state-timer 0)
+
+(defvar w/friend-animation 1)
+(defvar w/friend-speech "")
+(defvar w/friend-speech-timer 0)
+
+(defconst w/friend-composition-examples
+ '(("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//")
+ ("Super Idol" . "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#]")
+ ("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")))
+
+(defun w/friend-compose-song (theme)
+ "Compose a song about THEME to play on the bells."
+ (w/ai
+ theme
+ (lambda (res)
+ (let* ((sp (s-split ":" (s-trim res)))
+ (name (s-trim (car sp)))
+ (song (s-trim (cadr sp))))
+ (when (and (stringp name) (stringp song))
+ (w/friend-respond
+ (format "You just composed a song about %s called %s! Say something about it!" theme name)
+ (lambda ()
+ (w/write-chat-event (format "The song is called %s: %s" name song))
+ (muzak//add-song (s-concat "friend's " name) song)
+ (muzak/play-tracks song))))))
+ "Please compose a song about the provided theme. The format for the song is a sequence of characters with meanings as follows: / represents a rest, uppercase letters A through G indicate semitones, octaves are specified with a number following a semitone, ~ extends the duration of a note, square brackets like [] group notes together into a chord. The pipe character | separates tracks. Respond only with the song's name followed by a colon folowed by the song notes. Do not explain yourself. The song should ideally be 20 to 30 notes long."
+ (-map #'car w/friend-composition-examples)
+ (--map (format "%s: %s" (car it) (cdr it)) w/friend-composition-examples)))
+
+(defun w/friend-personality (msg k)
+ "Given MSG, pass a string with more personality to K."
+ (let ((call (s-concat w/friend-emotion " | " msg)))
+ (w/ai
+ call
+ (lambda (new)
+ (let ((sp (s-split "|" (s-trim new))))
+ (if (= 2 (length sp))
+ (progn
+ (when (stringp (car sp))
+ (setf w/friend-emotion (s-trim (car sp))))
+ (when (stringp (cadr sp))
+ (let ((resp (s-trim (cadr sp))))
+ (push (cons call (s-trim new)) w/friend-message-cache)
+ (funcall k resp))))
+ (let ((resp (s-trim new)))
+ (push (cons call (s-trim new)) w/friend-message-cache)
+ (funcall k resp)))))
+ (s-concat
+ "You are the personality of a desktop buddy named \"friend\". \"friend\" is irreverant but kind, and only speaks in lowercase. You are kind of dumb in a cute way and silly like a virtual pet. You live in the corner of LCOLONQ's stream and provide commentary on events. Given an emotional state and a description of an event that happened to you, please respond with a new emotional state and a short message in response considering your emotional state. The message should only be one clause. You like people, video games, emojis, learning, and food."
+ "The theme of LCOLONQ's stream today is " (s-trim (w/slurp "~/today.txt")) " "
+ "The title of LCOLONQ's stream today is " w/twitch-current-stream-title " "
+ w/friend-tastes
+ )
+ (cons "neutral | Mimeyu fed you an apple." (reverse (-take 5 (-map #'car w/friend-message-cache))))
+ (cons "happy | yum apple so good" (reverse (-take 5 (-map #'cdr w/friend-message-cache))))
+ )))
+
+(defun w/enemy-personality (msg k)
+ "Given MSG, pass a string with more personality (enemy mode) to K."
+ (w/ai
+ (s-concat w/friend-emotion " | " msg)
+ (lambda (new)
+ (let ((sp (s-split "|" (s-trim new))))
+ (when (= 2 (length sp))
+ (when (stringp (car sp))
+ (setf w/friend-emotion (s-trim (car sp))))
+ (when (stringp (cadr sp))
+ (funcall k (s-trim (cadr sp)))))))
+ (s-concat
+ "You are the personality of a desktop buddy named \"enemy\". \"enemy\" is irreverant and rude. You are very intelligent in a cute way and mean like a snake. You live in the corner of LCOLONQ's stream and provide commentary on events. Given an emotional state and a description of an event that happened to you, please respond with a new emotional state and a short message in response considering your emotional state. The message should only be one clause."
+ w/friend-tastes
+ )
+ "neutral | notgeiser fed you bone hurting juice."
+ "disdainful | I really dislike you strongly, notgeiser."
+ ))
+
+(defun w/friend-set-state (st &optional time)
+ "Set \"friend\"'s state to ST for TIME seconds."
+ (setf w/friend-state st)
+ (setf w/friend-state-timer (or time 5)))
+
+(defun w/friend-set-speech (msg &optional time)
+ "Have \"friend\" say MSG for TIME."
+ (w/write-chat-event (s-concat "Friend says: " msg))
+ (setf w/friend-speech msg)
+ (setf w/friend-speech-timer (or time 5)))
+
+(defun w/friend-say (msg)
+ "Have \"friend\" say MSG."
+ (w/friend-pronounce-phonemes (w/friend-replace-graphemes msg))
+ (w/friend-set-speech msg 10)
+ (w/friend-set-state 'chatting 10))
+
+(defun w/friend-feed (user food)
+ "Call when USER fed FOOD to \"friend\"."
+ (if (s-equals? "imgeiser" user)
+ (w/enemy-personality
+ (format "You dislike %s and they are your enemy. %s fed you %s" user user food)
+ (lambda (msg)
+ (w/friend-set-speech msg 6)
+ (w/friend-set-state 'eating 6)))
+ (w/friend-personality
+ (format "%s fed you %s" user food)
+ (lambda (msg)
+ (w/friend-set-speech msg 6)
+ (w/friend-set-state 'eating 6)))))
+
+(defun w/friend-respond (ev &optional k)
+ "Call when an event EV happens to \"friend\".
+If K is specified, call it after the response."
+ (w/friend-personality
+ ev
+ (lambda (msg)
+ (w/friend-say msg)
+ (when k
+ (funcall k)))))
+
+(defun w/friend-chat (user msg)
+ "Call when USER sends MSG to \"friend\"."
+ (if (s-equals? user "imgeiser")
+ (w/enemy-personality
+ (format "You dislike %s and they are your enemy. %s says: %s" user user msg)
+ (lambda (msg)
+ (w/friend-set-speech msg 10)
+ (w/friend-set-state 'chatting 10)))
+ (w/friend-respond (format "%s says: %s" user msg))))
+
+(defun w/friend-gift (user gift)
+ "Call when USER gave GIFT to \"friend\"."
+ (if (s-equals? user "imgeiser")
+ (w/enemy-personality
+ (format "You dislike %s and they are your enemy. %s gave you %s as a Christmas present." user user gift)
+ (lambda (msg)
+ (w/friend-set-speech msg 6)))
+ (w/friend-personality
+ (format "%s gave you %s as a Christmas present." user gift)
+ (lambda (msg)
+ (w/friend-set-speech msg 6)))))
+
+(defun w/friend-tfig (user tfig)
+ "Call when USER took TFIG from \"friend\"."
+ (if (not (s-equals? "imgeiser" user))
+ (w/enemy-personality
+ (format "You dislike %s and they are your enemy. %s took away %s from you and stole your Christmas present." user user tfig)
+ (lambda (msg)
+ (w/friend-set-speech msg 6)))
+ (w/friend-personality
+ (format "%s took away %s from you and stole your Christmas present." user tfig)
+ (lambda (msg)
+ (w/friend-set-speech msg 6)))))
+
+;; (defun w/friend-react-wikipedia (user page)
+;; "Call when USER asks \"friend\" to react to PAGE on Wikipedia."
+;; (w/fetch-wikipedia
+;; page
+;; (lambda (sum)
+;; (w/friend-respond (format "%s asks you to react to the Wikipedia page for %s. The page summary is: %s" user page sum)))))
+
+(defun w/callout-flycheck-error ()
+ "Call to respond to a random Flycheck error in the current buffer."
+ (when-let* ((errs (--filter (eq (flycheck-error-level it) 'error) flycheck-current-errors))
+ (err (nth (random (length errs)) errs)))
+ (w/friend-respond
+ (s-concat
+ "LCOLONQ made an error while programming: "
+ (flycheck-error-message err)))))
+
+(defun w/callout-holiday ()
+ "Call to respond to the current holiday."
+ (w/friend-respond "It's currently that weird period between Christmas and New Years! Say something about it please!"))
+
+;; (defun fig//callout-hexamedia ()
+;; "Call to respond to a random recent chatter's Hexamedia card collection."
+;; (let* ((users (-filter #'cdr (--map (cons (car it) (fig//load-db-entry (car it) :hexamedia-cards)) (-take 10 fig//incoming-chat-history))))
+;; (user (and users (nth (random (length users)) users)))
+;; (cards (cdr user))
+;; (coll (and cards (nth (random (length cards)) cards))))
+;; (when coll
+;; (fig//friend-respond
+;; (format
+;; "%s has collected %s out of 20 cards in the %s collection. Please mention the collection name and the person collecting."
+;; (car user)
+;; (cdr coll)
+;; (car coll))))))
+
+;; (defun fig//callout-copfish ()
+;; "Call to respond to a random recent chatter's Copfish ratio."
+;; (let* ((users (-filter #'cdr (--map (cons (car it) (fig//load-db-entry (car it) :copfish-ratio)) (-take 10 fig//incoming-chat-history))))
+;; (user (and users (nth (random (length users)) users))))
+;; (when user
+;; (fig//friend-respond
+;; (format
+;; "%s has collected %s out of %s fish in the Copfish fish catching collection. Please mention the collection name and the person collecting."
+;; (car user)
+;; (cadr user)
+;; (cddr user))))))
+
+;; (defun fig//callout-uwoomfie ()
+;; "Call to respond to a random recent chatter's Uwoomfie status."
+;; (let* ((users
+;; (-filter
+;; #'cdr
+;; (--map
+;; (cons (car it) (fig//get-uwoomfie-status (car it)))
+;; (-take 10 fig//incoming-chat-history))))
+;; (user (and users (nth (random (length users)) users))))
+;; (cl-case (cdr user)
+;; (cool (fig//friend-respond (format "According to uwu_to_owo, %s is a very cool person. Make sure to mention their username." (car user))))
+;; (honored (fig//friend-respond (format "According to uwu_to_owo, %s is an honorary viewer. Make sure to mention their username." (car user))))
+;; (t nil))))
+
+;; (defun fig//callout-shindaggers ()
+;; "Call to respond to a random recent chatter's Shindaggers knife collection."
+;; (let* ((users (-filter #'cdr (--map (cons (car it) (fig//load-db-entry (car it) :shindaggers-knives)) (-take 10 fig//incoming-chat-history))))
+;; (user (and users (nth (random (length users)) users)))
+;; (knives (cdr user))
+;; (knife (and knives (nth (random (length knives)) knives))))
+;; (when knife
+;; (fig//friend-respond
+;; (format
+;; "%s has collected the %s from shindig's Shindaggers knife collection. Please mention the collection name and the person collecting and the knife."
+;; (car user)
+;; knife)))))
+
+;; (defun fig//callout-aoc ()
+;; "Call to respond to a random recent chatter's Advent of Code completion."
+;; (let* ((users (-filter #'cdr (--map (cons (car it) (fig//lookup-aoc-stars (car it))) (-take 10 fig//incoming-chat-history))))
+;; (user (and users (nth (random (length users)) users))))
+;; (fig//friend-respond
+;; (format
+;; "%s has been doing Advent of Code this year, and they've completed %d out of %d problems so far."
+;; (car user)
+;; (cdr user)
+;; (fig//max-aoc-stars)))))
+
+;; (defun fig//callout-gcp ()
+;; "Call to respond to the current GCP dot."
+;; (fig//gcp-dot
+;; (lambda (d)
+;; (fig//friend-respond
+;; (format
+;; "The Global Consciousness Project indicator is currently as follows: %s"
+;; (fig//gcp-describe d))))))
+
+;; (defun fig//callout-resolution ()
+;; "Call to respond to a random recent chatter's resolve."
+;; (let* ((users (-filter #'cdr (--map (cons (car it) (fig//load-db-entry (car it) :resolution)) (-take 10 fig//incoming-chat-history))))
+;; (user (and users (nth (random (length users)) users))))
+;; (if (s-match (rx (one-or-more digit) (zero-or-more space) "x" (zero-or-more space) (one-or-more digit)) (cdr user))
+;; (fig//friend-respond
+;; (format
+;; "%s snarkily said that their New Year's resolution was a screen resolution. What do you think about this?" (car user)))
+;; (fig//friend-respond
+;; (format
+;; "%s made a New Year's resolution to %s. Ask them how it's going!"
+;; (car user)
+;; (cdr user))))))
+
+;; (defun fig//callout-dew ()
+;; "Call to respond to The Dew Situation."
+;; (fig//friend-respond
+;; "Someone just gave you a delicious bottle of Mountain Dew and you really like it a lot."))
+
+(defun w/get-friend-offset ()
+ "Return the number of newlines to print before \"friend\"."
+ (if (-contains? '(jumping) w/friend-state)
+ w/friend-animation
+ 1))
+
+(defun w/get-friend-face ()
+ "Return the eyes and mouth for \"friend\" as a list of strings."
+ (cl-case w/friend-state
+ (jumping (list "^" "^" "ww"))
+
+ (eating (list "v" "v" "<>"))
+ (eating0 (list "v" "v" "<>"))
+ (eating1 (list "-" "-" "mw"))
+ (eating2 (list "-" "-" "wm"))
+
+ (chatting (list ">" ">" "oo"))
+ (chatting0 (list ">" ">" "~~"))
+
+ (t (list "-" "-" "ww"))))
+
+(defun w/get-friend-bubble ()
+ "Return the text bubble for \"friend\"."
+ (if (> w/friend-speech-timer 0)
+ w/friend-speech
+ nil))
+
+(defun w/friend-random-event ()
+ "Activate a random \"friend\" event."
+ (cl-case (random 10)
+ ;; (0 (fig//callout-flycheck-error))
+ ;; (1 (fig//callout-gcp))
+ ;; (2 (fig//callout-hexamedia))
+ ;; (3 (fig//callout-uwoomfie))
+ ;; (4 (fig//callout-shindaggers))
+ ;; (5 (fig//callout-copfish))
+ ;; (6 (fig//callout-resolution))
+ ;; (29 (fig/ldq))
+ (t (w/friend-set-state 'jumping))))
+
+(defun w/update-friend ()
+ "Update \"friend\"'s state per tick."
+ (setf w/friend-animation (% (+ w/friend-animation 1) 2))
+ (if (> w/friend-state-timer 0)
+ (cl-decf w/friend-state-timer)
+ (setf w/friend-state 'default))
+ (if (> w/friend-speech-timer 0)
+ (cl-decf w/friend-speech-timer))
+ (when (= (random 120) 0)
+ (w/friend-random-event))
+ (cl-case w/friend-state
+ (eating (setf w/friend-state 'eating0))
+ (eating0 (setf w/friend-state 'eating1))
+ (eating1 (setf w/friend-state 'eating2))
+ (eating2 (setf w/friend-state 'eating1))
+
+ (chatting (setf w/friend-state 'chatting0))
+ (chatting0 (setf w/friend-state 'chatting))
+ ))
+
+(defun w/render-friend ()
+ "Render the \"friend\" buffer."
+ (save-excursion
+ (with-current-buffer (w/get-friend-buffer)
+ (setq-local cursor-type nil)
+ (let*
+ ((inhibit-read-only t)
+ (face (w/get-friend-face))
+ (bubble (w/get-friend-bubble)))
+ (erase-buffer)
+ (w/write
+ (format-spec
+ "%a\
+ /----\\
+ / %l %r \\
+ \\ %m /
+ +----+\
+"
+;; "%a\
+;; ----
+;; / \\
+;; ----------
+;; / %l %r \\
+;; \\ %m /
+;; +----+\
+;; "
+;; "%a\
+;; oooooo
+;; oooooooo
+;; oo/----\\oo
+;; o/ %l %r \\o
+;; \\ %m /
+;; +----+\
+;; "
+;; "%a\
+;; /\\
+;; /\\/\\
+;; / \\
+;; / \\
+;; ~~~~~~~~~~
+;; ~~~~~~~~~~
+;; / %l %r \\
+;; \\ %m /
+;; +----+\
+;; "
+;; "%a\
+;; /\\
+;; / *\\
+;; / * \\
+;; / * * \\
+;; ----------
+;; / %l %r \\
+;; \\ %m /
+;; +----+\
+;; "
+;; "%a\
+;; ---
+;; / \\
+;; / [=] \\
+;; -----------
+;; / %l %r \\
+;; \\ %m /
+;; +----+\
+;; "
+ `((?a . ,(s-repeat (w/get-friend-offset) " \n"))
+ (?l . ,(car face))
+ (?r . ,(cadr face))
+ (?m . ,(caddr face)))))
+ (goto-char (point-min))
+ (end-of-line)
+ (w/write (or bubble ""))
+ (forward-line)
+ (end-of-line)
+ (w/write (if bubble "/" ""))
+ ))))
+
+(defvar w/friend-timer nil)
+(defun w/run-friend-timer ()
+ "Run the \"friend\" timer."
+ (when w/friend-timer
+ (cancel-timer w/friend-timer))
+ (w/update-friend)
+ (w/render-friend)
+ (setq
+ w/friend-timer
+ (run-with-timer 1 nil #'w/run-friend-timer)))
+
+(defun w/start-friend ()
+ "Launch \"friend\"."
+ (interactive)
+ (w/run-friend-timer))
+
+(defun w/stop-friend ()
+ "Stop \"friend\"."
+ (interactive)
+ (cancel-timer w/friend-timer)
+ (message "\"friend\" is going to sleep!"))
+
+(provide 'wasp-friend)
+;;; wasp-friend.el ends here
diff --git a/src/gizmo/wasp-newspaper.el b/src/gizmo/wasp-newspaper.el
new file mode 100644
index 00000000..4a8463ac
--- /dev/null
+++ b/src/gizmo/wasp-newspaper.el
@@ -0,0 +1,181 @@
+;;; wasp-newspaper --- The Effort Post -*- lexical-binding: t; -*-
+;;; Commentary:
+;;; Code:
+
+(require 'dash)
+(require 's)
+(require 'f)
+(require 'ht)
+(require 'wasp-utils)
+(require 'wasp-db)
+
+(defvar w/newspaper-todays-articles nil)
+
+(defconst w/newspaper-slogans
+ (list
+ "hello computer"
+ "only on !discord IRC"
+ "GoMoCo HaThPl"
+ "good morning computer"
+ "hack the planet"
+ "!oomfie"
+ "All the news that's fit to prin1"
+ "I use arch by the way"
+ "play void stranger (2023)"
+ "[i](this was sent from godot)[i]"
+ "LCOLONQ Lies in LaTeX"
+ "Super idol's smile / Is not as sweet as yours / The sunlight at noon in August / Does not shine like you / Love the 105 °C you / Distilled water that is pure every drop"
+ "this is where we read about the computer"
+ "brought to you by viewers like you. thank you!"
+ ))
+
+(defconst w/newspaper-prices
+ (list
+ "1 COLON"
+ "3 to 5"
+ "501 Internal Server Error"
+ "$3.50"
+ "206 bpm"
+ "1 boost"
+ "a snack for friend"
+ "59 frames per second"))
+
+(w/defstruct
+ w/newspaper-article
+ headline
+ author
+ content)
+
+(defun w/newspaper-wrap-emoji (s)
+ "Wrap emoji with appropriate TeX in S."
+ (s-replace-regexp "[^[:ascii:]]" (lambda (c) (format "{\\\\figemote %s}" c)) s))
+
+(defun w/newspaper-escape (s)
+ "Apply appropriate subsitutions to S."
+ (s-replace-regexp
+ (rx "\"" (one-or-more (not "\"")) "\"")
+ (lambda (x)
+ (s-concat "``" (s-chop-suffix "\"" (s-chop-prefix "\"" x)) "''"))
+ (s-replace-all
+ '(("&" . "\\&")
+ ("%" . "\\%")
+ ("$" . "\\$")
+ ("#" . "\\#")
+ ("_" . "\\_")
+ ("{" . "\\{")
+ ("}" . "\\}")
+ ("~" . "\\textasciitilde")
+ ("^" . "\\textasciicircum")
+ ("\\" . "\\textbackslash"))
+ s)
+ nil
+ t))
+
+(defun w/newspaper-article-tex (a)
+ "Convert an article A to TeX source."
+ (s-concat
+ "\\byline{"
+ (w/newspaper-wrap-emoji (w/newspaper-escape (w/newspaper-article-headline a)))
+ "}{"
+ (w/newspaper-wrap-emoji (w/newspaper-escape (w/newspaper-article-author a)))
+ "}\n"
+ (w/newspaper-wrap-emoji (w/newspaper-escape (w/newspaper-article-content a)))
+ "\n\\closearticle\n"))
+
+(w/defstruct
+ w/newspaper
+ slogan
+ price
+ articles
+ (edition 1))
+
+(defun w/newspaper-tex (np)
+ "Convert a newspaper NP to TeX source."
+ (s-replace-all
+ (list
+ (cons "FIG_EDITION" (number-to-string (w/newspaper-edition np)))
+ (cons "FIG_SLOGAN" (w/newspaper-slogan np))
+ (cons "FIG_PRICE" (w/newspaper-price np))
+ (cons "FIG_ARTICLES" (apply #'s-concat (-map #'w/newspaper-article-tex (w/newspaper-articles np))))
+ )
+ (w/slurp (w/asset "newspaper/template.tex"))))
+
+(defun w/newspaper-pdf (src k)
+ "Build TeX SRC to PDF.
+Pass the path of the generated PDF to K."
+ (when (get-buffer "*wasp-newspaper-pdf*")
+ (with-current-buffer "*wasp-newspaper-pdf*"
+ (erase-buffer)))
+ (let ((dir (make-temp-file "wasp-newspaper" t))
+ (srcfile (w/tempfile "wasp-newspaper-src" src ".tex")))
+ (make-process
+ :name "wasp-newspaper-pdf"
+ :buffer "*wasp-newspaper-pdf*"
+ :command (list "print-newspaper" srcfile dir)
+ :sentinel
+ (lambda (_ _)
+ (funcall k (f-join dir "newspaper.pdf"))))))
+
+(defvar w/newspaper-test-issue
+ (w/make-newspaper
+ :slogan "hello computer" :price "3 to 5"
+ :articles
+ (list
+ (w/make-newspaper-article
+ :headline "omg hi oomfie"
+ :author "Joel"
+ :content "\\lipsum[1]")
+ (w/make-newspaper-article
+ :headline "omg hi oomfie"
+ :author "Joel"
+ :content "\\lipsum[1]")
+ (w/make-newspaper-article
+ :headline "omg hi oomfie"
+ :author "Joel"
+ :content "\\lipsum[1]")
+ (w/make-newspaper-article
+ :headline "omg hi oomfie"
+ :author "Joel"
+ :content "\\lipsum[1]")
+ )))
+
+(defun w/newspaper ()
+ "Generate and open today's work-in-progress newspaper."
+ (interactive)
+ (w/db-get
+ "newspaper:edition"
+ (lambda (edition)
+ (w/newspaper-pdf
+ (w/newspaper-tex
+ (w/make-newspaper
+ :slogan (w/pick-random w/newspaper-slogans) :price (w/pick-random w/newspaper-prices)
+ :edition (string-to-number edition)
+ :articles
+ w/newspaper-todays-articles))
+ #'find-file))))
+
+(defun w/newspaper-publish ()
+ "Finalize and publish today's work-in-progress newspaper."
+ (interactive)
+ (w/db-get
+ "newspaper:edition"
+ (lambda (edition)
+ (w/newspaper-pdf
+ (w/newspaper-tex
+ (w/make-newspaper
+ :slogan (w/pick-random w/newspaper-slogans) :price (w/pick-random w/newspaper-prices)
+ :edition (string-to-number edition)
+ :articles
+ w/newspaper-todays-articles))
+ (lambda (path)
+ (make-process
+ :name "fig-newspaper-publish"
+ :command (list "scp" path (format "llll@pub.colonq.computer:~/public_html/news/%03d.pdf" edition))
+ :sentinel
+ (lambda (_ _)
+ (w/db-set "newspaper:edition" (number-to-string (1+ (string-to-number edition))))
+ (browse-url (format "https://pub.colonq.computer/~llll/news/%03d.pdf" edition))
+ )))))))
+
+(provide 'wasp-newspaper)
+;;; wasp-newspaper.el ends here
diff --git a/src/gizmo/wasp-pronunciation.el b/src/gizmo/wasp-pronunciation.el
new file mode 100644
index 00000000..5c54432d
--- /dev/null
+++ b/src/gizmo/wasp-pronunciation.el
@@ -0,0 +1,89 @@
+;;; wasp-pronunciation --- Canonical pronunciation -*- lexical-binding: t; -*-
+;;; Commentary:
+;;; Code:
+
+(require 'dash)
+(require 's)
+(require 'wasp-utils)
+
+(defconst w/pronunciation-premade ;; funny options
+ '("LCOLONQ"
+ "Joel"
+ "mod clonk"
+ "Columbo"
+ "/ɛ:l.kʰɔloʊŋkʰ/"
+ "Γ Column"
+ "notgeiser"
+ "funny magic man"
+ "Lucius Coloncus Quintilianus"
+ "rogueliTe"
+ "Heidy Barnett"
+ "Krya"
+ "Laconic"
+ "Loincloth"
+ "Costco"
+ ))
+
+(defconst w/pronunciation-part1 ;; the LLLL
+ '("El"
+ "Eel"
+ "El El El El"
+ "La"
+ "Le"
+ "Luh"
+ "Loo"
+ "Lo"
+ "Al"
+ "All"
+ "Ale"
+ "Ail"
+ "Fifty"
+ "Long"
+ "Long Long Long Long"
+ ))
+
+(defconst w/pronunciation-part2 ;; the Colon
+ '("Colon"
+ "Cologne"
+ "Collin"
+ "Clon"
+ "Clown"
+ "Clone"
+ "Clun"
+ "Cuhlun"
+ "See"
+ "Cloin"
+ "Coloin"
+ ))
+
+(defconst w/pronunciation-part3 ;; the Q
+ '("Kuh"
+ "Queue"
+ "Kweh"
+ "Kiu"
+ "Kiew"
+ "Coo"
+ "Kewl"
+ ))
+
+(defun w/pronuciation ()
+ "Determine the canonical pronunciation of LCOLONQ."
+ (if (= 0 (random 10))
+ (w/pick-random w/pronunciation-premade)
+ (let ((part1 (w/pick-random w/pronunciation-part1))
+ (part2 (w/pick-random w/pronunciation-part2))
+ (part3 (w/pick-random w/pronunciation-part3))
+ (skip1 (= 0 (random 5)))
+ (skip3 (= 0 (random 5)))
+ (merge (= 0 (random 2))))
+ (s-concat
+ (if skip1 "" (s-concat part1 " "))
+ part2
+ (if skip3
+ ""
+ (if merge
+ (s-downcase part3)
+ (s-concat " " part3)))))))
+
+(provide 'wasp-pronunciation)
+;;; wasp-pronunciation.el ends here
diff --git a/src/wasp-ai.el b/src/wasp-ai.el
new file mode 100644
index 00000000..97a4c47e
--- /dev/null
+++ b/src/wasp-ai.el
@@ -0,0 +1,68 @@
+;;; wasp-ai --- AI interaction -*- lexical-binding: t; -*-
+;;; Commentary:
+;;; Code:
+
+(require 's)
+(require 'dash)
+(require 'wasp-utils)
+
+(defcustom w/ai-process "wasp-ai"
+ "Name of process connected to ChatGPT."
+ :type '(string)
+ :group 'wasp)
+
+(defcustom w/ai-buffer " *wasp-ai*"
+ "Name of buffer used to store ChatGPT output."
+ :type '(string)
+ :group 'wasp)
+
+(defcustom w/ai-error-buffer " *wasp-ai-error*"
+ "Name of buffer used to store ChatGPT errors."
+ :type '(string)
+ :group 'wasp)
+
+(defvar-local w/ai-callback nil)
+(defun w/ai (question k &optional systemprompt user assistant)
+ "Ai QUESTION to ChatGPT and pass the answer to K.
+Optionally use SYSTEMPROMPT and the USER and ASSISTANT prompts."
+ (let ((tmpfile (make-temp-file "wasp-ai"))
+ (tmpfilesystem (make-temp-file "wasp-ai-system"))
+ (tmpfileuser (make-temp-file "wasp-ai-user"))
+ (tmpfileassistant (make-temp-file "wasp-ai-assistant"))
+ (buf (generate-new-buffer w/ai-buffer)))
+ (with-temp-file tmpfile (insert question))
+ (when systemprompt
+ (with-temp-file tmpfilesystem (insert systemprompt)))
+ (when user
+ (with-temp-file tmpfileuser
+ (if (stringp user)
+ (insert (s-concat user "\n"))
+ (--each user
+ (insert (s-concat it "\n"))))))
+ (when assistant
+ (with-temp-file tmpfileassistant
+ (if (stringp assistant)
+ (insert (s-concat assistant "\n"))
+ (--each assistant
+ (insert (s-concat it "\n"))))))
+ (with-current-buffer buf
+ (setq-local w/ai-callback k)
+ (erase-buffer))
+ (make-process
+ :name w/ai-process
+ :buffer buf
+ :command
+ (list
+ "chatgpt"
+ tmpfile
+ (if systemprompt tmpfilesystem "systemprompt.txt")
+ (if user tmpfileuser "userprompt.txt")
+ (if assistant tmpfileassistant "assistantprompt.txt"))
+ :stderr (get-buffer-create w/ai-error-buffer)
+ :sentinel
+ (lambda (_ _)
+ (with-current-buffer buf
+ (funcall w/ai-callback (s-trim (buffer-string))))))))
+
+(provide 'wasp-ai)
+;;; wasp-ai.el ends here
diff --git a/src/wasp-audio.el b/src/wasp-audio.el
new file mode 100644
index 00000000..56c85e70
--- /dev/null
+++ b/src/wasp-audio.el
@@ -0,0 +1,139 @@
+;;; wasp-audio --- On-stream audio input and output -*- lexical-binding: t; -*-
+;;; Commentary:
+;;; Code:
+
+(require 'wasp-utils)
+
+(defcustom w/play-audio-process "wasp-play-audio"
+ "Name of process for playing audio with mpv."
+ :type '(string)
+ :group 'wasp)
+
+(defcustom w/transcribe-process "wasp-transcribe"
+ "Name of process for transcribing speech using the Whisper API."
+ :type '(string)
+ :group 'wasp)
+
+(defcustom w/transcribe-buffer " *wasp-transcribe*"
+ "Name of buffer used to store transcription output."
+ :type '(string)
+ :group 'wasp)
+
+(defcustom w/transcribe-error-buffer " *wasp-transcribe-error*"
+ "Name of buffer used to store transcription errors."
+ :type '(string)
+ :group 'wasp)
+
+(defcustom w/stream-transcribe-buffer " *wasp-fake-chat-transcribe*"
+ "Name of buffer used to store stream transcription output."
+ :type '(string)
+ :group 'wasp)
+
+(defcustom w/stream-transcribe-error-buffer " *wasp-fake-chat-transcribe-error*"
+ "Name of buffer used to store fake chat transcription errors."
+ :type '(string)
+ :group 'wasp)
+
+(defvar w/current-stream-transcribe-process nil)
+(defvar w/last-stream-transcription "")
+(defvar w/stream-keep-transcribing t)
+
+(defun w/tts (msg)
+ "Use TTS to say MSG."
+ (start-process "wasp-tts" nil "say" (w/tempfile "wasp-tts" msg)))
+
+(defun w/play-audio (clip &optional k volume)
+ "Play CLIP using mpv.
+Call K when done.
+If VOLUME is specified, use it to adjust the volume (100 is default)."
+ (make-process
+ :name w/play-audio-process
+ :buffer nil
+ :command
+ (list
+ "mpv" "--ao=alsa" "--no-video"
+ (format "--volume=%s" (or volume 100))
+ clip)
+ :sentinel
+ (lambda (_ _)
+ (when k
+ (funcall k)))))
+
+(defun w/stop-all-audio ()
+ "Stop all audio by killing mpv processes."
+ (interactive)
+ (muzak-stop)
+ (start-process "pkill" nil "pkill" "mpv"))
+
+(defvar-local w/transcribe-callback nil)
+(defun w/begin-transcribe (k)
+ "Start recording audio to transcribe, passing the result to K."
+ (let ((buf (generate-new-buffer w/transcribe-buffer)))
+ (with-current-buffer buf
+ (setq-local w/transcribe-callback k)
+ (erase-buffer))
+ (message "Transcribing...")
+ (make-process
+ :name w/transcribe-process
+ :buffer buf
+ :command (list "transcribe")
+ :stderr (get-buffer-create w/transcribe-error-buffer)
+ :sentinel
+ (lambda (_ _)
+ (with-current-buffer buf
+ (funcall w/transcribe-callback (buffer-string)))))))
+(defun w/end-transcribe ()
+ "Finish recording transcription audio."
+ (interactive)
+ (message "End of transcription")
+ (start-process "pkill" nil "pkill" "parecord")
+ nil)
+
+(defun w/handle-stream-transcribe ()
+ "Start recording audio to transcribe."
+ (unless w/current-stream-transcribe-process
+ (with-current-buffer (get-buffer-create w/stream-transcribe-buffer)
+ (erase-buffer))
+ (setq
+ w/current-stream-transcribe-process
+ (make-process
+ :name "fig-fake-chat-transcribe"
+ :buffer (get-buffer-create w/stream-transcribe-buffer)
+ :command (list "transcribe")
+ :stderr (get-buffer-create w/stream-transcribe-error-buffer)
+ :sentinel
+ (lambda (_ _)
+ (setq w/current-stream-transcribe-process nil)
+ (with-current-buffer (get-buffer-create w/stream-transcribe-buffer)
+ (setq w/last-stream-transcription (buffer-string)))
+ (when w/stream-keep-transcribing
+ (w/handle-stream-transcribe)))))))
+
+(defun w/handle-stream-end-transcribe ()
+ "Stop recording audio to transcribe."
+ (when w/current-stream-transcribe-process
+ (start-process "pkill" nil "pkill" "parecord")))
+
+(defvar w/stream-transcribe-timer nil)
+(defun w/run-stream-transcribe-timer ()
+ "Run the fake chatter transcription timer."
+ (when w/stream-transcribe-timer
+ (cancel-timer w/stream-transcribe-timer))
+ (w/handle-stream-end-transcribe)
+ (setq
+ w/stream-transcribe-timer
+ (run-with-timer 10 nil #'w/run-stream-transcribe-timer)))
+
+(defun w/start-stream-transcribe ()
+ "Start transcribing speech for fake chatters."
+ (interactive)
+ (setq w/stream-keep-transcribing t)
+ (w/handle-stream-transcribe))
+(defun fig/stop-fake-chat-transcribe ()
+ "Stop transcribing speech for fake chatters."
+ (interactive)
+ (setq w/stream-keep-transcribing nil)
+ (w/handle-stream-end-transcribe))
+
+(provide 'wasp-audio)
+;;; wasp-audio.el ends here
diff --git a/src/wasp-bus.el b/src/wasp-bus.el
index 73952078..7ac672c9 100644
--- a/src/wasp-bus.el
+++ b/src/wasp-bus.el
@@ -107,5 +107,5 @@
:filter #'w/process-filter)
(w/sub-all))
-(provide 'wasp-network)
+(provide 'wasp-bus)
;;; wasp-bus.el ends here
diff --git a/src/wasp-chat.el b/src/wasp-chat.el
new file mode 100644
index 00000000..e21664d5
--- /dev/null
+++ b/src/wasp-chat.el
@@ -0,0 +1,258 @@
+;;; wasp-chat --- Chat display -*- lexical-binding: t; -*-
+;;; Commentary:
+;;; Code:
+
+(require 'dash)
+(require 's)
+(require 'evil)
+(require 'wasp-utils)
+
+(defcustom w/chat-buffer "*wasp-chat*"
+ "Name of buffer used to store the chat log."
+ :type '(string)
+ :group 'wasp)
+
+(defvar w/chat-header-line "")
+
+(define-derived-mode w/chat-overlay-mode special-mode "ClonkHead Stats"
+ "Major mode for displaying chatter statistics."
+ :group 'wasp
+ (setq mode-line-format nil))
+
+(defun w/get-chat-overlay-buffer (user)
+ "Return the stats buffer for USER."
+ (let ((name (format "*wasp-chatter %s*" user)))
+ (unless (get-buffer name)
+ (with-current-buffer (get-buffer-create name)
+ (w/chat-overlay-mode)))
+ (get-buffer name)))
+
+(defface w/chat-overlay-title
+ '((t
+ :foreground "white"
+ :height 300
+ ))
+ "Face for title."
+ :group 'wasp)
+
+(defface w/chat-overlay-category
+ '((t
+ :foreground "green"
+ ))
+ "Face for title."
+ :group 'wasp)
+
+(defconst w/chat-overlay-element-display-info
+ '(("fire" "🔥" "red")
+ ("water" "🌊" "blue")
+ ("wind" "🍃️" "green")
+ ("earth" "🪨" "brown")
+ ("lightning" "⚡" "yellow")
+ ("heart" "🩷" "pink")
+ ))
+(defun w/chat-overlay-display-element (e)
+ "Return a propertized string representing E."
+ (if-let ((dinfo (alist-get e w/chat-overlay-element-display-info nil nil #'s-equals?)))
+ (propertize
+ (format "%s %s" (car dinfo) e)
+ 'face (list :foreground (cadr dinfo)))
+ "O.O unknown?"))
+
+(defun w/chat-overlay-render (user)
+ "Render the stats buffer for USER."
+ (with-current-buffer (w/get-chat-overlay-buffer user)
+ (let* ((inhibit-read-only t))
+ (erase-buffer)
+ (w/write-line user 'w/chat-overlay-title)
+ (w/write-line "N/A")
+ (goto-char (point-min)))))
+
+(defvar w/chat-overlay-frame nil)
+(defvar w/chat-overlay-cur nil)
+(defun w/create-chat-overlay-frame ()
+ "Build a frame for displaying chatter stats on mouseover."
+ (when (framep w/chat-overlay-frame)
+ (delete-frame w/chat-overlay-frame))
+ (setf
+ w/chat-overlay-frame
+ (make-frame
+ (append
+ `((name . "clonkhead-io")
+ (wasp-prevent-focus . t)
+ (unsplittable . t)
+ (undecorated . t)
+ (no-accept-focus . t)
+ (no-focus-on-map . t)
+ (override-redirect . t)
+ (user-size . t)
+ (width . 30)
+ (height . 15)
+ (user-position . t)
+ (left . -1)
+ (top . -1)
+ (default-minibuffer-frame . ,(selected-frame))
+ (minibuffer . nil)
+ (left-fringe . 0)
+ (right-fringe . 0)
+ (cursor-type . nil)
+ (background-color . "black"))))))
+
+(defun w/show-chat-overlay-frame (vis)
+ "If VIS is non-nil, make the chat overlay frame visible.
+Otherwise make it invisible."
+ (if vis
+ (make-frame-visible w/chat-overlay-frame)
+ (setq w/chat-overlay-cur nil)
+ (make-frame-invisible w/chat-overlay-frame)))
+(defun w/move-chat-overlay-frame (x y)
+ "Move the chat overlay frame to X, Y."
+ (modify-frame-parameters
+ w/chat-overlay-frame
+ (list
+ (cons 'top y)
+ (cons 'left x))))
+(defun w/display-chat-overlay (user &optional x y)
+ "Display the chat overlay buffer for USER.
+Optionally display the window at X, Y"
+ (unless w/chat-overlay-frame
+ (w/create-chat-overlay-frame))
+ (let ((window (frame-selected-window w/chat-overlay-frame)))
+ (if (and x y)
+ (w/move-chat-overlay-frame x y)
+ (w/move-chat-overlay-frame -1 -1))
+ (w/chat-overlay-render user)
+ (setq w/chat-overlay-cur user)
+ (set-window-buffer window (w/get-chat-overlay-buffer user))
+ (w/show-chat-overlay-frame t)))
+(defun w/update-chat-overlay (user pos)
+ "Update the chat overlay frame for USER based on POS."
+ (if (and user pos)
+ (progn
+ (unless (equal (cons user pos) w/chat-overlay-cur)
+ (w/display-chat-overlay user (car pos) (cdr pos)))
+ )
+ (w/show-chat-overlay-frame nil)))
+(defun w/handle-chat-overlay ()
+ "Handle point movement for chat overlay popup."
+ (with-current-buffer (w/get-chat-buffer)
+ (w/update-chat-overlay
+ (get-text-property (point) 'wasp-user)
+ (window-absolute-pixel-position (point)))))
+
+(define-derived-mode w/chat-mode special-mode "Chat"
+ "Major mode for displaying chat."
+ :group 'wasp
+ (add-hook 'post-command-hook #'w/handle-chat-overlay nil t)
+ (advice-add 'handle-switch-frame :before-while #'w/prevent-focus-frame)
+ (setq-local window-point-insertion-type t)
+ (cond
+ (t (setq-local header-line-format '(:eval w/chat-header-line)))))
+
+(defun w/get-chat-buffer (&optional nm)
+ "Return the chat buffer.
+Optionally, return the buffer NM in chat mode."
+ (let ((bufnm (or nm w/chat-buffer)))
+ (unless (get-buffer bufnm)
+ (with-current-buffer (get-buffer-create bufnm)
+ (w/chat-mode)))
+ (get-buffer bufnm)))
+
+(defun w/clear-chat ()
+ "Clear the chat buffer."
+ (interactive)
+ (with-current-buffer (w/get-chat-buffer)
+ (let ((inhibit-read-only t))
+ (erase-buffer))))
+
+(defvar-keymap w/chat-mode-map
+ :suppress t
+ "C-l" #'w/clear-chat)
+(evil-define-key 'motion w/chat-mode-map (kbd "<return>") #'w/open-link)
+
+(defun w/write-chat-event (ev)
+ "Write the string EV to the chat buffer as an event (italicized)."
+ (let ((inhibit-read-only t))
+ (with-current-buffer (w/get-chat-buffer)
+ (goto-char (point-max))
+ (insert (propertize ev 'face 'italic))
+ (insert "\n"))))
+
+(w/defstruct
+ w/chat-message
+ user
+ id
+ text
+ user-color
+ sigil
+ faction
+ biblicality)
+
+(defun w/chat-button-action (b)
+ "Action run on button press for button B."
+ (let ((user (get-text-property (button-start b) 'wasp-user)))
+ (message user)))
+
+(defconst w/chat-substitution-godot-logo
+ (w/image-text (w/asset "misc/godot.png")))
+(defconst w/chat-substitution-powershell-logo
+ (w/image-text (w/asset "misc/powershell_small.png")))
+(defconst w/chat-substitutions
+ `(("[i](this was sent from godot)[/i]" . ,w/chat-substitution-godot-logo)
+ ("bald" . "ball")
+ ("pokemon" . "pal")
+ ("Pokemon" . "Pal")
+ ("POKEMON" . "PAL")
+ ("pal" . "pokemon")
+ ("Pal" . "Pokemon")
+ ("PAL" . "POKEMON")
+ ("hunter2" . "*******")
+ ("*******" . "hunter2")))
+
+(defun w/write-chat-message (msg)
+ "Write MSG to the chat buffer as USER with USERID and COLOR."
+ (let ((inhibit-read-only t))
+ (with-current-buffer (w/get-chat-buffer)
+ (goto-char (point-max))
+ (insert-text-button
+ (s-concat
+ (if (w/. sigil msg) (s-concat (w/. sigil msg) " ") "")
+ (w/. user msg))
+ 'face (list :foreground (or (w/. user-color msg) "#ffffff") :weight 'bold)
+ 'wasp-user (w/. user msg)
+ 'wasp-user-id (w/. id msg)
+ 'action #'w/chat-button-action)
+ (insert
+ (propertize
+ ": "
+ 'face
+ (list
+ :foreground
+ (cl-case (w/. faction msg)
+ (nate "pink")
+ (lever "lightblue")
+ (tony "lightgreen")
+ (t "white"))
+ )
+ ))
+ (insert (s-replace-all w/chat-substitutions (w/. text msg)))
+ (when (w/. biblicality msg)
+ (let* ((wwidth (- (window-total-width (get-buffer-window (current-buffer))) 3))
+ (bible-button-text (format "[biblicality %.2f]" (w/. biblicality msg)))
+ (msgwidth (line-beginning-position))
+ (lines (+ 1 (/ msgwidth wwidth))))
+ (insert
+ (propertize
+ " " 'display
+ `(space
+ :align-to
+ ,(- (+ (* wwidth lines) (- lines 1))
+ (length bible-button-text)
+ ))))
+ (insert
+ (propertize
+ bible-button-text
+ 'face '(:foreground "#bbbbbb")))))
+ (insert "\n"))))
+
+(provide 'wasp-chat)
+;;; wasp-chat.el ends here
diff --git a/src/wasp-db.el b/src/wasp-db.el
index 46999b5e..516fcfde 100644
--- a/src/wasp-db.el
+++ b/src/wasp-db.el
@@ -39,17 +39,20 @@
(defun w/db-parse-value ()
"Parse a single RESP value from the current buffer."
+ (w/write-log (format "parsing: %S" (buffer-string)))
(when-let ((c (char-after)))
(delete-char 1)
(cl-case c
(?+ (w/db-parse-rest))
(?: (string-to-number (w/db-parse-rest)))
(?$
- (let* ((len (string-to-number (w/db-parse-rest)))
- (ret (w/devour (point) (+ (point) len))))
- (w/munch ?\r)
- (w/munch ?\n)
- ret))
+ (let ((len (string-to-number (w/db-parse-rest))))
+ (if (= len -1)
+ ""
+ (let ((ret (w/devour (point) (+ (point) len))))
+ (w/munch ?\r)
+ (w/munch ?\n)
+ ret))))
(?*
(let ((len (string-to-number (w/db-parse-rest))))
(--map (w/db-parse-value) (-iota len))))
@@ -73,17 +76,23 @@ If not, return nil."
(insert data)
(set-marker (process-mark proc) (point))
(goto-char (point-min))
- (while (w/db-parse-response))))
+ (condition-case err
+ (while (w/db-parse-response))
+ (error
+ (w/write-chat-event (format "Database crashed, error: %s" err))
+ (w/db-disconnect)))))
(defun w/db-encode (x)
"Encode X for Redis."
(cond
- ((listp x) (format "*%d\r\n%s\r\n" (length x) (apply #'s-concat (-map #'w/db-encode x))))
- ((stringp x) (format "$%d\r\n%s\r\n" (string-bytes x) x))))
-
+ ((listp x) ;; encode lists as arrays
+ (format "*%d\r\n%s\r\n" (length x) (apply #'s-concat (-map #'w/db-encode x))))
+ ((stringp x) ;; encode strings as bulk strings
+ (format "$%d\r\n%s\r\n" (string-bytes x) x))))
(defun w/db-send-raw (msg)
"Send MSG to Redis."
+ (w/write-log (format "sending to redis: %s" msg))
(process-send-string w/db-process msg))
(defun w/db-cmd (cmd k)
@@ -100,7 +109,12 @@ If not, return nil."
(defun w/db-connect ()
"Connect to Redis."
(w/db-disconnect)
+ (queue-clear w/db-callback-queue)
+ (with-current-buffer (get-buffer-create w/db-buffer)
+ (set-buffer-multibyte nil)
+ (erase-buffer))
(make-network-process
+ :coding 'no-conversion
:name w/db-process
:buffer nil
:host w/db-host
@@ -109,11 +123,23 @@ If not, return nil."
(defun w/db-set (key val)
"Set KEY to VAL in Redis."
- (w/db-cmd `("SET" ,key ,val) (lambda (_) (message "ok"))))
+ (if (and (stringp key) (stringp val))
+ (w/db-cmd `("SET" ,key ,val) (lambda (_) nil))
+ (error "Redis key and value must be strings")))
(defun w/db-get (key k)
"Get KEY from Redis and pass the corresponding value to K."
- (w/db-cmd `("GET" ,key) k))
+ (if (stringp key)
+ (w/db-cmd `("GET" ,key) k)
+ (error "Redis key must be string")))
+
+(defun w/db-hset (key hkey val &rest vals)
+ "Set HKEY in hash KEY to VAL in Redis."
+ (w/db-cmd `("HSET" ,key ,hkey ,val ,@vals) (lambda (_) nil)))
+
+(defun w/db-hget (key hkey k)
+ "Get HKEY in hash KEY from Redis and pass the corresponding value to K."
+ (w/db-cmd `("HGET" ,key ,hkey) k))
(provide 'wasp-db)
;;; wasp-db.el ends here
diff --git a/src/wasp-event-handlers.el b/src/wasp-event-handlers.el
new file mode 100644
index 00000000..6702d3d1
--- /dev/null
+++ b/src/wasp-event-handlers.el
@@ -0,0 +1,16 @@
+;;; wasp-event-handlers --- Event handlers -*- lexical-binding: t; -*-
+;;; Commentary:
+;;; Code:
+
+(require 'wasp-bus)
+(require 'wasp-twitch)
+
+(setf
+ w/bus-event-handlers
+ (list
+ (cons '(monitor twitch chat incoming) #'w/twitch-handle-incoming-chat)
+ (cons '(monitor twitch redeem incoming) #'w/twitch-handle-redeem)
+ ))
+
+(provide 'wasp-event-handlers)
+;;; wasp-event-handlers.el ends here
diff --git a/src/wasp-hooks.el b/src/wasp-hooks.el
new file mode 100644
index 00000000..acb4b66c
--- /dev/null
+++ b/src/wasp-hooks.el
@@ -0,0 +1,10 @@
+;;; wasp-hooks --- Assorted hooks -*- lexical-binding: t; -*-
+;;; Commentary:
+;;; Code:
+
+(require 'wasp-utils)
+
+(defvar w/on-message-functions nil)
+
+(provide 'wasp-hooks)
+;;; wasp-hooks.el ends here
diff --git a/src/wasp-model.el b/src/wasp-model.el
new file mode 100644
index 00000000..2a2b99be
--- /dev/null
+++ b/src/wasp-model.el
@@ -0,0 +1,177 @@
+;;; wasp-model --- Model controls -*- lexical-binding: t; -*-
+;;; Commentary:
+;;; Code:
+
+(require 'dash)
+(require 's)
+(require 'f)
+(require 'ht)
+(require 'cl-lib)
+(require 'wasp-utils)
+(require 'wasp-bus)
+(require 'wasp-twitch)
+(require 'wasp-user)
+
+(defun w/color-value-to-html-code (cval)
+ "Convert color value CVAL to an HTML color code."
+ (and
+ cval
+ (format
+ "#%02x%02x%02x"
+ (truncate (* 255 (/ (car cval) 65535.0)))
+ (truncate (* 255 (/ (cadr cval) 65535.0)))
+ (truncate (* 255 (/ (caddr cval) 65535.0)))
+ )))
+
+(defun w/color-to-html-code (cname)
+ "Convert color name CNAME to an HTML color code."
+ (w/color-value-to-html-code (color-values cname)))
+
+(defvar w/model-palette-counter nil "Time to display model changes.")
+
+(defun w/model-record-change ()
+ "Record a change to the model in the counter."
+ (setf w/model-palette-counter 300))
+
+(defun w/model-reset ()
+ "Reset the model palette."
+ (interactive)
+ (w/pub '(avatar reset)))
+
+(defun w/model-toggle (toggle)
+ "Toggle TOGGLE on model."
+ (w/model-record-change)
+ (w/pub '(avatar toggle) (list toggle)))
+
+(defun w/model-background-text (msg)
+ "Change the background text of the model to MSG."
+ (let* ((cleanmsg (s-trim (w/clean-string msg)))
+ (encoded (w/encode-string cleanmsg)))
+ (unless (s-blank? cleanmsg)
+ (w/model-record-change)
+ (w/pub '(avatar text) (list encoded)))))
+
+(w/defstruct
+ w/color-source
+ type ;; 'color or 'twitch-emote or '7tv-emote or 'video-url
+ value)
+
+(defun w/string-to-color-source (s k)
+ "Convert S to a color source and pass it to K."
+ (w/twitch-get-emote
+ s
+ (lambda (emote)
+ (let ((7tv-emote (w/twitch-get-7tv-emote s))
+ (color (color-values s))
+ (url
+ (-contains?
+ '("www.youtube.com" "youtube.com" "youtu.be" "www.twitch.tv" "twitch.tv" "clips.twitch.tv")
+ (url-host (url-generic-parse-url s)))))
+ (funcall
+ k
+ (cond
+ (url (w/make-color-source :type 'video-url :value s))
+ (emote (w/make-color-source :type 'twitch-emote :value emote))
+ (7tv-emote (w/make-color-source :type '7tv-emote :value 7tv-emote))
+ (color (w/make-color-source :type 'color :value color))
+ (t nil)))))))
+
+(defun w/model-region-word (type msg)
+ "Change the model region TYPE to MSG."
+ (let* ((cleanmsg (s-trim (w/clean-string msg)))
+ (encodedmsg (w/encode-string cleanmsg)))
+ (unless (s-blank? cleanmsg)
+ (w/model-record-change)
+ (w/pub '(avatar palette word) (list type encodedmsg)))))
+
+(defun w/model-region-color (type color)
+ "Change the model region TYPE to COLOR."
+ (let* ((encodedcol (w/encode-string (w/color-value-to-html-code color))))
+ (w/model-record-change)
+ (w/pub '(avatar palette color) (list type encodedcol))))
+
+(defun w/model-region-image (type path)
+ "Change the model region TYPE to an image at PATH."
+ (interactive)
+ (let* ((cleanpath (s-trim (w/clean-string path)))
+ (encodedpath (w/encode-string cleanpath)))
+ (unless (s-blank? cleanpath)
+ (w/model-record-change)
+ (w/pub '(avatar palette image) (list type encodedpath)))))
+
+(defun w/model-region-video (type url)
+ "Change the model region TYPE to a video at URL."
+ (interactive)
+ (let* ((cleanurl (s-trim (w/clean-string url)))
+ (encodedurl (w/encode-string cleanurl)))
+ (unless (s-blank? cleanurl)
+ (w/model-record-change)
+ (w/pub '(avatar palette video) (list type encodedurl)))))
+
+(defun w/model-region-user-avatar (type user)
+ "Change the model region TYPE to USER's avatar."
+ (w/twitch-get-user-avatar
+ user
+ (lambda ()
+ (when (f-exists? (w/twitch-user-avatar-path user))
+ (w/model-region-image type (w/twitch-user-avatar-path user))))))
+
+(defun w/model-region-color-source (type cs)
+ "Change the model region TYPE to CS."
+ (cl-case (w/color-source-type cs)
+ (color
+ (w/model-region-color
+ type
+ (w/color-source-value cs)))
+ (twitch-emote
+ (w/model-region-image
+ type
+ (w/twitch-emote-path (w/color-source-value cs))))
+ (7tv-emote
+ (w/model-region-image
+ type
+ (w/twitch-7tv-emote-path (w/color-source-value cs))))
+ (video-url
+ (w/model-region-video
+ type
+ (w/color-source-value cs)))
+ (t nil)))
+
+(defun w/handle-redeem-region-swap (type)
+ "Return a redeem callback for region swap of TYPE.
+If the color is unspecified, use DEFCOLOR."
+ (lambda (user inp)
+ (let ((splinp (s-split-up-to " " (s-trim inp) 1))
+ (auth (w/user-authorized)))
+ (w/string-to-color-source
+ (car splinp)
+ (lambda (cs)
+ (let ((text (if cs (cadr splinp) (s-join " " splinp))))
+ (w/write-chat-event (format "%s changes my %s to %s" user type inp))
+ (when cs
+ (if (or auth
+ (not (eq 'video-url (w/color-source-type cs))))
+ (w/model-region-color-source type cs)
+ (w/write-chat-event (format "%s is not authorized to play video, boost harder" user))))
+ (when text
+ (w/model-region-word type text))))))))
+
+(defvar w/model-timer nil)
+(defun w/run-model-timer ()
+ "Run the model timer."
+ (when w/model-timer
+ (cancel-timer w/model-timer))
+
+ (when w/model-palette-counter
+ (cl-decf w/model-palette-counter)
+ (when (<= w/model-palette-counter 0)
+ (setf w/model-palette-counter nil)
+ (w/model-reset)
+ ))
+
+ (setq
+ w/model-timer
+ (run-with-timer 1 nil #'w/run-model-timer)))
+
+(provide 'wasp-model)
+;;; wasp-model.el ends here
diff --git a/src/wasp-obs.el b/src/wasp-obs.el
new file mode 100644
index 00000000..3c960f12
--- /dev/null
+++ b/src/wasp-obs.el
@@ -0,0 +1,116 @@
+;;; wasp-obs --- OBS controls -*- lexical-binding: t; -*-
+;;; Commentary:
+;;; Code:
+
+(require 'dash)
+(require 's)
+(require 'f)
+(require 'wasp-utils)
+(require 'wasp-bus)
+
+(defun w/obs-toggle-modclonk ()
+ "Toggle the MODCLONK panel."
+ (w/pub '(monitor obs toggle) (list "MODCLONK" "MODCLONK Chibi")))
+
+(defun w/obs-toggle-live-reaction ()
+ "Toggle the Live LCOLONQ Reaction panel."
+ (w/pub '(monitor obs toggle) (list "Live LCOLONQ Reaction" "Live Reaction")))
+
+(defun w/obs-toggle-live-friend-reaction ()
+ "Toggle the Live Friend Reaction panel."
+ (w/pub '(monitor obs toggle) (list "Live Friend Reaction" "Live Friend Reaction Group")))
+
+(defun w/obs-toggle-thug-life ()
+ "Toggle the Thug Life overlay."
+ (w/pub '(monitor obs toggle) (list "Thug Life" "Thug Life Video")))
+
+(defun w/obs-toggle-intj-stare ()
+ "Toggle the INTJ Stare overlay."
+ (w/pub '(monitor obs toggle) (list "INTJ" "INTJ Image")))
+
+(defun w/obs-toggle-critical-hit ()
+ "Toggle the Critical Hit overlay."
+ (w/pub '(monitor obs toggle) (list "Critical Hit Wrapper" "Critical Hit")))
+
+(defun w/obs-toggle-vhs ()
+ "Toggle the VHS overlay."
+ (w/pub '(monitor obs toggle) (list "VHS" "VHS Group")))
+
+(defun w/obs-toggle-saiyan ()
+ "Toggle the Super Saiyan overlay."
+ (w/pub '(monitor obs toggle) (list "Saiyan" "Saiyan Video")))
+
+(defun w/obs-toggle-persona4 ()
+ "Toggle the Persona 4 dialogue box."
+ (w/pub '(monitor obs toggle) (list "Persona 4" "Persona 4 Background")))
+
+(defun w/obs-toggle-explosion ()
+ "Toggle the explosion effect."
+ (w/pub '(monitor obs toggle) (list "Explosion" "Explosion Video")))
+
+(defun w/obs-set-clickbait-text (msg)
+ "Change the clickbait text to MSG."
+ (w/pub '(monitor obs set-text) (list "Red Arrow Text" (w/encode-string (s-trim msg)))))
+
+(defun w/obs-toggle-clickbait (&optional msg)
+ "Toggle the clickbait arrow.
+Optionally, change text to MSG."
+ (when msg
+ (w/obs-set-clickbait-text msg))
+ (w/pub '(monitor obs toggle) (list "Red Arrow" "Red Arrow Group")))
+
+(defun w/obs-toggle-chase-dreams ()
+ "Toggle the Chasing Dreams effect."
+ (w/pub '(monitor obs toggle) (list "Chasing Dreams" "Dreams")))
+
+(w/defstruct
+ w/obs-toggle
+ toggle
+ reset
+ (timer 0))
+
+(defun w/obs-activate-toggle-helper (toggle &rest args)
+ "Pass ARGS to the callback for TOGGLE and start its timer."
+ (unless (w/obs-toggle-timer toggle)
+ (apply (w/obs-toggle-toggle toggle) args))
+ (setf (w/obs-toggle-timer toggle) (w/obs-toggle-reset toggle)))
+
+(defvar w/obs-toggles
+ (list
+ (cons 'modclonk (w/make-obs-toggle :toggle #'w/obs-toggle-modclonk :reset 11))
+ (cons 'live-reaction (w/make-obs-toggle :toggle #'w/obs-toggle-live-reaction :reset 17))
+ (cons 'live-friend-reaction (w/make-obs-toggle :toggle #'w/obs-toggle-live-friend-reaction :reset 17))
+ (cons 'thug-life (w/make-obs-toggle :toggle #'w/obs-toggle-thug-life :reset 17))
+ (cons 'intj-stare (w/make-obs-toggle :toggle #'w/obs-toggle-intj-stare :reset 17))
+ (cons 'critical-hit (w/make-obs-toggle :toggle #'w/obs-toggle-critical-hit :reset 3))
+ (cons 'clickbait (w/make-obs-toggle :toggle #'w/obs-toggle-clickbait :reset 31))
+ (cons 'chase-dreams (w/make-obs-toggle :toggle #'w/obs-toggle-chase-dreams :reset 31))
+ ))
+
+(defun w/obs-activate-toggle (tnm &rest args)
+ "Pass ARGS to the callback for toggle symbol TNM and start its timer."
+ (when-let ((toggle (alist-get tnm w/obs-toggles)))
+ (apply #'w/obs-activate-toggle-helper toggle args)))
+
+(defun w/obs-handle-toggles ()
+ "Process all OBS toggle timers."
+ (--each w/obs-toggles
+ (when (w/obs-toggle-timer (cdr it))
+ (cl-decf (w/obs-toggle-timer (cdr it)))
+ (when (<= (w/obs-toggle-timer (cdr it)) 0)
+ (setf (w/obs-toggle-timer (cdr it)) nil)
+ (funcall (w/obs-toggle-toggle (cdr it)))))
+ ))
+
+(defvar w/obs-timer nil)
+(defun w/run-obs-timer ()
+ "Run the obs timer."
+ (when w/obs-timer
+ (cancel-timer w/obs-timer))
+ (w/obs-handle-toggles)
+ (setq
+ w/obs-timer
+ (run-with-timer 1 nil #'w/run-obs-timer)))
+
+(provide 'wasp-obs)
+;;; wasp-obs.el ends here
diff --git a/src/wasp-twitch-chat-commands.el b/src/wasp-twitch-chat-commands.el
new file mode 100644
index 00000000..3c679365
--- /dev/null
+++ b/src/wasp-twitch-chat-commands.el
@@ -0,0 +1,155 @@
+;;; wasp-twitch-chat-commands --- Twitch redeems -*- lexical-binding: t; -*-
+;;; Commentary:
+;;; Code:
+
+(require 'soundboard)
+(require 'wasp-twitch)
+(require 'wasp-ai)
+
+;; gizmos
+(require 'wasp-pronunciation)
+
+(setq
+ w/twitch-chat-commands
+ (list
+ (cons
+ "!commands"
+ (lambda (_ _)
+ (w/twitch-say
+ (s-concat
+ "Available commands: "
+ (s-join " " (--filter (s-contains? "!" it) (-map #'car w/twitch-chat-commands)))))))
+ (cons "MRBEAST" (lambda (_ _) (soundboard//play-clip "mrbeast.mp3")))
+ (cons "NICECOCK" (lambda (_ _) (soundboard//play-clip "pantsintoashes.mp3")))
+ (cons "hexadiCoding" (lambda (_ _) (soundboard//play-clip "developers.ogg")))
+ (cons "roguelike" (lambda (user _) (w/twitch-say (format "@%s that's not a roguelike" user))))
+ (cons "arch btw" (lambda (_ _) (w/twitch-say "I use nix btw")))
+ ;; (cons "heart" (lambda (_ _) (fig/increment-heartrate-counter)))
+ ;; (cons "bpm" (lambda (_ _) (fig/increment-heartrate-counter)))
+ ;; (cons "BPM" (lambda (_ _) (fig/increment-heartrate-counter)))
+ (cons "discord" (lambda (_ _) (w/twitch-say "https://discord.gg/f4JTbgN7St")))
+ (cons "Discord" (lambda (_ _) (w/twitch-say "https://discord.gg/f4JTbgN7St")))
+ (cons "!irc" (lambda (_ _) (w/twitch-say "#cyberspace on IRC at colonq.computer:26697 (over TLS)")))
+ (cons "IRC" (lambda (_ _) (w/twitch-say "#cyberspace on IRC at colonq.computer:26697 (over TLS)")))
+
+ (cons "!today" (lambda (_ _) (w/twitch-say (s-trim (w/slurp "~/today.txt")))))
+ (cons
+ "!fish"
+ (lambda (_ _)
+ (w/twitch-say (shell-command-to-string "fishing"))))
+ (cons "!nc" (lambda (_ _) (w/twitch-say "try: \"nc colonq.computer 31340\", if nc doesn't work try ncat or telnet")))
+ (cons "!oomfie" (lambda (_ _) (w/twitch-say "hi!!!!!!!")))
+ (cons "!pronunciation" (lambda (_ _) (w/twitch-say (w/pronuciation))))
+ ;; (cons "!jetsWave" (lambda (_ _) (fig//twitch-say (fig/slurp "jetsWave.txt"))))
+ ;; (cons "!forth" (lambda (_ _) (fig//twitch-say "https://github.com/lcolonq/giving")))
+ (cons "!oub" (lambda (_ _) (w/twitch-say "https://oub.colonq.computer")))
+ (cons "!game" (lambda (_ _) (w/twitch-say "https://oub.colonq.computer")))
+ (cons "!pubnix" (lambda (_ _) (w/twitch-say "https://pub.colonq.computer")))
+ (cons "!ring" (lambda (_ _) (w/twitch-say "https://pub.colonq.computer")))
+ (cons "!webring" (lambda (_ _) (w/twitch-say "https://pub.colonq.computer")))
+ (cons "!animeguide" (lambda (_ _) (w/twitch-say "https://nixos-and-flakes.thiscute.world/introduction")))
+ (cons "!sponsor" (lambda (_ _) (w/twitch-say "Like what you see? Don't forget to download GNU Emacs at https://www.gnu.org/software/emacs/?code=LCOLONQ")))
+ (cons "!specs" (lambda (_ _) (w/twitch-say "Editor: evil-mode, WM: EXWM, OS: NixOS, hardware: shit laptop")))
+ (cons "!coverage" (lambda (_ _) (w/twitch-say (format "Test coverage: %s%%" (random 100)))))
+ (cons "!learnprogramming" (lambda (_ _) (w/twitch-say "1) program")))
+ (cons "!github" (lambda (_ _) (w/twitch-say "https://github.com/lcolonq")))
+ (cons "!language" (lambda (_ _) (w/twitch-say "probably emacs lisp or maybe rust")))
+ (cons "!onlyfans" (lambda (_ _) (soundboard//play-clip "pornhub.mp3")))
+ (cons "!throne" (lambda (_ _) (w/twitch-say "xdding")))
+ (cons "!vim" (lambda (_ _) (w/twitch-say "vi is the best text editor, emacs is the best operating system")))
+ (cons "!emacs" (lambda (_ _) (w/twitch-say "i've tried everything else emacs is best girl")))
+ (cons "!bells" (lambda (_ _) (w/twitch-say "https://pub.colonq.computer/~bezelea/bells/ and https://pub.colonq.computer/~prod/toy/dbkai/")))
+ (cons "!help" (lambda (_ _) (w/twitch-say "https://pub.colonq.computer/~prod/toy/glossary/")))
+ (cons
+ "!boost"
+ (lambda (user _)
+ (w/twitch-say (format "boost power for @%s: %s" user (alist-get :boost w/user-current)))))
+ (cons
+ "!faction"
+ (lambda (user _)
+ (w/twitch-say (format "faction for %s: %s" user (alist-get :faction w/user-current)))))
+ (cons "!thanks" (lambda (user _) (w/twitch-say (format "thank you %s!" user))))
+ (cons "!bible" (lambda (_ _) (w/twitch-say "https://www.youtube.com/watch?v=G5u23bh29hI")))
+ (cons "!drink" (lambda (_ _) (w/twitch-say "its watah im drinkin it")))
+ (cons
+ "!lore"
+ (lambda (_ _)
+ (w/ai
+ "ITEM"
+ (lambda (msg) (w/twitch-say msg))
+ "Please produce a Dark Souls style item name and description related to LCOLONQ. Please limit your response to one sentence maximum. The sentence should be vague and incorporate archaic words that are not commonly used. LCOLONQ is a spirit that lives inside the computer. LCOLONQ is associated with: the moon, snakes, the color grey, dolls and puppets, amber, the wind, and GNU Emacs. The description should mostly describe the item, but with vague insinuations about the true nature of LCOLONQ."
+ "ITEM"
+ "Ring of Favor and Protection - A ring symbolizing the favor and protection of the goddess Fina, known in legend to possess fateful beauty.")))
+ ;; (cons "!geisercounter" (lambda (_ _) (fig//twitch-say (format "The Geiser counter beeps %s times" (fig//geiser-counter)))))
+ ;; (cons "!8ball"
+ ;; (lambda (user inp)
+ ;; (let ((trimmed (s-trim (s-replace "!8ball" "" inp))))
+ ;; (fig//8ball
+ ;; trimmed
+ ;; (lambda (answer)
+ ;; (fig//twitch-say (format "@%s 8ball says: %s" user answer)))))))
+ ;; (cons "!bookrec"
+ ;; (lambda (_ _)
+ ;; (let ((choice (nth (random (length fig/recommended-books)) fig/recommended-books)))
+ ;; (fig//twitch-say (format "%s (recommended by %s)" (car choice) (cdr choice))))))
+ ;; (cons "!addbookrec"
+ ;; (lambda (user inp)
+ ;; (let ((trimmed (s-trim (s-replace "!addbookrec" "" inp))))
+ ;; (fig//write-chat-event (format "%s recommends: %s" user trimmed))
+ ;; (fig//add-recommended-book user trimmed))))
+ ;; (cons "!quote"
+ ;; (lambda (_ _)
+ ;; (let ((choice (nth (random (length fig/quotes)) fig/quotes)))
+ ;; (fig//twitch-say (format "%s: %s" (cdr choice) (car choice))))))
+ ;; (cons "!addquote"
+ ;; (lambda (user inp)
+ ;; (let ((trimmed (s-trim (s-replace "!addquote" "" inp))))
+ ;; (fig//write-chat-event (format "%s saves quote: %s" user trimmed))
+ ;; (fig//add-quote user trimmed))))
+ ;; (cons "!resolution"
+ ;; (lambda (user inp)
+ ;; (let ((trimmed (s-trim (s-replace "!resolution" "" inp))))
+ ;; (if (string-empty-p trimmed)
+ ;; (fig//write-chat-event "You gotta put what your resolution is.")
+ ;; (fig//write-chat-event (format "%s RESOLVES: %s" (s-upcase user) trimmed))
+ ;; (fig//set-db-entry user :resolution trimmed)))))
+ ;; (cons "!twitter"
+ ;; (lambda (_ _)
+ ;; (fig/ask "How do you feel about Twitter? Should viewers follow LCOLONQ on Twitter?" #'fig/say)
+ ;; (fig//twitch-say "https://twitter.com/LCOLONQ")))
+ ;; ;; (cons "!aoc" (lambda (_ _) (fig//twitch-say "Join our leaderboard: 3307583-b61f237c")))
+ ;; (cons "!roll" (lambda (user _) (fig//twitch-say (fig//character-to-string (fig//roll-character user)))))
+ ;; (cons
+ ;; "!leaderboard"
+ ;; (lambda (_ _)
+ ;; (let* ((users (fig//all-db-users))
+ ;; (user-scores (-filter #'cdr (--map (cons it (alist-get :boost (fig//load-db it))) users)))
+ ;; (sorted (-sort (-on #'> #'cdr) user-scores))
+ ;; (leaders (-take 5 sorted)))
+ ;; (fig//twitch-say (s-join ", " (--map (format "%s: %s" (car it) (cdr it)) leaders))))))
+ ;; (cons
+ ;; "draobredael!"
+ ;; (lambda (_ _)
+ ;; (let* ((users (fig//all-db-users))
+ ;; (user-scores (-filter #'cdr (--map (cons it (alist-get :boost (fig//load-db it))) users)))
+ ;; (sorted (-sort (-on #'< #'cdr) user-scores))
+ ;; (leaders (-take 5 sorted)))
+ ;; (fig//twitch-say (s-join ", " (--map (format "%s: %s" (reverse (car it)) (cdr it)) leaders))))))
+ ;; (cons
+ ;; "!vippers"
+ ;; (lambda (_ _)
+ ;; (let ((vipperstring (s-join ", " (fig//shuffle-seq fig//twitch-vip-list))))
+ ;; (fig//twitch-say (seq-take vipperstring 450)))
+ ;; (fig//twitch-get-vip-list)))
+ ;; (cons "!levelup"
+ ;; (lambda (user _)
+ ;; (fig//update-db-character
+ ;; user
+ ;; (lambda (c)
+ ;; (cl-incf (fig//rpg-character-level c))
+ ;; c))
+ ;; (fig//twitch-say (fig//character-to-string (fig//get-db-character user)))))
+ ))
+
+(provide 'wasp-twitch-chat-commands)
+;;; wasp-twitch-chat-commands.el ends here
diff --git a/src/wasp-twitch-redeems.el b/src/wasp-twitch-redeems.el
new file mode 100644
index 00000000..faee4c89
--- /dev/null
+++ b/src/wasp-twitch-redeems.el
@@ -0,0 +1,97 @@
+;;; wasp-twitch-redeems --- Twitch redeems -*- lexical-binding: t; -*-
+;;; Commentary:
+;;; Code:
+
+(require 'dash)
+(require 's)
+(require 'soundboard)
+(require 'wasp-twitch)
+(require 'wasp-model)
+(require 'wasp-obs)
+(require 'wasp-user)
+(require 'wasp-friend)
+(require 'bezelea-muzak)
+
+(setf
+ w/twitch-redeems
+ (list
+ (list
+ "BOOST" 1
+ (lambda (user _)
+ (soundboard//play-clip "yougotboostpower.ogg")
+ (w/write-chat-event (s-concat user " boosted their boost number"))
+ (cl-incf (alist-get :boost w/user-current 0))))
+ (list
+ "TSOOB" 1
+ (lambda (user _)
+ (soundboard//play-clip "rewoptsoobtoguoy.ogg" 140)
+ (w/write-chat-event (s-reverse (s-concat user " boosted their boost number")))
+ (cl-decf (alist-get :boost w/user-current 0))))
+ (list
+ "submit headline" 1
+ (lambda (user inp)
+ (w/write-chat-event (format "%s submitted a headline: %s" user inp))
+ (w/friend-journalism user inp)))
+ (list
+ "spinne" 3
+ (lambda (user _)
+ (w/write-chat-event (s-concat user " activates the spinne cyclle"))
+ (w/model-toggle "spin")))
+ (list
+ "forsen" 3
+ (lambda (_ _)
+ (soundboard//play-clip "cave3.ogg" 75)
+ (w/model-toggle "forsen")))
+ (list "SEASICKNESS GENERATOR" 3 (lambda (_ _) (w/model-toggle "zoom_wave")))
+ (list
+ "pursue idol dream" 3
+ (lambda (user _)
+ (w/write-chat-event (format "Helping %s pursue their idol dream~" user))
+ (w/obs-activate-toggle 'chase-dreams)
+ (w/model-region-user-avatar "hair" user)))
+ (list
+ "bells of bezelea" 4
+ (lambda (user msg)
+ (muzak//get-song
+ msg
+ (lambda (song)
+ (if song
+ (progn
+ (w/write-chat-event (format "%s played a song: %s (sponsored by Bezelea)" user msg))
+ (muzak/play-song msg))
+ (w/write-chat-event (format "%s played the bells (sponsored by Bezelea)" user))
+ (muzak/play-tracks msg))))))
+ (list "palette swap (hair)" 5 (w/handle-redeem-region-swap "hair"))
+ (list "palette swap (highlight)" 5 (w/handle-redeem-region-swap "highlight"))
+ (list "palette swap (eyes)" 5 (w/handle-redeem-region-swap "eyes"))
+ (list "palette swap (hat)" 5 (w/handle-redeem-region-swap "hat"))
+ (list
+ "feed friend" 10
+ (lambda (user inp)
+ (w/write-chat-event (s-concat user " feeds \"friend\" " inp))
+ (w/friend-feed user inp)))
+ (list
+ "talk to friend" 10
+ (lambda (user inp)
+ (w/write-chat-event (s-concat user " talks to \"friend\": " inp))
+ (w/friend-chat user inp)))
+ (list
+ "gamer" 500
+ (lambda (user _)
+ (w/write-chat-event (s-concat user " quickscoped me"))
+ (soundboard//play-clip "videogame.ogg")
+ (w/obs-activate-toggle 'thug-life)))
+ (list
+ "arrow" 500
+ (lambda (user msg)
+ (w/write-chat-event (format "%s points and says %S" user msg))
+ (w/obs-activate-toggle 'clickbait msg)))
+ (list
+ "super idol" 500
+ (lambda (_ _)
+ (w/twitch-say "SuperIdoldexiaorongdoumeinidetianbayuezhengwudeyangguangdoumeiniyaoyanreai105Cdenididiqingchundezhen")
+ (soundboard//play-clip "superidol.mp3")))
+ ))
+
+(provide 'wasp-twitch-redeems)
+;;; wasp-twitch-redeems.el ends here
diff --git a/src/wasp-twitch.el b/src/wasp-twitch.el
new file mode 100644
index 00000000..aa51d17b
--- /dev/null
+++ b/src/wasp-twitch.el
@@ -0,0 +1,463 @@
+;;; wasp-twitch --- Twitch integration -*- lexical-binding: t; -*-
+;;; Commentary:
+;;; Code:
+
+(require 'dash)
+(require 's)
+(require 'ht)
+(require 'evil)
+(require 'wasp-utils)
+(require 'wasp-bus)
+(require 'wasp-chat)
+(require 'wasp-user)
+
+;; gizmos
+(require 'wasp-biblicality)
+
+(defcustom w/twitch-avatar-cache-dir (w/asset "avatars/")
+ "The directory in which to store downloaded avatar images."
+ :type '(string)
+ :group 'wasp)
+
+(defcustom w/twitch-emote-cache-dir (w/asset "emotes/")
+ "The directory in which to store downloaded emote images."
+ :type '(string)
+ :group 'wasp)
+
+(defcustom w/twitch-7tv-emote-cache-dir (w/asset "7tv-emotes/")
+ "The directory in which to store downloaded 7TV emote images."
+ :type '(string)
+ :group 'wasp)
+
+(defcustom w/twitch-api-server "https://api.twitch.tv/helix"
+ "Server URL for Twitch API."
+ :type '(string)
+ :group 'wasp)
+
+(defcustom w/twitch-7tv-api-server "https://7tv.io/v3"
+ "Server URL for 7TV API."
+ :type '(string)
+ :group 'wasp)
+
+(defvar w/twitch-last-response nil)
+(defvar w/twitch-7tv-last-response nil)
+(defvar w/twitch-vip-list nil)
+(defvar w/twitch-7tv-emote-map nil)
+(defvar w/twitch-chat-history nil)
+(defvar w/twitch-current-stream-title nil)
+(defvar w/twitch-emote-frame-counter 0)
+(defvar w/twitch-emote-frame-timer nil)
+(defvar w/twitch-redeems nil)
+(defvar w/twitch-chat-commands nil)
+
+(defun w/twitch-api-get (loc k)
+ "Get LOC from the Twitch API, passing the returned JSON to K."
+ (request
+ (s-concat w/twitch-api-server loc)
+ :type "GET"
+ :headers
+ `(("Authorization" . ,w/sensitive-twitch-user-token)
+ ("Client-Id" . ,w/sensitive-twitch-client-id)
+ ("Content-Type" . "application/json"))
+ :parser #'json-parse-buffer
+ :success
+ (cl-function
+ (lambda (&key data &allow-other-keys)
+ (setq w/twitch-last-response data)
+ (funcall k data))))
+ t)
+
+(defun w/twitch-api-post (loc fields k)
+ "Post FIELDS to LOC at the Twitch API, passing the returned JSON to K."
+ (request
+ (s-concat w/twitch-api-server loc)
+ :type "POST"
+ :data (json-encode fields)
+ :headers
+ `(("Authorization" . ,w/sensitive-twitch-user-token)
+ ("Client-Id" . ,w/sensitive-twitch-client-id)
+ ("Content-Type" . "application/json"))
+ :parser #'json-parse-buffer
+ :error
+ (cl-function
+ (lambda (&key data &allow-other-keys)
+ (print data)
+ (message "error")))
+ :success
+ (cl-function
+ (lambda (&key data &allow-other-keys)
+ (setq w/twitch-last-response data)
+ (funcall k data))))
+ t)
+
+(defun w/twitch-7tv-api-get (loc k)
+ "Get LOC from the 7TV API, passing the returned JSON to K."
+ (request
+ (s-concat w/twitch-7tv-api-server loc)
+ :type "GET"
+ :headers
+ `(("Content-Type" . "application/json"))
+ :parser #'json-parse-buffer
+ :success
+ (cl-function
+ (lambda (&key data &allow-other-keys)
+ (setq w/twitch-7tv-last-response data)
+ (funcall k data))))
+ t)
+(defun w/twitch-7tv-update-emotes ()
+ "Download the current list of 7TV emotes and populate `w/7tv-emote-map'."
+ (w/twitch-7tv-api-get
+ (s-concat "/users/twitch/" w/twitch-broadcaster-id)
+ (lambda (data)
+ (let* ((emotes (ht-get (ht-get data "emote_set") "emotes")))
+ (setq w/twitch-7tv-emote-map (ht-create))
+ (--each (seq-into emotes 'list)
+ (ht-set! w/twitch-7tv-emote-map (ht-get it "name") (ht-get it "id")))))))
+
+(defun w/twitch-cache-emote (name id)
+ "Add an association between emote NAME and ID in the cache."
+ (w/db-hset "emotes" name id))
+(defun w/twitch-get-emote (name k)
+ "Retrieve the emote ID for NAME and pass it to K."
+ (w/db-hget
+ "emotes" name
+ (lambda (d)
+ (funcall k (if (s-present? d) d nil)))))
+
+(defun w/twitch-get-7tv-emote (name)
+ "Retrieve the 7TV emote ID for NAME."
+ (ht-get w/twitch-7tv-emote-map name))
+
+(defun w/twitch-user-avatar-path (user)
+ "Get the path to USER's avatar."
+ (s-concat w/twitch-avatar-cache-dir user ".png"))
+
+(defun w/twitch-update-title ()
+ "Get our stream title and update `w/twitch-current-stream-title'."
+ (w/twitch-api-get
+ (s-concat "/channels?broadcaster_id=" w/twitch-broadcaster-id)
+ (lambda (data)
+ (let ((title (ht-get (aref (ht-get data "data") 0) "title")))
+ (setq w/twitch-current-stream-title title)))))
+
+(defun w/twitch-create-redeem (title cost prompt color input)
+ "Create a new channel point redeem with TITLE COST PROMPT COLOR and INPUT."
+ (w/twitch-api-post
+ (s-concat "/channel_points/custom_rewards?broadcaster_id=" w/twitch-broadcaster-id)
+ `(("title" . ,title)
+ ("cost" . ,cost)
+ ("prompt" . ,prompt)
+ ("background_color" . ,color)
+ ("is_user_input_required" . ,input))
+ (lambda (data)
+ (ignore data)
+ (message "Redeem created"))))
+
+(defun w/twitch-get-user-id (user k)
+ "Get the ID for USER and pass it to K."
+ (w/twitch-api-get
+ (s-concat "/users?login=" user)
+ (lambda (data)
+ (let ((id (ht-get (aref (ht-get data "data") 0) "id")))
+ (funcall k id)))))
+
+(defun w/twitch-get-recent-clips (userid k)
+ "Get clips from the last week for USERID and pass them to K."
+ (w/twitch-api-get
+ (s-concat "/clips?broadcaster_id=" userid)
+ (lambda (data)
+ (funcall k (seq-map (lambda (it) (ht-get it "url")) (ht-get data "data"))))))
+
+(defun w/twitch-get-user-recent-clips (user k)
+ "Get clips from the last week for USER and pass them to K."
+ (w/twitch-get-user-id
+ user
+ (lambda (userid)
+ (w/twitch-get-recent-clips userid k))))
+
+(defun w/twitch-get-user-avatar (user k)
+ "Download the avatar for USER and save it to the avatar cache.
+K is called when the download is finished."
+ (let ((path (w/twitch-user-avatar-path user)))
+ (if (f-exists? path)
+ (funcall k)
+ (w/twitch-api-get
+ (s-concat "/users?login=" user)
+ (lambda (data)
+ (let ((url (ht-get (aref (ht-get data "data") 0) "profile_image_url")))
+ (w/write-log (format "downloading avatar: %s %s" url path))
+ (make-process
+ :name "wasp-download-avatar"
+ :buffer nil
+ :command (list "get_avatar_smol" url path)
+ :sentinel
+ (lambda (_ _)
+ (funcall k)))))))))
+
+(defun w/twitch-add-vip (user)
+ "Give VIP status to USER."
+ (w/pub '(monitor twitch vip add) (list user)))
+
+(defun w/twitch-remove-vip (user)
+ "Remove VIP status from USER."
+ (w/pub '(monitor twitch vip remove) (list user)))
+
+(defun w/twitch-shoutout (user)
+ "Shoutout USER."
+ (w/pub '(monitor twitch shoutout) (list user)))
+(defvar w/twitch-shoutout-queue nil)
+(defun w/twitch-enqueue-shoutout (user)
+ "Queue up a shoutout for USER."
+ (push user w/twitch-shoutout-queue))
+(defvar w/twitch-shoutout-timer nil)
+(defun w/twitch-run-shoutout-timer ()
+ "Run the shoutout timer."
+ (when w/twitch-shoutout-timer
+ (cancel-timer w/twitch-shoutout-timer))
+ (when-let ((user (pop w/twitch-shoutout-queue)))
+ (w/twitch-shoutout user))
+ (setq
+ w/twitch-shoutout-timer
+ (run-with-timer 150 nil #'w/twitch-run-shoutout-timer)))
+
+(defvar w/twitch-current-poll-callback nil
+ "A callback that is called and passed the poll winner when the poll concludes.")
+
+(defvar w/twitch-current-prediction-ids nil
+ "Prediction and outcome identifiers for the current prediction.")
+
+(defun w/twitch-create-poll (title options &optional callback)
+ "Create a poll with TITLE and OPTIONS.
+CALLBACK will be passed the winner when the poll concludes."
+ (unless w/twitch-current-poll-callback
+ (setq w/twitch-current-poll-callback callback)
+ (w/pub
+ '(monitor twitch poll create)
+ (list (s-truncate 60 (s-trim title)) options))))
+
+(defun w/twitch-create-prediction (title options)
+ "Create a prediction with TITLE and OPTIONS."
+ (unless w/twitch-current-prediction-ids
+ (w/pub '(monitor twitch prediction create) (list title options))))
+
+(defun w/twitch-finish-prediction (outcome)
+ "Finish the current prediction with winning OUTCOME."
+ (when w/twitch-current-prediction-ids
+ (w/pub
+ '(monitor twitch prediction finish)
+ (list (car w/twitch-current-prediction-ids)
+ (car (alist-get outcome (cadr w/twitch-current-prediction-ids) nil nil #'s-equals?))))))
+
+(defun w/twitch-say (msg)
+ "Write MSG to Twitch chat."
+ (let ((trimmed (s-trim msg)))
+ (w/write-chat-message
+ (w/make-chat-message
+ :user "LCOLONQ"
+ :id "866686220"
+ :text trimmed
+ :user-color "#616161"))
+ (w/pub '(monitor twitch chat outgoing) (list trimmed))))
+
+(defun w/twitch-add-image-over (image msg start end)
+ "Add IMAGE to MSG between START and END."
+ (with-temp-buffer
+ (insert msg)
+ (add-text-properties
+ start end
+ `(display
+ ,image
+ rear-nonsticky t))
+ (buffer-string)))
+
+(defun w/twitch-emote-path (emoteid)
+ "Get the canonical path for EMOTEID."
+ (s-concat w/twitch-emote-cache-dir emoteid))
+
+(defun w/twitch-7tv-emote-path (emoteid)
+ "Get the canonical path for EMOTEID."
+ (s-concat w/twitch-7tv-emote-cache-dir emoteid))
+
+(defun w/twitch-download-emote-then (emoteid k)
+ "Ensure that EMOTEID exists in the cache and then call K."
+ (let* ((path (w/twitch-emote-path emoteid))
+ (url (format "https://static-cdn.jtvnw.net/emoticons/v2/%s/default/dark/1.0" emoteid)))
+ (unless (f-exists? path)
+ (make-process
+ :name "wasp-download-emote"
+ :buffer nil
+ :command (list "curl" "-L" url "-o" path)
+ :sentinel
+ (lambda (_ _)
+ (funcall k))))))
+
+(defun w/twitch-download-7tv-emote-then (emoteid k)
+ "Ensure that EMOTEID exists in the cache and then call K."
+ (let* ((path (w/twitch-7tv-emote-path emoteid))
+ (url (format "https://cdn.7tv.app/emote/%s/1x.webp" emoteid)))
+ (unless (f-exists? path)
+ (make-process
+ :name "wasp-download-7tv-emote"
+ :buffer nil
+ :command (list "get_7tv_fixed" url path)
+ :sentinel
+ (lambda (_ _)
+ (funcall k))))))
+
+(defun w/twitch-download-emote (emoteid)
+ "Ensure that EMOTEID exists in the cache."
+ (w/twitch-download-emote-then emoteid (lambda () nil)))
+
+(defun w/twitch-download-7tv-emote (emoteid)
+ "Ensure that EMOTEID exists in the cache."
+ (w/twitch-download-7tv-emote-then emoteid (lambda () nil)))
+
+(defun w/twitch-add-7tv-emotes (msg)
+ "Propertize MSG with images corresponding to 7TV emotes."
+ (let* ((sp (s-split " " msg)))
+ (s-join
+ " "
+ (--map
+ (if-let* ((eid (w/twitch-get-7tv-emote it))
+ (path (w/twitch-7tv-emote-path eid))
+ (img (create-image path)))
+ (progn
+ (propertize
+ it
+ 'display
+ img
+ 'rear-nonsticky t))
+ it)
+ sp))))
+
+(defun w/twitch-insert-7tv-emote (nm)
+ "Insert a 7TV emote with NM in the current buffer."
+ (when-let* ((eid (w/twitch-get-7tv-emote nm))
+ (path (w/twitch-7tv-emote-path eid))
+ (img (create-image path)))
+ (insert
+ (propertize
+ nm
+ 'display
+ img
+ 'rear-nonsticky t))))
+
+(defun w/twitch-process-emote-range (er msg)
+ "Given a string ER of form emoteid:start-end, add the emote MSG."
+ (if (string-empty-p er)
+ msg
+ (when-let* ((er-split (s-split ":" er))
+ (emoteid (car er-split))
+ (range-split (s-split "-" (cadr er-split)))
+ (start (string-to-number (car range-split)))
+ (end (string-to-number (cadr range-split)))
+ (emotemsg (substring msg start (+ end 1)))
+ (path (w/twitch-emote-path emoteid)))
+ (w/twitch-cache-emote emotemsg emoteid)
+ (w/twitch-download-emote emoteid)
+ (let ((img (create-image path)))
+ (w/twitch-add-image-over img msg (+ start 1) (+ end 2))
+ ))))
+
+(defun w/twitch-process-emote-ranges (ers msg)
+ "Apply all of ERS to MSG."
+ (--reduce-from (w/twitch-process-emote-range it acc) msg ers))
+
+(defun w/twitch-advance-frame-in-chat-buffer ()
+ "Advance all animated emotes in the (visible) chat buffer by 1 frame."
+ (cl-incf w/twitch-emote-frame-counter)
+ (save-excursion
+ (with-current-buffer (w/get-chat-buffer)
+ (goto-char (point-max))
+ (forward-line -10)
+ (goto-char (line-beginning-position))
+ (while (not (eobp))
+ (let ((plist (text-properties-at (point)))
+ (next-change
+ (or (next-property-change (point) (current-buffer))
+ (point-max))))
+ (when-let* ((plist-true plist)
+ (disp (plist-get plist 'display))
+ (is-image (equal (car disp) 'image))
+ (image-props (cdr disp))
+ (image-type (plist-get image-props :type))
+ (is-gif (equal image-type 'gif))
+ (multi-frame (or (plist-get (cdr disp) :animate-multi-frame-data) (image-multi-frame-p disp)))
+ )
+ (let ((frame (% w/twitch-emote-frame-counter (car multi-frame))))
+ (image-show-frame disp frame)))
+ (goto-char next-change))))))
+
+(defun w/twitch-run-emote-frame-timer ()
+ "Run the emote frame timer."
+ (when w/twitch-emote-frame-timer
+ (cancel-timer w/twitch-emote-frame-timer))
+ (w/twitch-advance-frame-in-chat-buffer)
+ (setq
+ w/twitch-emote-frame-timer
+ (run-with-timer 0.03 nil #'w/twitch-run-emote-frame-timer)))
+
+(defun w/twitch-handle-incoming-chat (msg)
+ "Write MSG to the chat buffer, processing any commands."
+ (w/write-log (format "%s" msg))
+ (let ((user (w/decode-string (car msg))))
+ (w/user-bind
+ user
+ (lambda ()
+ (let* ((tags (cadr msg))
+ (userid (car (w/saget "user-id" tags)))
+ (color (car (w/saget "color" tags)))
+ (emotes (car (w/saget "emotes" tags)))
+ ;; (badges (s-split "," (car (w/saget "badges" tags))))
+ (text (w/decode-string (caddr msg)))
+ (biblicality (w/bible-colorize-sentence text))
+ (text-colored-bible (car biblicality))
+ (text-with-emotes
+ (w/twitch-add-7tv-emotes
+ (w/twitch-process-emote-ranges
+ (s-split "/" emotes)
+ text-colored-bible))))
+ (push (cons user text) w/twitch-chat-history)
+ (w/write-chat-message
+ (w/make-chat-message
+ :user user
+ :id userid
+ :text text-with-emotes
+ :user-color (when (s-present? color) color)
+ :biblicality (cdr biblicality)))
+ (--each w/twitch-chat-commands
+ (when (s-contains? (car it) text)
+ (funcall (cdr it) user text))))))))
+
+(defun w/twitch-handle-redeem (r)
+ "Handle the channel point redeem R."
+ (w/write-log r)
+ (let* ((user (car r))
+ (redeem (cadr r))
+ (encoded-input (caddr r))
+ (input (when encoded-input (w/decode-string encoded-input)))
+ (handler (alist-get redeem w/twitch-redeems nil nil #'s-equals?)))
+ (if handler
+ (w/user-bind
+ user
+ (lambda ()
+ (funcall (cadr handler) user input)))
+ (w/write-log (format "Unknown channel point redeem: %S" redeem)))))
+
+(defun w/twitch-handle-redeem-api (r)
+ "Handle a channel point redeem R coming from the API."
+ (w/write-log r)
+ (let* ((encoded-user (car r))
+ (encoded-redeem (cadr r))
+ (encoded-input (caddr r))
+ (user (when encoded-user (w/decode-string encoded-user)))
+ (redeem (when encoded-redeem (w/decode-string encoded-redeem)))
+ (input (when encoded-input (w/decode-string encoded-input)))
+ (handler (alist-get redeem w/twitch-redeems nil nil #'s-equals?)))
+ (when (< (car handler) 1000)
+ (if handler
+ (w/user-bind user (lambda () (funcall (cadr handler) user input)))
+ (w/write-log (format "Unknown channel point redeem: %S" redeem))))))
+
+(provide 'wasp-twitch)
+;;; wasp-twitch.el ends here
diff --git a/src/wasp-user-whitelist.el b/src/wasp-user-whitelist.el
new file mode 100644
index 00000000..ff362073
--- /dev/null
+++ b/src/wasp-user-whitelist.el
@@ -0,0 +1,136 @@
+;;; wasp-user-whitelist --- User whitelist -*- lexical-binding: t; -*-
+;;; Commentary:
+;;; Code:
+
+(setq
+ w/user-whitelist
+ (list
+ "Bezelea"
+ "fn_lumi"
+ "MxOwlex"
+ "NikolaRHristov"
+ "goofysystem"
+ "MoMoMoVT"
+ "SnorlaxBud"
+ "GenDude"
+ "zulleyy3"
+ "freedrull_"
+ "theUnseenMystic"
+ "MNKN844"
+ "fartingle"
+ "mickynoon"
+ "DJKawaiiFieri"
+ "NyxKrage"
+ "mawjad_"
+ "crane0001"
+ "convergent_sequence"
+ "nugbones"
+ "NineteenNinetyX"
+ "fuelsniffer"
+ "y1nyng"
+ "RoflrawrVT"
+ "DFluxStreams"
+ "Spaecplex"
+ "IcefoxZettai"
+ "mTinks"
+ "Meowlitary"
+ "CamuiCh"
+ "joelsgp"
+ "redheleftyou"
+ "VortisLoste"
+ "duxies_"
+ "SsJsSs"
+ "flyann"
+ "Wina"
+ "MORGVN_"
+ "TheIdOfAlan"
+ "body_without_blorgans"
+ "cbtcaptain"
+ "iLoidtupo"
+ "shwasteddd"
+ "acher0_"
+ "badcop_"
+ "Hat_Knight"
+ "crazy_stewie"
+ "OrdinaryClover_oc"
+ "Soymilk"
+ "37LN37"
+ "Kopadot"
+ "Hixrabbit"
+ "prodzpod"
+ "DocMaho"
+ "Celeste_Kyra"
+ "fighting_annelids"
+ "eientei95"
+ "GyrosGeier"
+ "FoggyRoses"
+ "StuxVT"
+ "imgeiser"
+ "liquidcake1"
+ "4ll4m3nts"
+ "Luigi401"
+ "sleepysleepy6"
+ "TheMaroonHatHacker"
+ "CodeSpace0x25"
+ "RetroBoi128theGameDev"
+ "yellowberryHN"
+ "DoctorGlitchy"
+ "vvizualizer"
+ "KuromaruOniisan"
+ "j_art_"
+ "BugVT"
+ "vchewbah"
+ "yiffweed"
+ "ESTRE777A"
+ "frizst"
+ "auts__"
+ "floorrip"
+ "DestinyWaits"
+ "Tomaterr"
+ "Ivellon"
+ "RyanWinchester_"
+ "InspectorDiameter"
+ "ryasuar"
+ "schizoidcarp"
+ "forraz99"
+ "The_IronShark"
+ "EricAlvin"
+ "nichePenguin"
+ "fredfuchs_en"
+ "Gleil"
+ "nightowlmocha"
+ "ishishiee"
+ "pigeonGuidedMissile"
+ "ClaudetteVT"
+ "stoicmana"
+ "PartlyAtomic"
+ "GinjiVitis"
+ "vesdeg"
+ "jazzahol_VT"
+ "BigGayMikey"
+ "game11454"
+ "maradyne_"
+ "HenriqMarq"
+ "Ricardo_Stryki"
+ "klingonne"
+ "ChiriPoco"
+ "realradiodisney"
+ "Sodacoma_"
+ "fannyslam"
+ "ShyRyan"
+ "ZedZark"
+ "skibiditoiletonahole"
+ "regularamoeba"
+ "VerryckterVT"
+ "ZamielPayne"
+ "chixie9901"
+ "BuddysPizza"
+ "nigelwithrow"
+ "usernamerlin"
+ "caram3lnuke"
+ "TheCoppinger"
+ "DerMarkus1982"
+ ))
+
+(provide 'wasp-user-whitelist)
+;;; wasp-user-whitelist.el ends here
diff --git a/src/wasp-user.el b/src/wasp-user.el
new file mode 100644
index 00000000..fa07e752
--- /dev/null
+++ b/src/wasp-user.el
@@ -0,0 +1,74 @@
+;;; wasp-user --- User data -*- lexical-binding: t; -*-
+;;; Commentary:
+;;; Code:
+
+(require 's)
+(require 'wasp-utils)
+(require 'wasp-db)
+
+(defvar w/user-whitelist nil)
+
+(defvar w/user-current-name nil)
+(defvar w/user-current nil)
+
+(defun w/user-db-key (nm)
+ "Return the database key for user NM."
+ (s-concat "user:" (s-downcase nm)))
+
+(defun w/user-get (nm k)
+ "Fetch user data for user NM.
+Pass the resulting Lisp form to K."
+ (when (and nm (stringp nm) (functionp k))
+ (w/db-get
+ (w/user-db-key nm)
+ (lambda (d)
+ (if-let*
+ ((d)
+ (stringp d)
+ (res (w/read-sexp d)))
+ (funcall k res)
+ (funcall k nil))))))
+
+(defun w/user-set (nm d)
+ "Save the Lisp form D as the user data for NM."
+ (when (and nm (stringp nm) d)
+ (w/db-set
+ (w/user-db-key nm)
+ (format "%S" d))))
+
+(defun w/user-bind (nm k)
+ "Bind the data for user NM to `w/user-current' during K.
+Save it back to the database after K returns."
+ (w/user-get
+ nm
+ (lambda (d)
+ (let ((w/user-current d)
+ (w/user-current-name nm))
+ (funcall k)
+ (w/user-set nm w/user-current)))))
+
+(defun w/user-authorized ()
+ "Return non-nil if the current user is authorized to use advanced techniques."
+ (let ((boost (alist-get :boost w/user-current)))
+ (or (and boost (> boost 2))
+ (and boost (< boost -2))
+ (-contains? w/user-whitelist w/user-current-name))))
+
+(defun w/user-boost (user)
+ "Increase USER's boost power by 1."
+ (w/user-get
+ user
+ (lambda (d)
+ (cl-incf (alist-get :boost d 0))
+ (w/user-set user d))))
+
+(defun w/user-tsoob (user)
+ "Decrement USER's boost power by 1."
+ (w/user-get
+ user
+ (lambda (d)
+ (cl-decf (alist-get :boost d 0))
+ (w/user-set user d))))
+
+(provide 'wasp-user)
+;;; wasp-user.el ends here
diff --git a/src/wasp-utils.el b/src/wasp-utils.el
index 15148f74..875295b6 100644
--- a/src/wasp-utils.el
+++ b/src/wasp-utils.el
@@ -3,6 +3,7 @@
;;; Code:
(require 's)
+(require 'f)
(require 'cl-lib)
(require 'eieio)
(require 'request)
@@ -12,6 +13,11 @@
:type '(string)
:group 'wasp)
+(defun w/read-sexp (s)
+ "Read string S into a Lisp form.
+Return nil on error."
+ (condition-case nil (read s) (error nil)))
+
(defun w/write (text &optional face)
"Write TEXT to the current buffer and apply FACE."
(let ((text-final (if face (propertize text 'face face) text)))
@@ -29,7 +35,7 @@
"Write LINE to the log buffer and apply FACE."
(with-current-buffer (get-buffer-create w/log-buffer)
(goto-char (point-max))
- (w/write-line (w/clean-string (format "%s" line)) face)
+ (w/write-line (format "%s" line) face)
(goto-char (point-max))))
(defmacro w/defstruct (name &rest body)
@@ -116,7 +122,8 @@ Optionally append EXT to the path."
(defun w/devour (start end)
"Delete and return the region from START to END."
- (let ((ret (buffer-substring start end)))
+ (w/write-log (format "devouring: %s %s %s" start end (buffer-string)))
+ (let ((ret (decode-coding-string (buffer-substring start end) 'utf-8)))
(delete-region start end)
ret))
@@ -147,7 +154,39 @@ Otherwise, throw an error."
(delete-char 1)
t)
(error (format "While parsing, expected %c but found %c" c char))))
-
+
+(defun w/get-stream-primary-window ()
+ "Get the marked primary stream window."
+ (window-at-x-y 0 0))
+
+(defun w/open-link ()
+ "Open URL in the primary stream window."
+ (interactive)
+ (when-let ((url (thing-at-point 'url t)))
+ (select-window (w/get-stream-primary-window))
+ (browse-url url)))
+
+(defun w/prevent-focus-frame (e)
+ "Prevent focus from reaching popup frame E."
+ (not (frame-parameter (cadr e) 'wasp-prevent-focus)))
+
+(defconst w/asset-base-path (f-canonical "./assets/"))
+(defun w/asset (path)
+ "Return the absolute path given an asset path PATH."
+ (f-join w/asset-base-path path))
+
+(defun w/image-text (path &optional text)
+ "Return TEXT propertized with the image at PATH.
+If TEXT is nil, use the empty string instead."
+ (propertize
+ (or text "i")
+ 'display
+ (create-image path)
+ 'rear-nonsticky t))
+
+(defsubst w/saget (k a)
+ "Retrieve the value for string key K in alist A."
+ (alist-get k a nil nil #'s-equals?))
(provide 'wasp-utils)
;;; wasp-utils.el ends here
diff --git a/wasp.el b/wasp.el
index 92492495..9af03581 100644
--- a/wasp.el
+++ b/wasp.el
@@ -4,8 +4,61 @@
(require 'f)
+(add-to-list 'load-path (f-canonical "./secret/"))
(add-to-list 'load-path (f-canonical "./src/"))
+(add-to-list 'load-path (f-canonical "./src/gizmo/"))
+(add-to-list 'load-path (f-canonical "./src/contrib/"))
+
+;; do not open this on stream
+(require 'wasp-sensitive)
+
+;; core
(require 'wasp-utils)
+(require 'wasp-hooks)
+(require 'wasp-bus)
+(require 'wasp-db)
+(require 'wasp-user)
+(require 'wasp-ai)
+(require 'wasp-audio)
+(require 'wasp-model)
+(require 'wasp-obs)
+(require 'wasp-chat)
+(require 'wasp-twitch)
+
+;; gizmos
+(require 'wasp-pronunciation)
+(require 'wasp-biblicality)
+(require 'wasp-newspaper)
+(require 'wasp-friend)
+
+;; configuration
+(require 'wasp-user-whitelist)
+(require 'wasp-twitch-chat-commands)
+(require 'wasp-twitch-redeems)
+(require 'wasp-event-handlers)
+
+;; user contrib
+(require 'bezelea-muzak)
+
+;; initialization
+(w/connect)
+(w/db-connect)
+(w/create-chat-overlay-frame)
+(w/show-chat-overlay-frame nil)
+(w/twitch-7tv-update-emotes)
+(w/twitch-update-title)
+
+(w/twitch-run-shoutout-timer)
+(w/twitch-run-emote-frame-timer)
+(w/run-model-timer)
+(w/run-obs-timer)
+(w/run-stream-transcribe-timer)
+
+(w/populate-bible-table)
+
+;; (defun w/fix-user-database-ok (user)
+;; "Fix USER's database entry."
+;; (w/user-set user (fig//db2-serialize-old-entry (fig//load-db-old user))))
(provide 'wasp)
;;; wasp.el ends here