diff options
Diffstat (limited to 'src')
37 files changed, 1216 insertions, 1133 deletions
diff --git a/src/gizmo/wasp-alert-message.el b/src/gizmo/wasp-alert-message.el index fcd8f6b3..fb80f002 100644 --- a/src/gizmo/wasp-alert-message.el +++ b/src/gizmo/wasp-alert-message.el @@ -12,10 +12,10 @@ (defconst w/alert-message-phrases (list - "hi :3" - "Chat seems active. Considerrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr" - "Witscord The Game 2025" - )) + "hi :3" + "Chat seems active. Considerrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr" + "Witscord The Game 2025" + )) (defcustom w/alert-message-buffer "*wasp-alert-message*" "Name of buffer used to display alert message." @@ -49,8 +49,8 @@ (cancel-timer w/alert-message-timer)) (w/render-alert-message) (setq - w/alert-message-timer - (run-with-timer 10 nil #'w/run-alert-message-timer))) + w/alert-message-timer + (run-with-timer 10 nil #'w/run-alert-message-timer))) (w/run-alert-message-timer) (provide 'wasp-alert-message) diff --git a/src/gizmo/wasp-animism.el b/src/gizmo/wasp-animism.el new file mode 100644 index 00000000..80c6f70e --- /dev/null +++ b/src/gizmo/wasp-animism.el @@ -0,0 +1,57 @@ +;;; wasp-animism --- Superterranean Animism Overlay -*- lexical-binding: t; -*- +;;; Commentary: +;;; Code: + +(require 'wasp-utils) +(require 'wasp-bus) +(require 'wasp-prod) + +(add-to-list 'load-path (f-canonical "~/src/animism/")) +(require 'bulletml) + +;; src,Xway,fire^쾠㘽쾷ㅗ껋㾨먝乲뛏屚w㮇㸩멽ꝼ쓋♫릫m떫쓏䓳⩺䮻1㨧퉝ƭ쓐ǥᓌ㒵ᒄ먽乳俴㢈쿗峫ฐꙢ왽욍투ㅖ㨧슝呑㟪䁓Ɂy䏧呠3먫슎呒3⧘ɍy욋ᕈ00먫⇳ +;; this one is broken fix it -ellg, probably + +(defconst w/overlay-spellcard-names + '("Joel" "Pemis" "JoelTeachingHisSonJolHowToSpinWhileWideBorisPassesBy" "bugSegz" + "widepeepoMASTURBATION77769420GANGSHITNOMOREFORTNITE19DOLLERFORTNITECARD" + "Machine Made Of Fire, Heart Made Of Doves" + "Dream Seal" "Evil-Sealing Circle" "Dream Seal -Spread-" "Dream Seal -Concentrate-" + "Duplex Barrier" "Dream Orb" "Omnidirectional Oni-Binding Circle" "Yin-Yang Treasured Orb" + "Yin-Yang Kishin Orb" "Dream Orb String" "Yin-Yang Scattering" "Exorcising Border" + "Yin-Yang King Piece" "Illusionary Moon" "Flying Mysterious Shrine Maiden" + "Dream Seal -Blink-" "Great Duplex Barrier" "Dream Seal -Worn-" "Dream Seal -Marred-" + "Dream Seal -The Point Of The Mask-" + )) + +(defvar w/overlay-barrage-active nil) +(defvar w/overlay-last-cursor nil) +(defun w/overlay-update-cursor () + "Inform the overlay about the current cursor position." + (when (and w/overlay-barrage-active (process-live-p (get-process w/bus-process))) + (when-let ((pos (window-absolute-pixel-position))) + (when (not (equal pos w/overlay-last-cursor)) + (setf w/overlay-last-cursor pos) + (w/pub '(overlay cursor) (list (- (car pos) 1920) (cdr pos))))))) +(add-hook 'post-command-hook #'w/overlay-update-cursor) + +(defun w/overlay-start-barrage (bml) + "Start a barrage on the overlay using the BulletML source string BML." + (w/pub '(overlay barrage start) (list (w/encode-string bml)))) + +(defun w/overlay-decode-shorthand-bml (s k) + "Decode the shorthand BulletML string S. +Pass the resulting BulletML XML string to K." + ;; (w/write-log s) + (w/prod-get-raw + (format "/api/yamame?input=%s" (url-encode-url s)) + (lambda (data) + (if-let* ((bml (bml/parse-string data)) + (b (bml/initialize bml)) + ((bml/barrage-toplevel b))) + (progn + (funcall k data)) + (w/write-chat-event "That spell card is too powerful... "))))) + +(provide 'wasp-animism) +;;; wasp-animism.el ends here diff --git a/src/gizmo/wasp-aoc.el b/src/gizmo/wasp-aoc.el index 57b16c32..4c287add 100644 --- a/src/gizmo/wasp-aoc.el +++ b/src/gizmo/wasp-aoc.el @@ -19,23 +19,23 @@ (defvar w/aoc-user-stars nil) (defconst w/aoc-name-map '(("exodrifter_" . "exodrifter") - ("cephon_altera" . "lainlayer") - ("monochrome_0" . "monochrome") - ("yoink2000" . "darius1702") - ("lukeisun_" . "lukeisun") - ("dwinkley_" . "dwinkley") - ("lcolonq" . "llll colonq") - ("fn_lumi" . "lumi") - ("leadengin" . "leaden") - ("vasher_1025" . "vash3r") - ("andrewdtr" . "drawthatredstone") - ("badcop_" . "cgsdev0") - ("asrael_io" . "asrael") - ("colinahscopy_" . "@colinahscopy") - ("ctrl_o" . "control-o") - ("whimsicallymade" . "aecepoglu") - ("chromosundrift" . "christo") - )) + ("cephon_altera" . "lainlayer") + ("monochrome_0" . "monochrome") + ("yoink2000" . "darius1702") + ("lukeisun_" . "lukeisun") + ("dwinkley_" . "dwinkley") + ("lcolonq" . "llll colonq") + ("fn_lumi" . "lumi") + ("leadengin" . "leaden") + ("vasher_1025" . "vash3r") + ("andrewdtr" . "drawthatredstone") + ("badcop_" . "cgsdev0") + ("asrael_io" . "asrael") + ("colinahscopy_" . "@colinahscopy") + ("ctrl_o" . "control-o") + ("whimsicallymade" . "aecepoglu") + ("chromosundrift" . "christo") + )) (defun w/aoc-max-stars () "Return the maximum Advent of Code stars for today." @@ -44,7 +44,7 @@ (defun w/aoc-lookup-stars (user) "Retrieve the Advent of Code stars for USER." (let* ((duser (s-downcase user)) - (cuser (s-downcase (alist-get duser w/aoc-name-map duser nil #'s-equals?)))) + (cuser (s-downcase (alist-get duser w/aoc-name-map duser nil #'s-equals?)))) (alist-get cuser w/aoc-user-stars nil nil #'s-equals?))) (defun w/aoc-fetch-api (k) @@ -58,24 +58,24 @@ Pass the resulting JSON to K." :parser #'json-parse-buffer :success (cl-function - (lambda (&key data &allow-other-keys) - (setq w/aoc-last-response data) - (funcall k data)))) + (lambda (&key data &allow-other-keys) + (setq w/aoc-last-response data) + (funcall k data)))) nil) (defun w/aoc-update-user-stars () "Update the Advent of Code stars list." (w/aoc-fetch-api - (lambda (data) - (setf - w/aoc-user-stars - (--map - (cons (s-downcase (car it)) (cdr it)) - (--filter - (stringp (car it)) + (lambda (data) + (setf + w/aoc-user-stars (--map - (cons (ht-get it "name") (ht-get it "stars")) - (ht-values (ht-get data "members"))))))))) + (cons (s-downcase (car it)) (cdr it)) + (--filter + (stringp (car it)) + (--map + (cons (ht-get it "name") (ht-get it "stars")) + (ht-values (ht-get data "members"))))))))) ;; (w/aoc-update-user-stars) (provide 'wasp-aoc) diff --git a/src/gizmo/wasp-bannerads.el b/src/gizmo/wasp-bannerads.el index 70f9c8be..7d64ac1b 100644 --- a/src/gizmo/wasp-bannerads.el +++ b/src/gizmo/wasp-bannerads.el @@ -49,20 +49,18 @@ (cancel-timer w/banner-ad-timer)) (w/render-banner-ad) (setq - w/banner-ad-timer - (run-with-timer 60 nil #'w/run-banner-ad-timer))) -(w/run-banner-ad-timer) - + w/banner-ad-timer + (run-with-timer 60 nil #'w/run-banner-ad-timer))) (defun w/banner-ad-block () "Toggle adblock." (setq w/banner-ad-block t) (w/render-banner-ad) - (w/model-toggle-set "adblock") + (w/model-toggle-set "adblock") (run-with-timer 10 nil (lambda () (setq w/banner-ad-block nil) - (w/model-toggle-unset "adblock") + (w/model-toggle-unset "adblock") (w/render-banner-ad))) nil) diff --git a/src/gizmo/wasp-biblicality.el b/src/gizmo/wasp-biblicality.el index 317e87f7..db169337 100644 --- a/src/gizmo/wasp-biblicality.el +++ b/src/gizmo/wasp-biblicality.el @@ -14,17 +14,18 @@ (defun w/bible-canonize (user) "Add USER to the bible 1000 times." (w/append-file - (s-concat "\n" (s-repeat 1000 (s-concat user " "))) - (w/asset "bible.txt")) + (s-concat "\n" (s-repeat 1000 (s-concat user " "))) + (w/asset "bible.txt")) (ht-set! w/bible-table user 1000)) (defun w/populate-bible-table () "Populate `w/bible-table' from the Bible text file." (unless w/bible-table - (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))) + ;; (let* ((bible-string (s-downcase (w/slurp (w/asset "bible.txt")))) + (let* ((bible-string (s-downcase (w/slurp (w/asset "medical.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))))) @@ -33,47 +34,46 @@ (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 + -666.0 (let ((occs (ht-get w/bible-table (downcase (s-trim word)))) - (thresh 0.6)) + (thresh 0.6)) (if occs - ;; (+ thresh (/ (min occs 1000.0) (/ 1000.0 (- 1.0 thresh)))) - (+ thresh (/ (min occs 10.0) (/ 10.0 (- 1.0 thresh)))) + (+ 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)))))) + (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))) +;; (format "#00%02x%02x" others others))) (defun w/bible-colorize-sentence (sen) "Propertize SEN with colors representing word biblicality." (if w/bible-table - (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))))) + (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))))) (cons sen 0.0))) (provide 'wasp-biblicality) diff --git a/src/gizmo/wasp-bless.el b/src/gizmo/wasp-bless.el index 109b2f35..c3175548 100644 --- a/src/gizmo/wasp-bless.el +++ b/src/gizmo/wasp-bless.el @@ -22,21 +22,21 @@ "Construct an Emacs Lisp value representation of the value J." (let ((tag (alist-get 'tag j))) (cond - ((s-equals? tag "ValueInteger") (alist-get 'contents j)) - ((s-equals? tag "ValueArray") - (-map #'w/bless-parse-value (alist-get 'contents j))) - (t (message "Unknown Bless tag: %s" tag))))) + ((s-equals? tag "ValueInteger") (alist-get 'contents j)) + ((s-equals? tag "ValueArray") + (-map #'w/bless-parse-value (alist-get 'contents j))) + (t (message "Unknown Bless tag: %s" tag))))) (defun w/bless-parse-effect (j) "Construct an Emacs Lisp value representation of the effect J." (let ((tag (alist-get 'tag j)) - (c (alist-get 'contents j))) - (cond - ((s-equals? tag "EffectPrint") `(print ,(w/bless-parse-value c))) - ((s-equals? tag "EffectPrintBackwards") `(print-backwards ,(w/bless-parse-value c))) - ((s-equals? tag "EffectSoundboard") `(soundboard ,(w/bless-parse-value c))) - ((s-equals? tag "EffectModelToggle") `(model-toggle ,(w/bless-parse-value c))) - ))) + (c (alist-get 'contents j))) + (cond + ((s-equals? tag "EffectPrint") `(print ,(w/bless-parse-value c))) + ((s-equals? tag "EffectPrintBackwards") `(print-backwards ,(w/bless-parse-value c))) + ((s-equals? tag "EffectSoundboard") `(soundboard ,(w/bless-parse-value c))) + ((s-equals? tag "EffectModelToggle") `(model-toggle ,(w/bless-parse-value c))) + ))) (defun w/bless-parse-stack (j) "Construct an Emacs Lisp value representation of the stack J." @@ -63,32 +63,32 @@ Optionally limit evaluation to FUEL steps." (with-current-buffer buf (erase-buffer)) (make-process - :name "wasp-bless-eval" - :buffer buf - :command `("bless" "-j" "eval" ,@(if fuel (list "--fuel" (number-to-string fuel)) nil) ,str) - :sentinel - (lambda (_ _) - (let* ((s (with-current-buffer buf (buffer-string))) - (j (json-read-from-string s)) - (status (alist-get 'status j))) - (kill-buffer buf) - (if (s-equals? status "success") - (funcall + :name "wasp-bless-eval" + :buffer buf + :command `("bless" "-j" "eval" ,@(if fuel (list "--fuel" (number-to-string fuel)) nil) ,str) + :sentinel + (lambda (_ _) + (let* ((s (with-current-buffer buf (buffer-string))) + (j (json-read-from-string s)) + (status (alist-get 'status j))) + (kill-buffer buf) + (if (s-equals? status "success") + (funcall k (cons - (w/bless-parse-stack (alist-get 'stack (alist-get 'data j))) - (w/bless-parse-effects (alist-get 'effects (alist-get 'data j))))) - (w/bless-error (alist-get 'data j)))))))) + (w/bless-parse-stack (alist-get 'stack (alist-get 'data j))) + (w/bless-parse-effects (alist-get 'effects (alist-get 'data j))))) + (w/bless-error (alist-get 'data j)))))))) (defun w/bless (str &optional fuel) "Run the Bless program STR and apply its side effects. Optionally limit evaluation to FUEL steps." (w/bless-eval - str - (lambda (res) - (--each (cdr res) - (w/bless-apply-effect it))) - fuel)) + str + (lambda (res) + (--each (cdr res) + (w/bless-apply-effect it))) + fuel)) (provide 'wasp-bless) ;;; wasp-bless.el ends here diff --git a/src/gizmo/wasp-chatsummary.el b/src/gizmo/wasp-chatsummary.el index 5a6a27ae..3087c18d 100644 --- a/src/gizmo/wasp-chatsummary.el +++ b/src/gizmo/wasp-chatsummary.el @@ -26,16 +26,16 @@ (defun w/update-chatsummary () "Update the chat summary." (w/ai - (w/friend-journalism-input) - (lambda (d) - (when-let* ((d) - (resp (s-trim d))) - (with-current-buffer (w/chatsummary-get-buffer) - (let ((inhibit-read-only t)) - (erase-buffer) - (w/write-line "Chat summary" 'bold) - (w/write-line resp))))) - "Given a list of recent YouTube chatter activity, produce a summary of the topics discussed. The summary should be very short, maximum two sentences total. Do not introduce yourself. Simply provide a short summary of the chat. Do not mention specific names of chatters. Keep it succinct. Do not mention that you are summarizing YouTube activity. Be laconic.")) + (w/friend-journalism-input) + (lambda (d) + (when-let* ((d) + (resp (s-trim d))) + (with-current-buffer (w/chatsummary-get-buffer) + (let ((inhibit-read-only t)) + (erase-buffer) + (w/write-line "Chat summary" 'bold) + (w/write-line resp))))) + "Given a list of recent YouTube chatter activity, produce a summary of the topics discussed. The summary should be very short, maximum two sentences total. Do not introduce yourself. Simply provide a short summary of the chat. Do not mention specific names of chatters. Keep it succinct. Do not mention that you are summarizing YouTube activity. Be laconic.")) (defvar w/chatsummary-timer nil) (defun w/run-chatsummary-timer () @@ -44,8 +44,8 @@ (cancel-timer w/chatsummary-timer)) (w/update-chatsummary) (setq - w/chatsummary-timer - (run-with-timer 120 nil #'w/run-chatsummary-timer))) + w/chatsummary-timer + (run-with-timer 120 nil #'w/run-chatsummary-timer))) (defun w/start-chatsummary () "Enable fake chatters." diff --git a/src/gizmo/wasp-copfish.el b/src/gizmo/wasp-copfish.el index 024c27dc..7afa3414 100644 --- a/src/gizmo/wasp-copfish.el +++ b/src/gizmo/wasp-copfish.el @@ -28,20 +28,20 @@ :parser #'buffer-string :success (cl-function - (lambda (&key data &allow-other-keys) - (setq w/copfish-last-response data) - (funcall k data)))) + (lambda (&key data &allow-other-keys) + (setq w/copfish-last-response data) + (funcall k data)))) t) (defun w/copfish-get-fish (user k) "Retrieve USER's fish ratio from copfish API. Pass the resulting fraction to K." (w/copfish-get - (s-concat "fishdex/" user) - (lambda (s) - (let ((sp (s-split " " s))) - (when (= (length sp) 2) - (funcall k (cons (string-to-number (car sp)) (string-to-number (cadr sp))))))))) + (s-concat "fishdex/" user) + (lambda (s) + (let ((sp (s-split " " s))) + (when (= (length sp) 2) + (funcall k (cons (string-to-number (car sp)) (string-to-number (cadr sp))))))))) (defvar w/copfish-user-cache nil) (defun w/copfish-update-user (user) @@ -49,12 +49,12 @@ Pass the resulting fraction to K." (unless (-contains? w/copfish-user-cache user) (add-to-list 'w/copfish-user-cache user) (w/copfish-get-fish - user - (lambda (ct) - (w/user-bind - user - (lambda () - (setf (alist-get :copfish-ratio w/user-current) ct))))))) + user + (lambda (ct) + (w/user-bind + user + (lambda () + (setf (alist-get :copfish-ratio w/user-current) ct))))))) (provide 'wasp-copfish) ;;; wasp-copfish.el ends here diff --git a/src/gizmo/wasp-curse.el b/src/gizmo/wasp-curse.el index 95149fef..2b31214f 100644 --- a/src/gizmo/wasp-curse.el +++ b/src/gizmo/wasp-curse.el @@ -20,148 +20,148 @@ (defconst w/binary-ops '((or . "||") - (and . "&&") - (> . ">") - (>= . ">=") - (< . "<") - (<= . "<=") - (= . "===") - (% . "%") - (/ . "/") - (bit-or . "|") - (bit-and . "&") - (bit-xor . "^"))) + (and . "&&") + (> . ">") + (>= . ">=") + (< . "<") + (<= . "<=") + (= . "===") + (% . "%") + (/ . "/") + (bit-or . "|") + (bit-and . "&") + (bit-xor . "^"))) (defun w/curse-expr (expr) "Translate EXPR according to the nature of the curse." (cond - ((null expr) "(null)") - ((listp expr) - (pcase (car expr) - ((or '+ '- '*) - (format - "(%s)" - (s-join (format "%s" (car expr)) (-map #'w/curse-expr (cdr expr))))) - ((pred (lambda (x) (alist-get x w/binary-ops))) - (format - "(%s)" - (s-join (alist-get (car expr) w/binary-ops) (-map #'w/curse-expr (cdr expr))))) - ((or '<< '>>) - (format - "(%s%s%s)" - (w/curse-expr (cadr expr)) - (format "%s" (car expr)) - (w/curse-expr (caddr expr)))) - ('comment "(null)") - ('lambda - (format - "((%s)=>(%s))" - (s-join "," (-map #'w/curse-name (cadr expr))) - (s-join "," (-map #'w/curse-expr (cddr expr))))) - ('async-lambda - (format - "(async(%s)=>(%s))" - (s-join "," (-map #'w/curse-name (cadr expr))) - (s-join "," (-map #'w/curse-expr (cddr expr))))) - ('if - (format - "(%s?%s:%s)" - (w/curse-expr (cadr expr)) - (w/curse-expr (caddr expr)) - (w/curse-expr (cadddr expr)))) - ('define - (format - "(globalThis.%s=%s)" - (w/curse-name (cadr expr)) - (w/curse-expr (caddr expr)))) - ('set - (format - "(%s=%s)" - (w/curse-name (cadr expr)) - (w/curse-expr (caddr expr)))) - ('aset - (format - "(%s[%s]=%s)" - (w/curse-name (cadr expr)) - (w/curse-expr (caddr expr)) - (w/curse-expr (cadddr expr)))) - ('new - (format - "(new %s(%s))" - (w/curse-expr (cadr expr)) - (s-join "," (-map #'w/curse-expr (cddr expr))))) - ('await - (format - "(await %s)" - (w/curse-expr (cadr expr)))) - ('not - (format - "(!%s)" - (w/curse-expr (cadr expr)))) - ('let - (format - "(((%s)=>(%s))(%s))" - (s-join "," (--map (w/curse-name (car it)) (cadr expr))) - (s-join "," (-map #'w/curse-expr (cddr expr))) - (s-join "," (--map (w/curse-expr (cadr it)) (cadr expr))))) - ('async-let - (format - "((async(%s)=>(%s))(%s))" - (s-join "," (--map (w/curse-name (car it)) (cadr expr))) - (s-join "," (-map #'w/curse-expr (cddr expr))) - (s-join "," (--map (w/curse-expr (cadr it)) (cadr expr))))) - ('do - (format - "((()=>(%s))())" - (s-join "," (-map #'w/curse-expr (cdr expr))))) - ('iota - (format - "[...Array(%s).keys()]" - (w/curse-expr (cadr expr)))) - ('array - (format - "[%s]" - (s-join "," (-map #'w/curse-expr (cdr expr))))) - ('object - (format - "{%s}" - (s-join - "," - (--map (format "%s:%s" (w/curse-name (car it)) (w/curse-expr (cadr it))) (cdr expr))))) - ('@ - (format - "((%s)[%s])" - (w/curse-expr (cadr expr)) - (w/curse-expr (caddr expr)))) - (_ - (format - "((%s)(%s))" - (w/curse-expr (car expr)) - (s-join "," (-map #'w/curse-expr (cdr expr))))) - )) - ((symbolp expr) (w/curse-name expr)) - ((numberp expr) (format "%s" expr)) - ((stringp expr) (format "\"%s\"" expr)) - (t "(null)"))) + ((null expr) "(null)") + ((listp expr) + (pcase (car expr) + ((or '+ '- '*) + (format + "(%s)" + (s-join (format "%s" (car expr)) (-map #'w/curse-expr (cdr expr))))) + ((pred (lambda (x) (alist-get x w/binary-ops))) + (format + "(%s)" + (s-join (alist-get (car expr) w/binary-ops) (-map #'w/curse-expr (cdr expr))))) + ((or '<< '>>) + (format + "(%s%s%s)" + (w/curse-expr (cadr expr)) + (format "%s" (car expr)) + (w/curse-expr (caddr expr)))) + ('comment "(null)") + ('lambda + (format + "((%s)=>(%s))" + (s-join "," (-map #'w/curse-name (cadr expr))) + (s-join "," (-map #'w/curse-expr (cddr expr))))) + ('async-lambda + (format + "(async(%s)=>(%s))" + (s-join "," (-map #'w/curse-name (cadr expr))) + (s-join "," (-map #'w/curse-expr (cddr expr))))) + ('if + (format + "(%s?%s:%s)" + (w/curse-expr (cadr expr)) + (w/curse-expr (caddr expr)) + (w/curse-expr (cadddr expr)))) + ('define + (format + "(globalThis.%s=%s)" + (w/curse-name (cadr expr)) + (w/curse-expr (caddr expr)))) + ('set + (format + "(%s=%s)" + (w/curse-name (cadr expr)) + (w/curse-expr (caddr expr)))) + ('aset + (format + "(%s[%s]=%s)" + (w/curse-name (cadr expr)) + (w/curse-expr (caddr expr)) + (w/curse-expr (cadddr expr)))) + ('new + (format + "(new %s(%s))" + (w/curse-expr (cadr expr)) + (s-join "," (-map #'w/curse-expr (cddr expr))))) + ('await + (format + "(await %s)" + (w/curse-expr (cadr expr)))) + ('not + (format + "(!%s)" + (w/curse-expr (cadr expr)))) + ('let + (format + "(((%s)=>(%s))(%s))" + (s-join "," (--map (w/curse-name (car it)) (cadr expr))) + (s-join "," (-map #'w/curse-expr (cddr expr))) + (s-join "," (--map (w/curse-expr (cadr it)) (cadr expr))))) + ('async-let + (format + "((async(%s)=>(%s))(%s))" + (s-join "," (--map (w/curse-name (car it)) (cadr expr))) + (s-join "," (-map #'w/curse-expr (cddr expr))) + (s-join "," (--map (w/curse-expr (cadr it)) (cadr expr))))) + ('do + (format + "((()=>(%s))())" + (s-join "," (-map #'w/curse-expr (cdr expr))))) + ('iota + (format + "[...Array(%s).keys()]" + (w/curse-expr (cadr expr)))) + ('array + (format + "[%s]" + (s-join "," (-map #'w/curse-expr (cdr expr))))) + ('object + (format + "{%s}" + (s-join + "," + (--map (format "%s:%s" (w/curse-name (car it)) (w/curse-expr (cadr it))) (cdr expr))))) + ('@ + (format + "((%s)[%s])" + (w/curse-expr (cadr expr)) + (w/curse-expr (caddr expr)))) + (_ + (format + "((%s)(%s))" + (w/curse-expr (car expr)) + (s-join "," (-map #'w/curse-expr (cdr expr))))) + )) + ((symbolp expr) (w/curse-name expr)) + ((numberp expr) (format "%s" expr)) + ((stringp expr) (format "\"%s\"" expr)) + (t "(null)"))) (defun w/curse-current-buffer () "Transmute the current buffer according to the curse." (interactive) (let* ((srcfile (buffer-file-name)) - (jspath (s-concat (f-base srcfile) ".js")) - (src (buffer-string))) + (jspath (s-concat (f-base srcfile) ".js")) + (src (buffer-string))) (with-temp-buffer (insert src) (goto-char (point-min)) (let ((acc "") - (line (read (current-buffer)))) + (line (read (current-buffer)))) (while (and line (not (eobp))) (setf acc (s-concat acc (w/curse-expr line) ";")) (setf - line - (condition-case nil - (read (current-buffer)) - (error nil)))) + line + (condition-case nil + (read (current-buffer)) + (error nil)))) (write-region acc nil jspath))))) (provide 'wasp-curse) diff --git a/src/gizmo/wasp-cyclone.el b/src/gizmo/wasp-cyclone.el index d77061e7..0223e8bc 100644 --- a/src/gizmo/wasp-cyclone.el +++ b/src/gizmo/wasp-cyclone.el @@ -7,6 +7,8 @@ (require 'wasp-heartrate) (require 'wasp-chatsummary) (require 'wasp-alert-message) +(require 'wasp-fakechat) +(require 'wasp-bannerads) (defconst w/gizmo-buffer-names (list @@ -23,7 +25,7 @@ (defun w/gizmo-tag-window () "Tag the current window as containing a gizmo." (interactive) - (when-let ((w (selected-window))) + (when-let* ((w (selected-window))) (add-to-list 'w/gizmo-windows w))) (defun w/gizmo-cycle-window (w) @@ -42,6 +44,11 @@ (--each w/gizmo-windows (w/gizmo-cycle-window it))) +(defun w/gizmo-ensure-shown (buf) + "Ensure that BUF is shown in one of the windows." + (unless (--any (s-equals? (buffer-name (window-buffer it)) (buffer-name (get-buffer buf))) w/gizmo-windows) + (set-window-buffer (car w/gizmo-windows) buf))) + (defvar w/gizmo-cycle-timer nil) (defun w/run-gizmo-cycle-timer () "Run the gizmo cycle timer." @@ -49,9 +56,32 @@ (cancel-timer w/gizmo-cycle-timer)) (w/gizmo-cycle) (setq - w/gizmo-cycle-timer - (run-with-timer 300 nil #'w/run-gizmo-cycle-timer))) + w/gizmo-cycle-timer + (run-with-timer 300 nil #'w/run-gizmo-cycle-timer))) (w/run-gizmo-cycle-timer) +(require 'htmlize) +(defvar w/gizmo-html-cache (ht-create)) +(defun w/gizmo-render-html (buf) + "Render BUF to HTML with embedded images." + (let* ( (htmlize-output-type 'inline-css) + (htmlize-force-inline-images t) + (buf (htmlize-buffer buf)) + (html (with-current-buffer buf (buffer-string)))) + (kill-buffer buf) + html)) +(defun w/gizmo-upload (buf) + "Upload the HTML contents of BUF to the database." + (let* ( (b (get-buffer buf)) + (nm (buffer-name b)) + (render (w/gizmo-render-html b)) + (cached (ht-get w/gizmo-html-cache nm))) + (unless (and cached (s-equals? cached render)) + (ht-set w/gizmo-html-cache nm render) + (w/db-hset-then "gizmos" nm + render + (lambda (_) + (w/pub '(gizmo buffer update) (list nm))))))) + (provide 'wasp-cyclone) ;;; wasp-cyclone.el ends here diff --git a/src/gizmo/wasp-fakechat.el b/src/gizmo/wasp-fakechat.el index 27b6962b..ffdd750a 100644 --- a/src/gizmo/wasp-fakechat.el +++ b/src/gizmo/wasp-fakechat.el @@ -137,12 +137,12 @@ (diff (if last (time-subtract cur last) 99999999)) (d (time-convert diff 'integer))) (+ - (if (> d 300) 0.01 0.1) + (if (> d 300) 0.01 0.05) (if (--any? (s-contains? (w/fake-chatter-profile-username (w/fake-chatter-profile st)) (cdr it)) (-take 20 w/twitch-chat-history)) - 0.8 + 0.1 0.0)))) (defun w/fake-chatter-elevated-likeliness (st) diff --git a/src/gizmo/wasp-flycheck.el b/src/gizmo/wasp-flycheck.el index 27a857b4..505ad8a3 100644 --- a/src/gizmo/wasp-flycheck.el +++ b/src/gizmo/wasp-flycheck.el @@ -2,16 +2,16 @@ ;;; Commentary: ;;; Code: -(require 'flycheck) - -(flycheck-define-generic-checker 'wasp-twitch - "Checker to display errors from Twitch redeems." - :start - (lambda (c x) - (print c) - (print x)) - :modes '(fundamental-mode) - ) +;; (require 'flycheck) +;; +;; (flycheck-define-generic-checker 'wasp-twitch +;; "Checker to display errors from Twitch redeems." +;; :start +;; (lambda (c x) +;; (print c) +;; (print x)) +;; :modes '(fundamental-mode) +;; ) (provide 'wasp-flycheck) ;;; wasp-flycheck.el ends here diff --git a/src/gizmo/wasp-friend-callout.el b/src/gizmo/wasp-friend-callout.el new file mode 100644 index 00000000..510c279c --- /dev/null +++ b/src/gizmo/wasp-friend-callout.el @@ -0,0 +1,106 @@ +;;; wasp-friend-callout --- "friend" talks about things -*- lexical-binding: t; -*- +;;; Commentary: +;;; Code: + +(require 'dash) +(require 's) +(require 'wasp-friend) +(require 'wasp-twitch) +(require 'wasp-gcp) +(require 'wasp-aoc) +(require 'wasp-uwoomfie) + +(defun w/friend-callout-holiday () + "Call to respond to the current holiday." + (w/friend-respond "We're restoring a crumbling mansion to it's former glory. Say something about that please!")) + +(defun w/friend-callout-hexamedia () + "Call to respond to a random recent chatter's Hexamedia card collection." + (let* ((users (-filter #'cdr (--map (cons (car it) (alist-get :hexamedia-cards (w/user-cache-get (car it)))) (-take 10 w/twitch-chat-history)))) + (user (and users (nth (random (length users)) users))) + (cards (cdr user)) + (coll (and cards (nth (random (length cards)) cards)))) + (when coll + (w/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 w/friend-callout-copfish () + "Call to respond to a random recent chatter's Copfish ratio." + (let* ((users (-filter #'cdr (--map (cons (car it) (alist-get :copfish-ratio (w/user-cache-get (car it)))) (-take 10 w/twitch-chat-history)))) + (user (and users (nth (random (length users)) users)))) + (when user + (w/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 w/friend-callout-uwoomfie () + "Call to respond to a random recent chatter's Uwoomfie status." + (let* ((users + (-filter + #'cdr + (--map + (cons (car it) (w/uwoomfie-get-status (car it))) + (-take 10 w/twitch-chat-history)))) + (user (and users (nth (random (length users)) users)))) + (cl-case (cdr user) + (cool (w/friend-respond (format "According to UWOSLAB, %s is a very cool person. Make sure to mention their username." (car user)))) + (honored (w/friend-respond (format "According to UWOSLAB, %s is an honorary viewer. Make sure to mention their username." (car user)))) + (t nil)))) + +(defun w/friend-callout-shindaggers () + "Call to respond to a random recent chatter's Shindaggers knife collection." + (let* ((users (-filter #'cdr (--map (cons (car it) (alist-get :shindaggers-knives (w/user-cache-get (car it)))) (-take 10 w/twitch-chat-history)))) + (user (and users (nth (random (length users)) users))) + (knives (cdr user)) + (knife (and knives (nth (random (length knives)) knives)))) + (when knife + (w/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 w/friend-callout-aoc () + "Call to respond to a random recent chatter's Advent of Code completion." + (let* ((users (-filter #'cdr (--map (cons (car it) (w/aoc-lookup-stars (car it))) (-take 10 w/twitch-chat-history)))) + (user (and users (nth (random (length users)) users)))) + (w/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) + (w/aoc-max-stars))))) + +(defun w/friend-callout-gcp () + "Call to respond to the current GCP dot." + (w/gcp-dot + (lambda (d) + (w/friend-respond + (format + "The Global Consciousness Project indicator is currently as follows: %s" + (w/gcp-describe d)))))) + +(defun w/friend-callout-resolution () + "Call to respond to a random recent chatter's resolve." + (when-let* + ((users (-filter #'cdr (--map (cons (car it) (alist-get :resolution2025 (w/user-cache-get (car it)))) (-take 10 w/twitch-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)) + (w/friend-respond + (format + "%s snarkily said that their New Year's resolution was a screen resolution. What do you think about this?" (car user))) + (w/friend-respond + (format + "%s made a New Year's resolution to %s. Ask them how it's going!" + (car user) + (cdr user)))))) + +(provide 'wasp-friend-callout) +;;; wasp-friend-callout.el ends here diff --git a/src/gizmo/wasp-friend-eating.el b/src/gizmo/wasp-friend-eating.el new file mode 100644 index 00000000..4bd92b8c --- /dev/null +++ b/src/gizmo/wasp-friend-eating.el @@ -0,0 +1,18 @@ +;;; wasp-friend-eating --- "friend" can eat -*- lexical-binding: t; -*- +;;; Commentary: +;;; Code: +(require 'wasp-friend) + +(defvar w/friend-tastes " You love eating cranberries and lemons.") + +(defun w/friend-feed (user food) + "Call when USER fed FOOD to \"friend\"." + (w/friend-personality + (format "%s fed you %s" user food) + (lambda (msg) + (w/friend-say msg) + (w/friend-set-state 'eating 6)) + w/friend-tastes)) + +(provide 'wasp-friend-eating) +;;; wasp-friend-eating.el ends here diff --git a/src/gizmo/wasp-friend-journalism.el b/src/gizmo/wasp-friend-journalism.el new file mode 100644 index 00000000..25d18bdb --- /dev/null +++ b/src/gizmo/wasp-friend-journalism.el @@ -0,0 +1,45 @@ +;;; wasp-friend-journalism --- "friend" writes the newspaper -*- lexical-binding: t; -*- +;;; Commentary: +;;; Code: + +(require 'dash) +(require 's) +(require 'wasp-friend) +(require 'wasp-newspaper) + +(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 20 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/friend-personality + (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)) + (funcall + (if (= (random 5) 0) #'w/newspaper-screenshot (lambda (k) (funcall k nil))) + (lambda (img) + (when img + (w/write-chat-event "...and the article included some photojournalism")) + (push + (w/make-newspaper-article + :headline headline + :author (format "\"friend\" and %s" author) + :content (s-trim resp) + :image img) + w/newspaper-todays-articles))))) + "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.")) + +(provide 'wasp-friend-journalism) +;;; wasp-friend-journalism.el ends here diff --git a/src/gizmo/wasp-friend-music.el b/src/gizmo/wasp-friend-music.el new file mode 100644 index 00000000..76e2c606 --- /dev/null +++ b/src/gizmo/wasp-friend-music.el @@ -0,0 +1,31 @@ +;;; wasp-friend-music --- "friend" can play music -*- lexical-binding: t; -*- +;;; Commentary: +;;; Code: +(require 'wasp-friend) + +(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)) + (w/add-song (s-concat "friend's " name) song) + (w/audio-muzak-enqueue "\"friend\"" 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))) + +(provide 'wasp-friend-music) +;;; wasp-friend-music.el ends here diff --git a/src/gizmo/wasp-friend-reading.el b/src/gizmo/wasp-friend-reading.el new file mode 100644 index 00000000..7859b2e8 --- /dev/null +++ b/src/gizmo/wasp-friend-reading.el @@ -0,0 +1,15 @@ +;;; wasp-friend-reading --- "friend" can read pages -*- lexical-binding: t; -*- +;;; Commentary: +;;; Code: +(require 'wasp-friend) +(require 'wasp-wikipedia) + +(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))))) + +(provide 'wasp-friend-reading) +;;; wasp-friend-reading.el ends here diff --git a/src/gizmo/wasp-friend-voice.el b/src/gizmo/wasp-friend-voice.el new file mode 100644 index 00000000..71519e09 --- /dev/null +++ b/src/gizmo/wasp-friend-voice.el @@ -0,0 +1,70 @@ +;;; wasp-friend-voice --- "friend" talks -*- lexical-binding: t; -*- +;;; Commentary: +;;; Code: + +(require 'dash) +(require 's) +(require 'wasp-friend) + +(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))) + +(provide 'wasp-friend-voice) +;;; wasp-friend-voice.el ends here diff --git a/src/gizmo/wasp-friend.el b/src/gizmo/wasp-friend.el index 0432040d..28403025 100644 --- a/src/gizmo/wasp-friend.el +++ b/src/gizmo/wasp-friend.el @@ -4,20 +4,13 @@ (require 'dash) (require 's) -(require 'flycheck) +(require 'cl-lib) (require 'wasp-utils) -(require 'wasp-audio) -(require 'wasp-ai) (require 'wasp-chat) +(require 'wasp-ai) (require 'wasp-twitch) -(require 'wasp-newspaper) -(require 'wasp-gcp) -(require 'wasp-aoc) -(require 'wasp-uwoomfie) -(require 'wasp-wikipedia) -(require 'muzak) -(require 'muzak-wasp) +;;;; Buffer and mode (defcustom w/friend-buffer "*wasp-friend*" "Name of buffer used to display \"friend\"." :type '(string) @@ -29,219 +22,22 @@ (message "hi i'm \"friend\"") (setq-local cursor-type nil)) -(defun w/get-friend-buffer () +(defun w/friend-get-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 20 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)) - (funcall - (if (= (random 5) 0) #'w/newspaper-screenshot (lambda (k) (funcall k nil))) - (lambda (img) - (when img - (w/write-chat-event "...and the article included some photojournalism")) - (push - (w/make-newspaper-article - :headline headline - :author (format "\"friend\" and %s" author) - :content (s-trim resp) - :image img) - 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 cranberries and lemons.") -;; (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 +;;;; State (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)) - (w/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) @@ -256,24 +52,40 @@ AUTHOR was a contributing author btw." (defun w/friend-say (msg) "Have \"friend\" say MSG." (w/daily-log (format "[FRIEND]: %s" msg)) + (w/gizmo-ensure-shown (w/friend-get-buffer)) (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))))) - +;;;; Core +(defun w/friend-personality (msg k &optional extra) + "Given MSG, pass a string with more personality to K. +Append EXTRA to the personality." + (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. You never use punctuation. You are foolish. You never use metaphors or similes or idioms. You never describe something by comparing it to another thing. You never use the words \"like\" or \"as\". 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, but you can include an occasional emoji if it is cute only. 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 " " + (or extra "")) + (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))))))) + +;;;; Interface (defun w/friend-respond (ev &optional k) "Call when an event EV happens to \"friend\". If K is specified, call it after the response." @@ -284,307 +96,109 @@ If K is specified, call it after the response." (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/friend-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/friend-callout-holiday () - "Call to respond to the current holiday." - (w/friend-respond "We're restoring a crumbling mansion to it's former glory. Say something about that please!")) - -(defun w/friend-callout-hexamedia () - "Call to respond to a random recent chatter's Hexamedia card collection." - (let* ((users (-filter #'cdr (--map (cons (car it) (alist-get :hexamedia-cards (w/user-cache-get (car it)))) (-take 10 w/twitch-chat-history)))) - (user (and users (nth (random (length users)) users))) - (cards (cdr user)) - (coll (and cards (nth (random (length cards)) cards)))) - (when coll - (w/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 w/friend-callout-copfish () - "Call to respond to a random recent chatter's Copfish ratio." - (let* ((users (-filter #'cdr (--map (cons (car it) (alist-get :copfish-ratio (w/user-cache-get (car it)))) (-take 10 w/twitch-chat-history)))) - (user (and users (nth (random (length users)) users)))) - (when user - (w/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 w/friend-callout-uwoomfie () - "Call to respond to a random recent chatter's Uwoomfie status." - (let* ((users - (-filter - #'cdr - (--map - (cons (car it) (w/uwoomfie-get-status (car it))) - (-take 10 w/twitch-chat-history)))) - (user (and users (nth (random (length users)) users)))) - (cl-case (cdr user) - (cool (w/friend-respond (format "According to UWOSLAB, %s is a very cool person. Make sure to mention their username." (car user)))) - (honored (w/friend-respond (format "According to UWOSLAB, %s is an honorary viewer. Make sure to mention their username." (car user)))) - (t nil)))) - -(defun w/friend-callout-shindaggers () - "Call to respond to a random recent chatter's Shindaggers knife collection." - (let* ((users (-filter #'cdr (--map (cons (car it) (alist-get :shindaggers-knives (w/user-cache-get (car it)))) (-take 10 w/twitch-chat-history)))) - (user (and users (nth (random (length users)) users))) - (knives (cdr user)) - (knife (and knives (nth (random (length knives)) knives)))) - (when knife - (w/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 w/friend-callout-aoc () - "Call to respond to a random recent chatter's Advent of Code completion." - (let* ((users (-filter #'cdr (--map (cons (car it) (w/aoc-lookup-stars (car it))) (-take 10 w/twitch-chat-history)))) - (user (and users (nth (random (length users)) users)))) - (w/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) - (w/aoc-max-stars))))) - -(defun w/friend-callout-gcp () - "Call to respond to the current GCP dot." - (w/gcp-dot - (lambda (d) - (w/friend-respond - (format - "The Global Consciousness Project indicator is currently as follows: %s" - (w/gcp-describe d)))))) +;;;; Updating +(defun w/friend-random-event () + "Activate a random \"friend\" event." + (cl-case (random 10) + (9 (w/friend-set-state 'jumping)))) -(defun w/friend-callout-resolution () - "Call to respond to a random recent chatter's resolve." - (when-let* - ((users (-filter #'cdr (--map (cons (car it) (alist-get :resolution2025 (w/user-cache-get (car it)))) (-take 10 w/twitch-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)) - (w/friend-respond - (format - "%s snarkily said that their New Year's resolution was a screen resolution. What do you think about this?" (car user))) - (w/friend-respond - (format - "%s made a New Year's resolution to %s. Ask them how it's going!" - (car user) - (cdr user)))))) +(defun w/friend-update () + "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/get-friend-offset () +;;;; Rendering +(defun w/friend-get-offset () "Return the number of newlines to print before \"friend\"." (if (-contains? '(jumping) w/friend-state) - w/friend-animation + w/friend-animation 1)) -(defun w/get-friend-face () +(defun w/friend-get-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 () +(defun w/friend-get-bubble () "Return the text bubble for \"friend\"." (if (> w/friend-speech-timer 0) - w/friend-speech + w/friend-speech nil)) -(defun w/friend-random-event () - "Activate a random \"friend\" event." - (cl-case (random 10) - (0 (w/friend-callout-flycheck-error)) - (1 (w/friend-callout-gcp)) - (2 (w/friend-callout-hexamedia)) - (3 (w/friend-callout-uwoomfie)) - (4 (w/friend-callout-shindaggers)) - (5 (w/friend-callout-copfish)) - (6 (w/friend-callout-resolution)) - (9 (w/friend-callout-holiday)) - (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 () +(defun w/friend-render () "Render the \"friend\" buffer." (save-excursion - (with-current-buffer (w/get-friend-buffer) + (with-current-buffer (w/friend-get-buffer) (setq-local cursor-type nil) (let* - ((inhibit-read-only t) - (face (w/get-friend-face)) - (bubble (w/get-friend-bubble))) + ((inhibit-read-only t) + (face (w/friend-get-face)) + (bubble (w/friend-get-bubble))) (erase-buffer) (w/write - (format-spec - "%a\ + (format-spec + "%a\ /----\\ / %l %r \\ \\ %m / +----+\ " -;; "%a\ -;; ---- -;; / \\ -;; ---------- -;; / %l %r \\ -;; \\ %m / -;; +----+\ -;; " -;; "%a\ -;; oooooo -;; oooooooo -;; oo/----\\oo -;; o/ %l %r \\o -;; \\ %m / -;; +----+\ -;; " -;; "%a\ -;; /\\ -;; /\\/\\ -;; / :3 \\ -;; /santa!\\ -;; ~~~~~~~~~~ -;; ~~~~~~~~~~ -;; / %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))))) + `((?a . ,(s-repeat (w/friend-get-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 "/" "")) - )))) + ))) + (w/gizmo-upload (w/friend-get-buffer))) (defvar w/friend-timer nil) -(defun w/run-friend-timer () +(defun w/friend-run-timer () "Run the \"friend\" timer." (when w/friend-timer (cancel-timer w/friend-timer)) (condition-case e - (progn - (w/update-friend) - (w/render-friend)) + (progn + (w/friend-update) + (w/friend-render)) ((debug error) - (message "friend error: %s" e) - (cancel-timer w/friend-timer) - (setq w/friend-timer nil))) + (message "friend error: %s" e) + (cancel-timer w/friend-timer) + (setq w/friend-timer nil))) (setq - w/friend-timer - (run-with-timer 1 nil #'w/run-friend-timer))) + w/friend-timer + (run-with-timer 1 nil #'w/friend-run-timer))) -(defun w/start-friend () +(defun w/friend-start () "Launch \"friend\"." (interactive) - (w/run-friend-timer)) + (w/friend-run-timer)) -(defun w/stop-friend () +(defun w/friend-stop () "Stop \"friend\"." (interactive) (cancel-timer w/friend-timer) diff --git a/src/gizmo/wasp-hex.el b/src/gizmo/wasp-hex.el index 81aa4f12..1417f0c9 100644 --- a/src/gizmo/wasp-hex.el +++ b/src/gizmo/wasp-hex.el @@ -10,34 +10,37 @@ (require 'ht) (require 's) (require 'rx) +(require 'ttf) (defconst w/hex-types - '(("DIGITAL" . hexadigital) - ("ESREVER" . reverse) - ("VANYAR" . quenya) - ("LEONDIS" . emoji) - ("KOBY" . clone) - ("BIGFOOT" . hair) - ("ALTMAN" . unbiblical) - ("DECIBEL" . allcaps) - ("PIQUANT" . mild) - ("PORCINE" . piglatin) - ("PYTHON" . oldeenglishe) - ("MANIAC" . pokemon) - ("ELBERETH" . counterspell) - ("ESUNA" . decurse) - )) + '( ("DIGITAL" . hexadigital) + ("ESREVER" . reverse) + ("VANYAR" . quenya) + ("LEONDIS" . emoji) + ("KOBY" . clone) + ("BIGFOOT" . hair) + ("ALTMAN" . unbiblical) + ("DECIBEL" . allcaps) + ("PIQUANT" . mild) + ("PORCINE" . piglatin) + ("PYTHON" . oldeenglishe) + ("MANIAC" . pokemon) + ("ELBERETH" . counterspell) + ("ESUNA" . decurse) + ("DECIMAL" . decimal) + ("DROPBEAR" . upsidedown) + )) (defconst w/hex-users (ht-create 'equal)) (defconst w/hex-pokemon (w/read-sexp (w/slurp (w/asset "palcries/pokemon.eld")))) (w/defstruct - w/hex - type - caster - (timer 0) - data) + w/hex + type + caster + (timer 0) + data) (defun w/hex-get (user) "Return the active hexes for USER." @@ -46,15 +49,15 @@ (defun w/hex-add (user hex) "Add HEX to the active hexes for USER." (let* ((key (s-downcase user)) - (cur (ht-get w/hex-users key))) + (cur (ht-get w/hex-users key))) (unless (> (length cur) 10) (cl-case (w/hex-type hex) (decurse - (ht-set! w/hex-users key nil)) + (ht-set! w/hex-users key nil)) (otherwise - (if-let ((defender (--find (eq 'counterspell (w/hex-type it)) cur))) - (w/write-chat-event (format "%s counterspelled %s's hex on %s!" (w/hex-caster defender) (w/hex-caster hex) user)) - (ht-set! w/hex-users key (cons hex cur)))))))) + (if-let* ((defender (--find (eq 'counterspell (w/hex-type it)) cur))) + (w/write-chat-event (format "%s counterspelled %s's hex on %s!" (w/hex-caster defender) (w/hex-caster hex) user)) + (ht-set! w/hex-users key (cons hex cur)))))))) (defun w/hex-clear (user) "Decurse USER." @@ -63,182 +66,192 @@ (defun w/hex (user caster type) "Record that CASTER cast a hex of TYPE on USER." (w/hex-add - user - (w/make-hex - :type type - :caster caster - :timer 10 - :data - (cl-case type - (pokemon (random (length w/hex-pokemon))) - (t nil))))) + user + (w/make-hex + :type type + :caster caster + :timer 10 + :data + (cl-case type + (pokemon (random (length w/hex-pokemon))) + (t nil))))) (defun w/hex-pokemon-syllable (pkmn) "Extract a syllable from PKMN." (if (= (random 4) 0) - pkmn + pkmn (let ((vowels '("a" "e" "i" "o" "u" "y"))) (or - (->> - (-mapcat - (lambda (idx) - (--map - (substring pkmn idx (+ idx it)) - (-iota (- (length pkmn) idx)))) - (-iota (length pkmn))) - (--filter - (and - (s-present? it) - (>= (length it) 2) - (not (-contains? vowels (substring it 0 1))) - (-contains? vowels (substring it 1 2)) - (-any (lambda (v) (s-contains? v it)) vowels))) - (w/pick-random)) - pkmn)))) + (->> + (-mapcat + (lambda (idx) + (--map + (substring pkmn idx (+ idx it)) + (-iota (- (length pkmn) idx)))) + (-iota (length pkmn))) + (--filter + (and + (s-present? it) + (>= (length it) 2) + (not (-contains? vowels (substring it 0 1))) + (-contains? vowels (substring it 1 2)) + (-any (lambda (v) (s-contains? v it)) vowels))) + (w/pick-random)) + pkmn)))) (defun w/hex-transform-pokemon (msg idx) "Transform MSG as if it was spoken by Pokemon IDX." (let* ((pkmn (nth (- idx 1) w/hex-pokemon))) (s-capitalize - (s-replace-regexp - (rx (one-or-more alpha)) - (lambda (_) (w/hex-pokemon-syllable pkmn)) - msg)))) + (s-replace-regexp + (rx (one-or-more alpha)) + (lambda (_) (w/hex-pokemon-syllable pkmn)) + msg)))) (defun w/hex-transform-helper (msg hexes k) "Transform MSG according to HEXES and pass the result to K." (cond - ((car hexes) - (cl-case (w/hex-type (car hexes)) - (hexadigital - (setf (w/chat-message-user msg) "Hexadigital") - (setf (w/chat-message-user-color msg) "#AED673") - (setf - (w/chat-message-text msg) - (w/twitch-replace-emotes-randomly - (w/chat-message-text msg) - (-map - #'w/twitch-emote-path - '("emotesv2_abbaa8ac25c14148ad8c1ef8046a3659" - "emotesv2_20b76cf83c5b431085c0f8361e3dbc92" - "emotesv2_3cf549deb99e4d34846c0cae6648657b" - "emotesv2_1e2390f5092f453184f8615fb899c4b5" - "emotesv2_c088d4ad26804a51a44170b711fec283" - "emotesv2_d9130333dfaf46a0a581bc1c814a1ce5" - "emotesv2_bcfda5ce372f453e98cb6aa42b7d7cc3" - "emotesv2_c333ce14069e4120a5857e121aeea046" - "emotesv2_4e960082535a48188e139b65393aa143" - "emotesv2_079d9054ba4f4e9881fd38a2a7e7d423" - "emotesv2_f1e892a1d0b145f98964cfc7f84c6377" - "emotesv2_65efa7f9a7d246c29a618bc3447b703b" - "emotesv2_107c23f9db49457184c0b8ebebb58113" - "emotesv2_3b74375a1ecf41b18bf04dcc6f133eb6" - "emotesv2_38a6711524a245a3976732d08f2ca1d9" - "emotesv2_84de70e8bc614c88a53711978c0fc64d" - "emotesv2_18c29a371f2b4d23bcd77bba6f1d8ab3" - "emotesv2_9d1b0530ad20434888b2e380cc7acb69" - "emotesv2_f1dbb27287a04c5ab815e2fc703be6e4" - "emotesv2_7e15943fdefe4a4c8d0da79202d739aa" - "emotesv2_27453bd537c4478488abf4e0c05b3bd0" - "emotesv2_8d844e7e064a41ed999a598a4aafadfd" - "emotesv2_1c0fb90252b243a0a359c80c58b4cff4")))) - (w/hex-transform-helper msg (cdr hexes) k)) - (reverse - (setf (w/chat-message-text msg) (s-reverse (w/chat-message-text msg))) - (w/hex-transform-helper msg (cdr hexes) k)) - (oldeenglishe - (w/ai - (w/chat-message-text msg) - (lambda (new) - (setf (w/chat-message-text msg) new) + ((car hexes) + (cl-case (w/hex-type (car hexes)) + (hexadigital + (setf (w/chat-message-user msg) "Hexadigital") + (setf (w/chat-message-user-color msg) "#AED673") + (setf + (w/chat-message-text msg) + (w/twitch-replace-emotes-randomly + (w/chat-message-text msg) + (-map + #'w/twitch-emote-path + '("emotesv2_abbaa8ac25c14148ad8c1ef8046a3659" + "emotesv2_20b76cf83c5b431085c0f8361e3dbc92" + "emotesv2_3cf549deb99e4d34846c0cae6648657b" + "emotesv2_1e2390f5092f453184f8615fb899c4b5" + "emotesv2_c088d4ad26804a51a44170b711fec283" + "emotesv2_d9130333dfaf46a0a581bc1c814a1ce5" + "emotesv2_bcfda5ce372f453e98cb6aa42b7d7cc3" + "emotesv2_c333ce14069e4120a5857e121aeea046" + "emotesv2_4e960082535a48188e139b65393aa143" + "emotesv2_079d9054ba4f4e9881fd38a2a7e7d423" + "emotesv2_f1e892a1d0b145f98964cfc7f84c6377" + "emotesv2_65efa7f9a7d246c29a618bc3447b703b" + "emotesv2_107c23f9db49457184c0b8ebebb58113" + "emotesv2_3b74375a1ecf41b18bf04dcc6f133eb6" + "emotesv2_38a6711524a245a3976732d08f2ca1d9" + "emotesv2_84de70e8bc614c88a53711978c0fc64d" + "emotesv2_18c29a371f2b4d23bcd77bba6f1d8ab3" + "emotesv2_9d1b0530ad20434888b2e380cc7acb69" + "emotesv2_f1dbb27287a04c5ab815e2fc703be6e4" + "emotesv2_7e15943fdefe4a4c8d0da79202d739aa" + "emotesv2_27453bd537c4478488abf4e0c05b3bd0" + "emotesv2_8d844e7e064a41ed999a598a4aafadfd" + "emotesv2_1c0fb90252b243a0a359c80c58b4cff4")))) (w/hex-transform-helper msg (cdr hexes) k)) - "Please translate the chat message given to ye olde Englishe. Only supply the translation without any additional context, as if it were to be substituted for the original message. Do not complain or give an explanation why you cannot do this, just do your best please.")) - (quenya - (w/ai - (w/chat-message-text msg) - (lambda (new) - (setf (w/chat-message-text msg) new) + (reverse + (setf (w/chat-message-text msg) (s-reverse (w/chat-message-text msg))) (w/hex-transform-helper msg (cdr hexes) k)) - "Please translate the chat message given to Quenya, one of Tolkien's elvish languages. Only supply the translation without any additional context, as if it were to be substituted for the original message. Do not complain or give an explanation why you cannot do this, just do your best please. If you can't do it just make something up as long as it looks like Quenya.")) - (emoji - (w/ai - (w/chat-message-text msg) - (lambda (new) - (setf (w/chat-message-text msg) new) + (oldeenglishe + (w/ai + (w/chat-message-text msg) + (lambda (new) + (setf (w/chat-message-text msg) new) + (w/hex-transform-helper msg (cdr hexes) k)) + "Please translate the chat message given to ye olde Englishe. Only supply the translation without any additional context, as if it were to be substituted for the original message. Do not complain or give an explanation why you cannot do this, just do your best please.")) + (quenya + (w/ai + (w/chat-message-text msg) + (lambda (new) + (setf (w/chat-message-text msg) new) + (w/hex-transform-helper msg (cdr hexes) k)) + "Please translate the chat message given to Quenya, one of Tolkien's elvish languages. Only supply the translation without any additional context, as if it were to be substituted for the original message. Do not complain or give an explanation why you cannot do this, just do your best please. If you can't do it just make something up as long as it looks like Quenya.")) + (emoji + (w/ai + (w/chat-message-text msg) + (lambda (new) + (setf (w/chat-message-text msg) new) + (w/hex-transform-helper msg (cdr hexes) k)) + "Please translate the chat message given to exclusively emoji. Do not provide any other text, only a string of emoji that somehow correspond to the message.")) + (clone + (let* ((caster (w/hex-caster (car hexes))) + (hist (-take 10 (--filter (s-equals? (car it) caster) w/twitch-chat-history)))) + (w/ai + (w/chat-message-text msg) + (lambda (new) + (setf (w/chat-message-text msg) new) + (w/hex-transform-helper msg (cdr hexes) k)) + (format + "Please translate the given chat message from %s as if it were written by the user %s. Do not respond to the message, only create another message with similar meaning in different style. You should try to match the example messages from %s in capitalization, formatting, and tone. %s has sent messages like:\n%s" + (w/chat-message-user msg) + caster + caster + caster + (s-join "\n" (-map #'cdr hist)))))) + (hair + (w/model-region-word "hair" (w/chat-message-text msg))) + (unbiblical + (setf (w/chat-message-biblicality msg) -666) (w/hex-transform-helper msg (cdr hexes) k)) - "Please translate the chat message given to exclusively emoji. Do not provide any other text, only a string of emoji that somehow correspond to the message.")) - (clone - (let* ((caster (w/hex-caster (car hexes))) - (hist (-take 10 (--filter (s-equals? (car it) caster) w/twitch-chat-history)))) - (w/ai - (w/chat-message-text msg) - (lambda (new) - (setf (w/chat-message-text msg) new) - (w/hex-transform-helper msg (cdr hexes) k)) - (format - "Please translate the given chat message from %s as if it were written by the user %s. Do not respond to the message, only create another message with similar meaning in different style. You should try to match the example messages from %s in capitalization, formatting, and tone. %s has sent messages like:\n%s" - (w/chat-message-user msg) - caster - caster - caster - (s-join "\n" (-map #'cdr hist)))))) - (hair - (w/model-region-word "hair" (w/chat-message-text msg))) - (unbiblical - (setf (w/chat-message-biblicality msg) -666) - (w/hex-transform-helper msg (cdr hexes) k)) - (allcaps - (setf (w/chat-message-text msg) (s-upcase (w/chat-message-text msg))) - (w/hex-transform-helper msg (cdr hexes) k)) - (mild - (w/ai - (w/chat-message-text msg) - (lambda (new) - (setf (w/chat-message-text msg) new) + (allcaps + (setf (w/chat-message-text msg) (s-upcase (w/chat-message-text msg))) (w/hex-transform-helper msg (cdr hexes) k)) - "Please censor all profanity in the given message and respond with the censored version. Censor by rewriting in a very polite way like Ned Flanders. Do not provide any other text, only a censored version of the message. If there is no profanity respond with the given message verbatim.")) - (pokemon - (w/audio-play (w/asset (format "palcries/%d.mp3" (w/hex-data (car hexes)))) nil 50) - (setf - (w/chat-message-user msg) - (s-titleize (nth (- (w/hex-data (car hexes)) 1) w/hex-pokemon))) - (setf - (w/chat-message-text msg) - (w/hex-transform-pokemon (w/chat-message-text msg) (w/hex-data (car hexes)))) - (w/hex-transform-helper msg (cdr hexes) k)) - (piglatin - (setf - (w/chat-message-text msg) - (s-join - " " - (--map - (let* ((slice (s-slice-at (rx (any "a" "e" "i" "o" "u")) it)) - (consonant (car slice)) - (rest (s-join "" (cdr slice)))) - (s-concat rest consonant "ay")) - (s-split-words (w/chat-message-text msg))))) - (w/hex-transform-helper msg (cdr hexes) k)) - (t (w/hex-transform-helper msg (cdr hexes) k)))) - (t (funcall k msg)))) + (mild + (w/ai + (w/chat-message-text msg) + (lambda (new) + (setf (w/chat-message-text msg) new) + (w/hex-transform-helper msg (cdr hexes) k)) + "Please censor all profanity in the given message and respond with the censored version. Censor by rewriting in a very polite way like Ned Flanders. Do not provide any other text, only a censored version of the message. If there is no profanity respond with the given message verbatim.")) + (pokemon + (w/audio-play (w/asset (format "palcries/%d.mp3" (w/hex-data (car hexes)))) nil 50) + (setf + (w/chat-message-user msg) + (s-titleize (nth (- (w/hex-data (car hexes)) 1) w/hex-pokemon))) + (setf + (w/chat-message-text msg) + (w/hex-transform-pokemon (w/chat-message-text msg) (w/hex-data (car hexes)))) + (w/hex-transform-helper msg (cdr hexes) k)) + (piglatin + (setf + (w/chat-message-text msg) + (s-join + " " + (--map + (let* ((slice (s-slice-at (rx (any "a" "e" "i" "o" "u")) it)) + (consonant (car slice)) + (rest (s-join "" (cdr slice)))) + (s-concat rest consonant "ay")) + (s-split-words (w/chat-message-text msg))))) + (w/hex-transform-helper msg (cdr hexes) k)) + (decimal + (setf + (w/chat-message-text msg) + (s-join " " (--map (format "%d" it) (w/chat-message-text msg)))) + (w/hex-transform-helper msg (cdr hexes) k)) + (upsidedown + (setf + (w/chat-message-text msg) + (ttf/flip (w/chat-message-text msg))) + (w/hex-transform-helper msg (cdr hexes) k)) + (t (w/hex-transform-helper msg (cdr hexes) k)))) + (t (funcall k msg)))) (defun w/hex-transform (user msg) "Given MSG, write to chat based on USER's hexes." (w/hex-transform-helper - msg (w/hex-get user) - (lambda (msg) - (when msg - (w/write-chat-message msg))))) + msg (w/hex-get user) + (lambda (msg) + (when msg + (w/write-chat-message msg))))) (defun w/hex-tick (user) "Decrement timers for all of USER's hexes." - (when-let ((hexes (w/hex-get user))) + (when-let* ((hexes (w/hex-get user))) (ht-set - w/hex-users - (s-downcase user) - (-non-nil - (--map - (when (> (cl-decf (w/hex-timer it)) 0) - it) - hexes))))) + w/hex-users + (s-downcase user) + (-non-nil + (--map + (when (> (cl-decf (w/hex-timer it)) 0) + it) + hexes))))) (provide 'wasp-hex) ;;; wasp-hex.el ends here diff --git a/src/gizmo/wasp-newspaper.el b/src/gizmo/wasp-newspaper.el index 4bdb9caf..74d2b97c 100644 --- a/src/gizmo/wasp-newspaper.el +++ b/src/gizmo/wasp-newspaper.el @@ -197,8 +197,7 @@ Pass the path of the generated PDF to K." :sentinel (lambda (_ _) (w/db-set "newspaper:edition" (number-to-string (1+ edition))) - (browse-url (format "https://pub.colonq.computer/~llll/news/%03d.pdf" 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-wikipedia.el b/src/gizmo/wasp-wikipedia.el index af69de07..74a6adf0 100644 --- a/src/gizmo/wasp-wikipedia.el +++ b/src/gizmo/wasp-wikipedia.el @@ -29,18 +29,18 @@ Pass the resulting article summary to K." :parser #'json-parse-buffer :success (cl-function - (lambda (&key data &allow-other-keys) + (lambda (&key data &allow-other-keys) - (setq w/wikipedia-last-response data) - (if-let (((ht-p w/wikipedia-last-response)) - (query (ht-get w/wikipedia-last-response "query")) - (prepages (ht-get query "pages")) - (pages (car (ht-values prepages))) - (ext (ht-get pages "extract")) - (dom (with-temp-buffer (insert ext) (libxml-parse-html-region (point-min) (point-max)))) - ) - (funcall k (s-trim (dom-texts dom))) - (w/write-chat-event (format "Could not find Wikipedia page: %s" pagename)))))) + (setq w/wikipedia-last-response data) + (if-let* ( ((ht-p w/wikipedia-last-response)) + (query (ht-get w/wikipedia-last-response "query")) + (prepages (ht-get query "pages")) + (pages (car (ht-values prepages))) + (ext (ht-get pages "extract")) + (dom (with-temp-buffer (insert ext) (libxml-parse-html-region (point-min) (point-max)))) + ) + (funcall k (s-trim (dom-texts dom))) + (w/write-chat-event (format "Could not find Wikipedia page: %s" pagename)))))) nil)) (defcustom w/wiki-buffer "*wasp-wiki*" @@ -62,12 +62,12 @@ Pass the resulting article summary to K." (defun w/wikipedia-summary (page) "Display a summary of PAGE from Wikipedia." (w/fetch-wikipedia - page - (lambda (sum) - (with-current-buffer (w/get-wiki-buffer) - (let ((inhibit-read-only t)) - (erase-buffer) - (w/write-line sum))))) + page + (lambda (sum) + (with-current-buffer (w/get-wiki-buffer) + (let ((inhibit-read-only t)) + (erase-buffer) + (w/write-line sum))))) ) (provide 'wasp-wikipedia) diff --git a/src/wasp-ai.el b/src/wasp-ai.el index 1201ca5b..e279103e 100644 --- a/src/wasp-ai.el +++ b/src/wasp-ai.el @@ -169,16 +169,15 @@ Double-check the output to make sure it sounds normal." (defun w/ai-transcribe (path k) "Transcribe the audio file at PATH and pass the resulting string to K." - ) - ;; (let ((request-curl-options '("-F" "model=whisper-1" "-F" "language=en"))) - ;; (w/ai-openai-post-form - ;; "/v1/audio/transcriptions" - ;; `(("file" . ,(f-canonical path))) - ;; (lambda (res) - ;; (funcall - ;; k - ;; (-some-> res - ;; (ht-get "text"))))))) + (let ((request-curl-options '("-F" "model=whisper-1" "-F" "language=en"))) + (w/ai-openai-post-form + "/v1/audio/transcriptions" + `(("file" . ,(f-canonical path))) + (lambda (res) + (funcall + k + (-some-> res + (ht-get "text"))))))) (provide 'wasp-ai) ;;; wasp-ai.el ends here diff --git a/src/wasp-audio.el b/src/wasp-audio.el index 30e2bdfe..0d509f9b 100644 --- a/src/wasp-audio.el +++ b/src/wasp-audio.el @@ -4,6 +4,8 @@ (require 'wasp-utils) (require 'wasp-ai) +(require 'wasp-db) +(require 'wasp-overlay) (defcustom w/audio-play-process "wasp-audio-play" "Name of process for playing audio with mpv." @@ -157,16 +159,16 @@ USER it's your birthday today." (defun w/audio-muzak (user song) "Play SONG by USER using muzak-rs courtesy The0x539." (setq w/audio-muzak-now-playing (cons user song)) - (w/pub '(avatar overlay muzak) (list (w/encode-string user))) + (w/overlay-muzak user song) (let ((proc (make-process :name "wasp-muzak" :connection-type '(pipe . pty) :buffer " *wasp-muzak-log*" :command (list w/audio-muzak-path "play") - :sentinel + :sentinel (lambda (_ _) - (w/pub '(avatar overlay muzak clear) (list)) + (w/overlay-muzak-clear) (setq w/audio-muzak-now-playing nil))))) (process-send-string proc song) (process-send-eof proc))) @@ -191,5 +193,24 @@ USER it's your birthday today." (run-with-timer 1 nil #'w/run-audio-muzak-timer))) (w/run-audio-muzak-timer) +(defun w/add-song (title notes-string) + "Add a song to wasp db. +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 w/get-song (song-name k) + "Look up notes of SONG-NAME from the database. +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)))))) + (provide 'wasp-audio) ;;; wasp-audio.el ends here diff --git a/src/wasp-chat.el b/src/wasp-chat.el index 10931b8d..e8feed89 100644 --- a/src/wasp-chat.el +++ b/src/wasp-chat.el @@ -7,6 +7,7 @@ (require 'evil) (require 'wasp-utils) (require 'wasp-user) +(require 'wasp-overlay) (defcustom w/chat-buffer "*wasp-chat*" "Name of buffer used to store the chat log." @@ -288,16 +289,13 @@ Optionally, return the buffer NM in chat mode." (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))) + ;; (bible-button-text (format "[biblicality %.2f]" (w/. biblicality msg))) + (bible-button-text (format "[medicality %.2f]" (w/. biblicality msg))) ;; (bible-button-text (format "[pollicality %.2f]" (w/. biblicality msg))) (msgwidth (line-beginning-position)) (lines (+ 1 (/ msgwidth wwidth)))) - (w/pub '(avatar overlay chat) - (list - (w/encode-string (w/. text msg)) - (format "%s" (w/unix-time)) - (format "%s" (or (w/. biblicality msg) 0.0)))) + (w/overlay-chat msg) (insert (propertize diff --git a/src/wasp-db.el b/src/wasp-db.el index 506002a1..8900cdc1 100644 --- a/src/wasp-db.el +++ b/src/wasp-db.el @@ -40,7 +40,7 @@ (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))) + (when-let* ((c (char-after))) (delete-char 1) (cl-case c (?+ (w/db-parse-rest)) @@ -56,7 +56,7 @@ (?* (let ((len (string-to-number (w/db-parse-rest)))) (--map (w/db-parse-value) (-iota len)))) - (otherwise (error (format "Unknown Redis sigil: %s" c)))))) + (otherwise (error (format "Unknown Redis sigil: %s (contents: %S)" c (buffer-string))))))) (defun w/db-parse-response () "Try to parse a single RESP value from the current process buffer. @@ -144,9 +144,15 @@ If not, return nil." "Get KEYS from Redis and pass the corresponding values to K." (w/db-cmd `("MGET" ,@keys) k)) +(defun w/db-hset-then (key hkey val k &rest vals) + "Set HKEY in hash KEY to VAL in Redis. +Afterward call K." + (w/db-cmd `("HSET" ,key ,hkey ,val ,@vals) k)) + (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))) + ;; (w/db-hset-then key hkey val (lambda (_) nil) vals)) (defun w/db-hget (key hkey k) "Get HKEY in hash KEY from Redis and pass the corresponding value to K." diff --git a/src/wasp-event-handlers.el b/src/wasp-event-handlers.el index ad8c8299..0e5b8d46 100644 --- a/src/wasp-event-handlers.el +++ b/src/wasp-event-handlers.el @@ -10,113 +10,117 @@ (require 'wasp-overlay) (setf - w/bus-event-handlers - (list - (cons - '(monitor nethack test) - (lambda (data) - (w/write-chat-event (format "Nethack says hi: %s" data)))) - (cons - '(monitor nethack monster) - (lambda (data) - (when-let ((sp (s-split " " (car data)))) - (setf planet/last-monster (cons (s-join " " (cdr sp)) (string-to-number (car sp)))) - (planet/render-monster-summary)))) - (cons - '(overlay barrage started) - (lambda (_) - (w/write-chat-event "It begins...") - (setf w/overlay-barrage-active t) - (w/overlay-update-cursor))) - (cons - '(overlay barrage ended) - (lambda (msg) - (cond - ((s-equals? (car msg) "won") (w/write-chat-event "Fufufu... I win...")) - (t (w/write-chat-event "that it's over"))) - (setf w/overlay-barrage-active nil))) - (cons '(monitor twitch chat incoming) #'w/twitch-handle-incoming-chat) - (cons '(monitor twitch redeem incoming) #'w/twitch-handle-redeem) - (cons - '(frontend redeem incoming) - (lambda (msg) - (w/twitch-handle-redeem-api msg) - )) - (cons - '(monitor twitch raid) - (lambda (msg) - (let ((user (car msg))) - (soundboard//play-clip "rampage.mp3") - (w/write-chat-event (format "%s just raided!" user)) - (w/friend-respond (format "%s just came to visit" user)) - (run-with-timer - 15 nil - (lambda () - (w/twitch-get-user-recent-clips - user - (lambda (clips) - (w/model-region-word "hair" (s-concat user "_")) - (w/model-region-word "eyes" "WELCOME") - (if clips - (w/model-region-video "hair" (car clips)) - (w/model-region-user-avatar "hair" user))))))))) - (cons - '(monitor twitch follow) - (lambda (msg) - (let ((user (car msg))) - (soundboard//play-clip "firstblood.mp3") - (w/model-region-word "skin" (format "welcome_%s_" user)) - (w/friend-respond (format "%s just followed the stream" user)) - (w/write-chat-event (format "New follower: %s" user))))) - (cons - '(monitor twitch subscribe) - (lambda (msg) - (let ((user (car msg))) - (w/thank-sub user) - (w/model-region-word "skin" (format "thanks_%s_" user)) - (w/friend-respond (format "%s just subscribed to the stream" user)) - (w/write-chat-event (format "New subscriber: %s" user))))) - (cons - '(monitor twitch gift) - (lambda (msg) - (let ((user (car msg)) - (subs (cadr msg))) - (unless (s-equals? user "lcolonq") - (w/model-region-word "skin" (format "thanks_%s_" user)) - (w/friend-respond (format "%s just gifted subscriptions" user)) - (w/write-chat-event (format "%s gifted %d subs" user subs)) - (soundboard//play-monsterkill subs))))) - (cons - '(monitor twitch poll begin) - (lambda (_) - (w/write-chat-event "Poll started") - (w/friend-respond "The chatters are doing a poll"))) - (cons - '(monitor twitch poll end) - (lambda (msg) - (let ((winner (car (-max-by (-on #'> #'cadr) (cadr msg))))) - (w/write-chat-event (format "Poll finished, winner is: %s" winner)) - (when w/twitch-current-poll-callback - (funcall w/twitch-current-poll-callback winner)) - (setq w/twitch-current-poll-callback nil)))) - (cons - '(monitor twitch prediction begin) - (lambda (msg) - (w/write-chat-event "Gamble started") - (w/friend-respond "The chatters are gambling") - (setq w/twitch-current-prediction-ids msg))) - (cons - '(monitor twitch prediction end) - (lambda (_) - (w/write-chat-event "Gamble finished") - (setq w/twitch-current-prediction-ids nil))) - ;; (cons - ;; '(monitor discord chat incoming) - ;; (lambda (data) - ;; (let ((user (w/decode-string (cadr data))) - ;; (msg (w/decode-string (cadddr data)))) - ;; (w/write-chat-event (format "discord from %s: %s" user msg))))) - )) + w/bus-event-handlers + (list + (cons + '(monitor lamulana test) + (lambda (data) + (w/write-chat-event (format "LA-MULANA says hi: %s" data)))) + (cons + '(monitor nethack test) + (lambda (data) + (w/write-chat-event (format "Nethack says hi: %s" data)))) + (cons + '(monitor nethack monster) + (lambda (data) + (when-let ((sp (s-split " " (car data)))) + (setf planet/last-monster (cons (s-join " " (cdr sp)) (string-to-number (car sp)))) + (planet/render-monster-summary)))) + (cons + '(overlay barrage started) + (lambda (_) + (w/write-chat-event "It begins...") + (setf w/overlay-barrage-active t) + (w/overlay-update-cursor))) + (cons + '(overlay barrage ended) + (lambda (msg) + (cond + ((s-equals? (car msg) "won") (w/write-chat-event "Fufufu... I win...")) + (t (w/write-chat-event "that it's over"))) + (setf w/overlay-barrage-active nil))) + (cons '(monitor twitch chat incoming) #'w/twitch-handle-incoming-chat) + (cons '(monitor twitch redeem incoming) #'w/twitch-handle-redeem) + (cons + '(frontend redeem incoming) + (lambda (msg) + (w/twitch-handle-redeem-api msg) + )) + (cons + '(monitor twitch raid) + (lambda (msg) + (let ((user (car msg))) + (soundboard//play-clip "rampage.mp3") + (w/write-chat-event (format "%s just raided!" user)) + (w/friend-respond (format "%s just came to visit" user)) + (run-with-timer + 15 nil + (lambda () + (w/twitch-get-user-recent-clips + user + (lambda (clips) + (w/model-region-word "hair" (s-concat user "_")) + (w/model-region-word "eyes" "WELCOME") + (if clips + (w/model-region-video "hair" (car clips)) + (w/model-region-user-avatar "hair" user))))))))) + (cons + '(monitor twitch follow) + (lambda (msg) + (let ((user (car msg))) + (soundboard//play-clip "firstblood.mp3") + (w/model-region-word "skin" (format "welcome_%s_" user)) + (w/friend-respond (format "%s just followed the stream" user)) + (w/write-chat-event (format "New follower: %s" user))))) + (cons + '(monitor twitch subscribe) + (lambda (msg) + (let ((user (car msg))) + (w/thank-sub user) + (w/model-region-word "skin" (format "thanks_%s_" user)) + (w/friend-respond (format "%s just subscribed to the stream" user)) + (w/write-chat-event (format "New subscriber: %s" user))))) + (cons + '(monitor twitch gift) + (lambda (msg) + (let ((user (car msg)) + (subs (cadr msg))) + (unless (s-equals? user "lcolonq") + (w/model-region-word "skin" (format "thanks_%s_" user)) + (w/friend-respond (format "%s just gifted subscriptions" user)) + (w/write-chat-event (format "%s gifted %d subs" user subs)) + (soundboard//play-monsterkill subs))))) + (cons + '(monitor twitch poll begin) + (lambda (_) + (w/write-chat-event "Poll started") + (w/friend-respond "The chatters are doing a poll"))) + (cons + '(monitor twitch poll end) + (lambda (msg) + (let ((winner (car (-max-by (-on #'> #'cadr) (cadr msg))))) + (w/write-chat-event (format "Poll finished, winner is: %s" winner)) + (when w/twitch-current-poll-callback + (funcall w/twitch-current-poll-callback winner)) + (setq w/twitch-current-poll-callback nil)))) + (cons + '(monitor twitch prediction begin) + (lambda (msg) + (w/write-chat-event "Gamble started") + (w/friend-respond "The chatters are gambling") + (setq w/twitch-current-prediction-ids msg))) + (cons + '(monitor twitch prediction end) + (lambda (_) + (w/write-chat-event "Gamble finished") + (setq w/twitch-current-prediction-ids nil))) + ;; (cons + ;; '(monitor discord chat incoming) + ;; (lambda (data) + ;; (let ((user (w/decode-string (cadr data))) + ;; (msg (w/decode-string (cadddr data)))) + ;; (w/write-chat-event (format "discord from %s: %s" user msg))))) + )) (provide 'wasp-event-handlers) ;;; wasp-event-handlers.el ends here diff --git a/src/wasp-model.el b/src/wasp-model.el index 321f7dae..c38da58b 100644 --- a/src/wasp-model.el +++ b/src/wasp-model.el @@ -12,6 +12,18 @@ (require 'wasp-twitch) (require 'wasp-user) +(defun w/model-get-default-backgrounds (k) + "Retrieve the background playlist and pass it to K." + (w/db-get "modelbackgrounds" + (lambda (res) + (funcall k (if (s-present? res) (w/read-sexp res) nil))))) + +(defun w/model-add-default-background (url) + "Add URL to the background playlist." + (w/model-get-default-backgrounds + (lambda (cur) + (w/db-set "modelbackgrounds" (format "%S" (cons url cur)))))) + (defun w/model-frame-test () "Submit a test frame for the new model." (let ((data @@ -45,12 +57,10 @@ "Reset the model palette." (interactive) (w/pub '(avatar reset)) - ;; (w/model-region-color "eyes" (color-values "gold")) - ;; (w/model-region-word "eyes" "GOLDEN") - ;; (w/model-region-video "hair" "https://www.twitch.tv/kamijoan") - ;; (w/model-region-video "hair" "https://www.twitch.tv/kiwidancing") - (w/model-region-video "hair" "https://www.youtube.com/watch?v=FtutLA63Cp8") - ) + (w/model-get-default-backgrounds + (lambda (bgs) + (when bgs + (w/model-region-video "hair" (w/pick-random bgs)))))) (defun w/model-toggle (toggle) "Toggle TOGGLE on model." diff --git a/src/wasp-overlay.el b/src/wasp-overlay.el index 23786453..c4e63e3b 100644 --- a/src/wasp-overlay.el +++ b/src/wasp-overlay.el @@ -1,57 +1,49 @@ -;;; wasp-overlay --- Superterranean Animism Overlay -*- lexical-binding: t; -*- +;;; wasp-overlay --- Fullscreen overlay -*- lexical-binding: t; -*- ;;; Commentary: ;;; Code: (require 'wasp-utils) (require 'wasp-bus) -(require 'wasp-prod) - -(add-to-list 'load-path (f-canonical "~/src/animism/")) -(require 'bulletml) - -;; src,Xway,fire^쾠㘽쾷ㅗ껋㾨먝乲뛏屚w㮇㸩멽ꝼ쓋♫릫m떫쓏䓳⩺䮻1㨧퉝ƭ쓐ǥᓌ㒵ᒄ먽乳俴㢈쿗峫ฐꙢ왽욍투ㅖ㨧슝呑㟪䁓Ɂy䏧呠3먫슎呒3⧘ɍy욋ᕈ00먫⇳ -;; this one is broken fix it -ellg, probably - -(defconst w/overlay-spellcard-names - '("Joel" "Pemis" "JoelTeachingHisSonJolHowToSpinWhileWideBorisPassesBy" "bugSegz" - "widepeepoMASTURBATION77769420GANGSHITNOMOREFORTNITE19DOLLERFORTNITECARD" - "Machine Made Of Fire, Heart Made Of Doves" - "Dream Seal" "Evil-Sealing Circle" "Dream Seal -Spread-" "Dream Seal -Concentrate-" - "Duplex Barrier" "Dream Orb" "Omnidirectional Oni-Binding Circle" "Yin-Yang Treasured Orb" - "Yin-Yang Kishin Orb" "Dream Orb String" "Yin-Yang Scattering" "Exorcising Border" - "Yin-Yang King Piece" "Illusionary Moon" "Flying Mysterious Shrine Maiden" - "Dream Seal -Blink-" "Great Duplex Barrier" "Dream Seal -Worn-" "Dream Seal -Marred-" - "Dream Seal -The Point Of The Mask-" - )) - -(defvar w/overlay-barrage-active nil) + +(defun w/overlay-shader (user shader) + "Set the overlay shader to SHADER by USER." + (w/pub '(avatar overlay shader) + (list (w/encode-string user) (w/encode-string shader)))) + +(defun w/overlay-chat (msg) + "Update the overlay about chat MSG." + (w/pub '(avatar overlay chat) + (list + (w/encode-string (w/. user msg)) + (w/encode-string (w/. text msg)) + (format "%s" (w/unix-time)) + (format "%s" (or (w/. biblicality msg) 0.0))))) + +(defun w/overlay-muzak (user song) + "Update the overlay about Muzak SONG played by USER." + (ignore song) + (w/pub '(avatar overlay muzak) (list (w/encode-string user)))) + +(defun w/overlay-muzak-clear () + "Tell the overlay that there is no Muzak song playing." + (w/pub '(avatar overlay muzak clear) (list))) + (defvar w/overlay-last-cursor nil) (defun w/overlay-update-cursor () "Inform the overlay about the current cursor position." - (when (and w/overlay-barrage-active (process-live-p (get-process w/bus-process))) - (when-let ((pos (window-absolute-pixel-position))) + (when (and (process-live-p (get-process w/bus-process))) + (when-let* ((pos (window-absolute-pixel-position))) (when (not (equal pos w/overlay-last-cursor)) (setf w/overlay-last-cursor pos) - (w/pub '(overlay cursor) (list (- (car pos) 1920) (cdr pos))))))) + (w/pub '(avatar overlay cursor) (list (car pos) (cdr pos))))))) (add-hook 'post-command-hook #'w/overlay-update-cursor) -(defun w/overlay-start-barrage (bml) - "Start a barrage on the overlay using the BulletML source string BML." - (w/pub '(overlay barrage start) (list (w/encode-string bml)))) - -(defun w/overlay-decode-shorthand-bml (s k) - "Decode the shorthand BulletML string S. -Pass the resulting BulletML XML string to K." - ;; (w/write-log s) - (w/prod-get-raw - (format "/api/yamame?input=%s" (url-encode-url s)) - (lambda (data) - (if-let* ((bml (bml/parse-string data)) - (b (bml/initialize bml)) - ((bml/barrage-toplevel b))) - (progn - (funcall k data)) - (w/write-chat-event "That spell card is too powerful... "))))) +(defun w/overlay-emacs () + "Update the overlay with miscellaneous data from Emacs." + (w/pub '(avatar overlay emacs) + (list + (w/get-heartrate) + ))) (provide 'wasp-overlay) ;;; wasp-overlay.el ends here diff --git a/src/wasp-setup.el b/src/wasp-setup.el index 6eeb5ded..e1488677 100644 --- a/src/wasp-setup.el +++ b/src/wasp-setup.el @@ -43,11 +43,12 @@ (w/run-audio-record-end-timer) (w/populate-bible-table) (w/user-cache-populate) + (w/run-banner-ad-timer) (w/start-audio-record) (w/start-chatsummary) (w/start-fake-chatters) - (w/start-friend) + (w/friend-start) ;; layout (eyebrowse-switch-to-window-config 0) diff --git a/src/wasp-twitch-chat-commands.el b/src/wasp-twitch-chat-commands.el index 33435d7f..d903d93c 100644 --- a/src/wasp-twitch-chat-commands.el +++ b/src/wasp-twitch-chat-commands.el @@ -14,12 +14,17 @@ w/twitch-chat-commands (list (cons + "!getpaid" + (lambda (_ _) + (w/pub '(monitor lamulana msg)))) + (cons "!commands" (lambda (_ _) (w/twitch-say - (s-concat - "Available commands: " - (s-join " " (--filter (s-contains? "!" it) (-map #'car w/twitch-chat-commands))))))) + (s-truncate 500 + (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"))) @@ -76,6 +81,7 @@ (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 "!news" (lambda (_ _) (w/twitch-say "https://news.colonq.computer"))) (cons "!oub" (lambda (_ _) (w/twitch-say "https://oub.colonq.computer"))) (cons "!cellar" (lambda (_ _) (w/twitch-say "https://pub.colonq.computer/~llll/cellar/index.html"))) (cons "!game" (lambda (_ _) (w/twitch-say "https://oub.colonq.computer"))) @@ -106,6 +112,10 @@ (lambda (user _) (w/twitch-say (format "boost power for @%s: %s" user (alist-get :boost w/user-current))))) (cons + "!tsoob" + (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))))) diff --git a/src/wasp-twitch-redeems.el b/src/wasp-twitch-redeems.el index bf7a352b..98887386 100644 --- a/src/wasp-twitch-redeems.el +++ b/src/wasp-twitch-redeems.el @@ -16,8 +16,6 @@ (require 'wasp-overlay) (require 'wasp-cyclone) (require 'wasp-bless) -(require 'muzak) -(require 'muzak-wasp) (defvar w/twitch-redeem-sound-last 0) @@ -30,7 +28,7 @@ (w/write-chat-event (format "%s threw shade" user)) (w/db-set "shader" shader) (w/model-record-change) - (w/pub '(avatar overlay shader) (list (w/encode-string user) (w/encode-string shader))))) + (w/overlay-shader user shader))) (list "lurker check in" 1 (lambda (user _) @@ -174,6 +172,10 @@ (w/bless inp 50)) (w/write-chat-event (format "%s is not authorized to run code" user))))) (list + "encoded clarity" 7 + (lambda (user _) + (w/write-chat-event (format "%s allowed the streamer to \"drink\"" user)))) + (list "feed friend" 10 (lambda (user inp) (let ((cur (float-time))) @@ -187,7 +189,7 @@ (let ((cur (float-time))) (when (> (- cur w/twitch-redeem-sound-last) 2) (w/write-chat-event (s-concat user " talks to \"friend\": " inp)) - (w/friend-chat user inp) + (w/friend-respond (format "%s says: %s" user inp)) (setq w/twitch-redeem-sound-last cur))))) (list "friend composes song" 10 @@ -301,7 +303,7 @@ (w/write-chat-event (s-concat user " established spatiotemporal clarity")) (w/obs-activate-toggle 'spatiotemporal-clarity))) (list - "total clarity" 5000 + "nasal clarity" 5000 (lambda (user _) (w/stop-all-audio) (run-with-timer @@ -314,6 +316,10 @@ (lambda (user _) (w/write-chat-event (s-concat user " was canonized!")) (w/bible-canonize user))) + (list + "cloning facility" 50000 + (lambda (user _) + (w/write-chat-event (format "%s entered the cloning facility" user)))) )) (provide 'wasp-twitch-redeems) diff --git a/src/wasp-twitch.el b/src/wasp-twitch.el index de44c735..2ff66567 100644 --- a/src/wasp-twitch.el +++ b/src/wasp-twitch.el @@ -14,6 +14,7 @@ (require 'wasp-copfish) (require 'wasp-shindaggers) (require 'wasp-hex) +(require 'wasp-user-stats) ;; gizmos (require 'wasp-biblicality) @@ -272,7 +273,7 @@ K is called when the download is finished." "Run the shoutout timer." (when w/twitch-shoutout-timer (cancel-timer w/twitch-shoutout-timer)) - (when-let ((user (pop w/twitch-shoutout-queue))) + (when-let* ((user (pop w/twitch-shoutout-queue))) (w/twitch-shoutout user)) (setq w/twitch-shoutout-timer @@ -335,7 +336,7 @@ CALLBACK will be passed the winner when the poll concludes." (let ((pos (point-min))) (while pos (let ((end (next-single-property-change pos 'display))) - (when-let ((face (get-text-property pos 'display))) + (when-let* ((face (get-text-property pos 'display))) (add-text-properties pos (or end (point-max)) `(display @@ -529,6 +530,9 @@ CALLBACK will be passed the winner when the poll concludes." ((s-equals? name "hellpie") "🥧") ((s-equals? name "steeledshield") "⛨") ((s-equals? name "asrael_io") (propertize "Q" 'display (create-image (w/twitch-emote-path "emotesv2_a9dc5935824a4d6792f4b48f91031fcf")))) + ((s-equals? name "nichepenguin") "💚") + ;; ((s-equals? name "h_ingles") "") + ;; ((s-equals? name "compilingjay") "") (t "EL."))) (when (-contains? badges "vip/1") "💎") (when (-contains? badges "subscriber/0") "💻") diff --git a/src/wasp-user-stats.el b/src/wasp-user-stats.el index 19d297a4..285754f8 100644 --- a/src/wasp-user-stats.el +++ b/src/wasp-user-stats.el @@ -2,6 +2,11 @@ ;;; Commentary: ;;; Code: +(require 'dash) +(require 's) +(require 'ht) +(require 'wasp-user) + (defvar w/user-faction-exemptions (list "LCOLONQ" @@ -54,7 +59,15 @@ (w/user-faction-total 'tony) (w/user-faction-total 'lever))) +(defun w/user-ensure-name () + "Ensure that the current user has a name assigned." + (let ((cur (alist-get :name w/user-current))) + (unless cur + (setf (alist-get :name w/user-current) w/user-current-name)))) + (defun w/user-stats-update () + "Ensure that the current user has all stats." + (w/user-ensure-name) (w/user-ensure-faction) (w/user-ensure-element)) diff --git a/src/wasp-user-whitelist.el b/src/wasp-user-whitelist.el index 5205e002..f23471d6 100644 --- a/src/wasp-user-whitelist.el +++ b/src/wasp-user-whitelist.el @@ -237,6 +237,9 @@ "quackthatsmackyo" "thelinuxdeveloper" "hrrawr" + "taske666" + "rat_not_like_noah" + "RealNaesten" ))) (setq diff --git a/src/wasp-user.el b/src/wasp-user.el index 6694b2f2..08e5c971 100644 --- a/src/wasp-user.el +++ b/src/wasp-user.el @@ -123,5 +123,25 @@ Save it back to the database after K returns." (print u) (w/user-set user u)))) +(defun w/user-decrown (user) + "Decrement USER's equity status." + (w/user-get + user + (lambda (u) + (let ((old (or (alist-get :equity u) 0))) + (setf (alist-get :equity u) (- old 1))) + (print u) + (w/user-set user u)))) + +(defun w/user-boost-compensation (user) + "Give USER a consolation BOOSTPOWER prize." + (w/user-get + user + (lambda (u) + (let ((old (or (alist-get :boost u) 0))) + (setf (alist-get :boost u) (+ old 20))) + (print u) + (w/user-set user u)))) + (provide 'wasp-user) ;;; wasp-user.el ends here diff --git a/src/wasp-utils.el b/src/wasp-utils.el index 54cc3cae..8bac37ae 100644 --- a/src/wasp-utils.el +++ b/src/wasp-utils.el @@ -170,8 +170,8 @@ If it is C, consume it and return non-nil." "Look at the character at point in the current buffer. If it is C, consume it. Otherwise, throw an error." - (if-let ((char (char-after)) - (cont (= char c))) + (if-let* ( (char (char-after)) + (cont (= char c))) (progn (delete-char 1) t) @@ -184,7 +184,7 @@ Otherwise, throw an error." (defun w/open-link () "Open URL in the primary stream window." (interactive) - (when-let ((url (thing-at-point 'url t))) + (when-let* ((url (thing-at-point 'url t))) (select-window (w/get-stream-primary-window)) (browse-url url))) @@ -192,7 +192,7 @@ Otherwise, throw an error." "Prevent focus from reaching popup frame E." (not (frame-parameter (cadr e) 'wasp-prevent-focus))) -(defconst w/asset-base-path (f-canonical "./assets/")) +(defconst w/asset-base-path (f-canonical "/home/llll/src/wasp/assets/")) (defun w/asset (path) "Return the absolute path given an asset path PATH." (f-join w/asset-base-path path)) |