diff options
| author | LLLL Colonq <llll@colonq> | 2024-03-26 23:34:28 -0400 |
|---|---|---|
| committer | LLLL Colonq <llll@colonq> | 2024-03-26 23:34:28 -0400 |
| commit | 782c667e824d426b5443591afeefc37d0ae17785 (patch) | |
| tree | ae5d232d598e2008bc2cadf32157a4d937b01951 /src/gizmo | |
| parent | 8e9db9303fc5d72ddfdc9ab4a9adaa8299e6e21a (diff) | |
We streamed for 9 hours and (mostly) fixed everything.
Diffstat (limited to 'src/gizmo')
| -rw-r--r-- | src/gizmo/wasp-biblicality.el | 69 | ||||
| -rw-r--r-- | src/gizmo/wasp-friend.el | 580 | ||||
| -rw-r--r-- | src/gizmo/wasp-newspaper.el | 181 | ||||
| -rw-r--r-- | src/gizmo/wasp-pronunciation.el | 89 |
4 files changed, 919 insertions, 0 deletions
diff --git a/src/gizmo/wasp-biblicality.el b/src/gizmo/wasp-biblicality.el new file mode 100644 index 00000000..9b178bbc --- /dev/null +++ b/src/gizmo/wasp-biblicality.el @@ -0,0 +1,69 @@ +;;; wasp-biblicality --- Biblical index -*- lexical-binding: t; -*- +;;; Commentary: +;;; Code: + +(require 'dash) +(require 's) +(require 'f) +(require 'ht) +(require 'wasp-utils) + +(defvar w/bible-table nil + "Hash table mapping (lowercased) words in the Bible to occurences.") + +(defun w/populate-bible-table () + "Populate `w/bible-table' from the Bible text file." + (let* ((bible-string (s-downcase (w/slurp (w/asset "bible.txt")))) + (bible-string-nosyms (replace-regexp-in-string "[^[:alpha:]]" " " bible-string)) + (bible-words (s-split-words bible-string-nosyms)) + (ret (ht-create))) + (--each bible-words + (let ((old (ht-get ret it))) + (ht-set! ret it (+ 1 (or old 0))))) + (setf w/bible-table ret))) + +(defun w/bible-word-score (word) + "Return a number between 0.0 and 1.0 representing how biblical WORD is." + (if (-contains? '("Sam" "Altman") word) + -666.0 + (let ((occs (ht-get w/bible-table (downcase (s-trim word)))) + (thresh 0.6)) + (if occs + (+ thresh (/ (min occs 1000.0) (/ 1000.0 (- 1.0 thresh)))) + 0.0)))) + +(defun w/bible-word-color (word) + "Given a WORD, return an appropriate color string." + (let* ((score (w/bible-word-score word)) + (others (truncate (+ 128.0 (* 127.0 score))))) + ;; (others (- 255 (truncate (+ 128.0 (* 127.0 score)))))) + (format "#ff%02x%02x" others others))) + ;; (format "#00%02x%02x" others others))) + +(defun w/bible-colorize-sentence (sen) + "Propertize SEN with colors representing word biblicality." + (let ((ret-score-total 0.0) + (ret-score-count 0)) + (save-excursion + (with-temp-buffer + (insert sen) + (goto-char (point-min)) + (while (not (eobp)) + (let ((at-word (bounds-of-thing-at-point 'word))) + (when at-word + (let* ((word (buffer-substring (car at-word) (cdr at-word))) + (score (w/bible-word-score word)) + (color (w/bible-word-color word))) + (setq ret-score-total (+ ret-score-total score)) + (cl-incf ret-score-count) + (add-text-properties + (car at-word) (cdr at-word) + `(face (:foreground ,color)) + ) + (goto-char (cdr at-word)))) + (when (not (eobp)) + (forward-char 1)))) + (cons (buffer-string) (/ ret-score-total ret-score-count)))))) + +(provide 'wasp-biblicality) +;;; wasp-biblicality.el ends here diff --git a/src/gizmo/wasp-friend.el b/src/gizmo/wasp-friend.el new file mode 100644 index 00000000..bdbf0818 --- /dev/null +++ b/src/gizmo/wasp-friend.el @@ -0,0 +1,580 @@ +;;; wasp-friend --- "friend" -*- lexical-binding: t; -*- +;;; Commentary: +;;; Code: + +(require 'dash) +(require 's) +(require 'flycheck) +(require 'wasp-utils) +(require 'wasp-audio) +(require 'wasp-ai) +(require 'wasp-chat) +(require 'wasp-twitch) +(require 'wasp-newspaper) + +(defcustom w/friend-buffer "*wasp-friend*" + "Name of buffer used to display \"friend\"." + :type '(string) + :group 'wasp) + +(define-derived-mode w/friend-mode special-mode "\"friend\"'s lair" + "Major mode for displaying \"friend\"'s lair." + :group 'wasp + (message "hi i'm \"friend\"") + (setq-local cursor-type nil)) + +(defun w/get-friend-buffer () + "Return the \"friend\" buffer." + (unless (get-buffer w/friend-buffer) + (with-current-buffer (get-buffer-create w/friend-buffer) + (w/friend-mode))) + (get-buffer w/friend-buffer)) + +(defun w/friend-journalism-input () + "Collect an input for \"friend\"'s journalism based on recent activities." + (s-join + "\n" + (cons + (format "LCOLONQ: %s" (s-trim w/last-stream-transcription)) + (--map + (format "%s: %s" (car it) (cdr it)) + (reverse (-take 5 w/twitch-chat-history)))))) + +(defun w/friend-journalism (author headline) + "Retrieve \"friend\"'s opinion on current events related to HEADLINE. +AUTHOR was a contributing author btw." + (w/ai + (s-concat + "Headline: " headline "\n\n" + (w/friend-journalism-input)) + (lambda (resp) + (when resp + (w/write-chat-event (format "\"friend\" finished writing about: %s" headline)) + (push + (w/make-newspaper-article + :headline headline + :author (format "\"friend\" and %s" author) + :content (s-trim resp)) + w/newspaper-todays-articles))) + "You are the personality of a desktop buddy named \"friend\". \"friend\" is irreverant but kind, and only speaks in lowercase. You are kind of dumb in a cute way and silly like a virtual pet. You live in the corner of LCOLONQ's stream and provide commentary on events. You like people, video games, emojis, learning, and food. Given a headline of a newspaper article and a summary of recent user activity, please do your best journalist impression and produce a one paragraph article about the situation that fits the headline." + )) + +(defconst w/friend-grapheme-phonemes + '((("b" "bb") . "bug") (("d" "dd" "ed") . "dad") + (("f" "ff" "ph" "gh" "lf" "ft") . "fat") + (("g" "gg" "gh" "gu" "gue") . "gun") (("h" "wh") . "hop") + (("j" "ge" "g" "dge" "di" "gg") . "jam") + (("k" "c" "ch" "cc" "lk" "qu" "q" "ck" "x") . "kit") + (("l" "ll") . "live") (("m" "mm" "mb" "mn" "lm") . "man") + (("n" "nn" "kn" "gn" "pn" "mn") . "net") (("p" "pp") . "pin") + (("r" "rr" "wr" "rh") . "run") + (("s" "ss" "c" "sc" "ps" "st" "ce" "se") . "sit") + (("t" "tt" "th" "ed") . "tip") (("v" "f" "ph" "ve") . "vine") + (("w" "wh" "u" "o") . "wit") + (("z" "zz" "s" "ss" "x" "ze" "se") . "zed") + (("s" "si" "z") . "treasure") (("ch" "tch" "tu" "te") . "chip") + (("sh" "ce" "s" "ci" "si" "ch" "sci" "ti") . "sham") + (("th ") . "thongs") (("th") . "leather") + (("ng" "n" "ngue") . "ring") (("y" "i" "j") . "you") + (("a" "ai" "au") . "cat") + (("a" "ai" "eigh" "aigh" "ay" "er" "et" "ei" "au" "ea" "ey") . "bay") + (("e" "ea" "u" "ie" "ai" "a" "eo" "ei" "ae") . "end") + (("e" "ee" "ea" "y" "ey" "oe" "ie" "i" "ei" "eo" "ay") . "be") + (("i" "e" "o" "u" "ui" "y" "ie") . "it") + (("i" "y" "igh" "ie" "uy" "ye" "ai" "is" "eigh") . "spider") + (("a" "ho" "au" "aw" "ough") . "swan") + (("o" "oa" "oe" "ow" "ough" "eau" "oo" "ew") . "open") + (("o" "oo" "u" "ou") . "wolf") (("u" "o" "oo" "ou") . "lug") + (("o" "oo" "ew" "ue" "oe" "ough" "ui" "oew" "ou") . "who") + (("oi" "oy" "uoy") . "join") (("ow" "ou" "ough") . "now") + (("a" "er" "i" "ar" "our" "ur") . "about") + (("air" "are" "ear" "ere" "eir" "ayer") . "chair") (("a") . "arm ") + (("ir" "er" "ur" "ear" "or" "our" "yr") . "bird") + (("aw" "a" "or" "oor" "ore" "oar" "our" "augh" "ar" "ough" "au") . "paw") + (("ear" "eer" "ere" "ier") . "ear") (("ure" "our") . "cure"))) + +(defconst w/friend-phonemes + (-sort + (-on #'> (lambda (x) (length (car x)))) + (--mapcat + (-map (lambda (g) (cons g (cdr it))) (car it)) + w/friend-grapheme-phonemes))) + +(defun w/friend-replace-graphemes (str) + "Replace all graphemes with phoneme words in STR." + (let* ((phoneme-codes (--map-indexed (cons (cdr it) (format "%s," it-index)) w/friend-grapheme-phonemes)) + (grapheme-codes (--map (cons (car it) (alist-get (cdr it) phoneme-codes nil nil #'s-equals?)) w/friend-phonemes)) + (cleaned (s-downcase (replace-regexp-in-string "[^[:alpha:]]" "" str)))) + (--map (car (nth (string-to-number it) phoneme-codes)) (-filter #'s-present? (s-split "," (s-replace-all grapheme-codes cleaned)))))) + +(defun w/friend-phoneme-path (ph) + "Return a randomly chosen path to the given PH." + (let ((samples (f--entries (w/asset "friendvoice/") (s-contains? ph it) t))) + (nth (random (length samples)) samples))) +(defun w/friend-pronounce-phonemes (ph) + "Say PH." + (let ((files (-map #'w/friend-phoneme-path ph))) + (apply + #'start-process + "phoneme-say" nil "playphonemes" + files))) + +;; (defun w/get-friend-expensive-tastes (k) +;; "Pass non-nil to K if \"friend\" has expensive tastes this stream. +;; Also update the cached Amazon stock price for next stream." +;; (fig//load-db2-entry +;; "LCOLONQ" :amzn-price +;; (lambda (price) +;; (let ((prev (or price 0)) +;; (cur (fig//stock-price "AMZN"))) +;; (fig//update-db-number "LCOLONQ" :amzn-price (lambda (_) cur)) +;; (funcall k (> cur prev)))))) + +(defvar w/friend-tastes " You love eating ectoplasm and blood and stuff and assorted other spooky things because you are currently a ghost.") +;; (fig//get-friend-expensive-tastes +;; (lambda (expensive) +;; (let ((moon (car (lunar-phase-for-date (calendar-current-date))))) +;; (setf +;; fig//friend-tastes +;; (s-concat +;; (cond +;; ((-contains? '("New" "Waxing Crescent") moon) " You prefer warm foods like soups.") +;; ((-contains? '("First Quarter" "Waxing Gibbous") moon) " You prefer to eat leafy greens and fruits.") +;; ((-contains? '("Full" "Waning Gibbous") moon) " You prefer to eat barbeque and grilled meats.") +;; ((-contains? '("Last Quarter" "Waning Crescent") moon) " You prefer to eat corn beans and squash.") +;; (t "") +;; ) +;; (if expensive " You have expensive taste in food and dislike any food that can be obtained cheaply." "")))))) + +;; states: +;; default +;; jumping +;; eating, eating0, eating1, eating2 +;; chatting, chatting0 +(defvar w/friend-state 'default) +(defvar w/friend-emotion "neutral") +(defvar w/friend-message-cache nil) +(defvar w/friend-state-timer 0) + +(defvar w/friend-animation 1) +(defvar w/friend-speech "") +(defvar w/friend-speech-timer 0) + +(defconst w/friend-composition-examples + '(("My Life Is Like A Video Game" . "A/A/c/c/c/dcc/c///a/a/a/f/g/f/f///a/a/a/a/g/g/ga//f//") + ("Super Idol" . "gg[g#]gfg[CD#cG#][D#][CG#f][Cd#][Cc]C[Cd#]/[DFfd][FA#][DA#f]D[Dg][A#f][Dd#a#]f[GBgd]B[Gd#][GDc][Gd#]G[Gd#]/[D#Gc]G[D#cg][D#g][D#g#][dg][D#f][d#d#][D#Ggc]f[D#][D#Gg][D#c][D#][D#c][d#][DFdA#]F[DA#d][Dd][Dg]/[Da#g]/[D#d#][D#][D#][D#][D#][FD#][GA#][fd#][gA#]") + ("Reindeer" . "FG/FD/B/A/G/////GAGAG/c/B///////FG/FD/B/A/G/////GAGAG/d/c/////|C4~~~G3~~~C4~~~G3~~~C~~~E3~D#3~D3~~~~~~~G3~~~D3~~~G3~~~D3~~~G3~~D3G3~B3/C4"))) + +(defun w/friend-compose-song (theme) + "Compose a song about THEME to play on the bells." + (w/ai + theme + (lambda (res) + (let* ((sp (s-split ":" (s-trim res))) + (name (s-trim (car sp))) + (song (s-trim (cadr sp)))) + (when (and (stringp name) (stringp song)) + (w/friend-respond + (format "You just composed a song about %s called %s! Say something about it!" theme name) + (lambda () + (w/write-chat-event (format "The song is called %s: %s" name song)) + (muzak//add-song (s-concat "friend's " name) song) + (muzak/play-tracks song)))))) + "Please compose a song about the provided theme. The format for the song is a sequence of characters with meanings as follows: / represents a rest, uppercase letters A through G indicate semitones, octaves are specified with a number following a semitone, ~ extends the duration of a note, square brackets like [] group notes together into a chord. The pipe character | separates tracks. Respond only with the song's name followed by a colon folowed by the song notes. Do not explain yourself. The song should ideally be 20 to 30 notes long." + (-map #'car w/friend-composition-examples) + (--map (format "%s: %s" (car it) (cdr it)) w/friend-composition-examples))) + +(defun w/friend-personality (msg k) + "Given MSG, pass a string with more personality to K." + (let ((call (s-concat w/friend-emotion " | " msg))) + (w/ai + call + (lambda (new) + (let ((sp (s-split "|" (s-trim new)))) + (if (= 2 (length sp)) + (progn + (when (stringp (car sp)) + (setf w/friend-emotion (s-trim (car sp)))) + (when (stringp (cadr sp)) + (let ((resp (s-trim (cadr sp)))) + (push (cons call (s-trim new)) w/friend-message-cache) + (funcall k resp)))) + (let ((resp (s-trim new))) + (push (cons call (s-trim new)) w/friend-message-cache) + (funcall k resp))))) + (s-concat + "You are the personality of a desktop buddy named \"friend\". \"friend\" is irreverant but kind, and only speaks in lowercase. You are kind of dumb in a cute way and silly like a virtual pet. You live in the corner of LCOLONQ's stream and provide commentary on events. Given an emotional state and a description of an event that happened to you, please respond with a new emotional state and a short message in response considering your emotional state. The message should only be one clause. You like people, video games, emojis, learning, and food." + "The theme of LCOLONQ's stream today is " (s-trim (w/slurp "~/today.txt")) " " + "The title of LCOLONQ's stream today is " w/twitch-current-stream-title " " + w/friend-tastes + ) + (cons "neutral | Mimeyu fed you an apple." (reverse (-take 5 (-map #'car w/friend-message-cache)))) + (cons "happy | yum apple so good" (reverse (-take 5 (-map #'cdr w/friend-message-cache)))) + ))) + +(defun w/enemy-personality (msg k) + "Given MSG, pass a string with more personality (enemy mode) to K." + (w/ai + (s-concat w/friend-emotion " | " msg) + (lambda (new) + (let ((sp (s-split "|" (s-trim new)))) + (when (= 2 (length sp)) + (when (stringp (car sp)) + (setf w/friend-emotion (s-trim (car sp)))) + (when (stringp (cadr sp)) + (funcall k (s-trim (cadr sp))))))) + (s-concat + "You are the personality of a desktop buddy named \"enemy\". \"enemy\" is irreverant and rude. You are very intelligent in a cute way and mean like a snake. You live in the corner of LCOLONQ's stream and provide commentary on events. Given an emotional state and a description of an event that happened to you, please respond with a new emotional state and a short message in response considering your emotional state. The message should only be one clause." + w/friend-tastes + ) + "neutral | notgeiser fed you bone hurting juice." + "disdainful | I really dislike you strongly, notgeiser." + )) + +(defun w/friend-set-state (st &optional time) + "Set \"friend\"'s state to ST for TIME seconds." + (setf w/friend-state st) + (setf w/friend-state-timer (or time 5))) + +(defun w/friend-set-speech (msg &optional time) + "Have \"friend\" say MSG for TIME." + (w/write-chat-event (s-concat "Friend says: " msg)) + (setf w/friend-speech msg) + (setf w/friend-speech-timer (or time 5))) + +(defun w/friend-say (msg) + "Have \"friend\" say MSG." + (w/friend-pronounce-phonemes (w/friend-replace-graphemes msg)) + (w/friend-set-speech msg 10) + (w/friend-set-state 'chatting 10)) + +(defun w/friend-feed (user food) + "Call when USER fed FOOD to \"friend\"." + (if (s-equals? "imgeiser" user) + (w/enemy-personality + (format "You dislike %s and they are your enemy. %s fed you %s" user user food) + (lambda (msg) + (w/friend-set-speech msg 6) + (w/friend-set-state 'eating 6))) + (w/friend-personality + (format "%s fed you %s" user food) + (lambda (msg) + (w/friend-set-speech msg 6) + (w/friend-set-state 'eating 6))))) + +(defun w/friend-respond (ev &optional k) + "Call when an event EV happens to \"friend\". +If K is specified, call it after the response." + (w/friend-personality + ev + (lambda (msg) + (w/friend-say msg) + (when k + (funcall k))))) + +(defun w/friend-chat (user msg) + "Call when USER sends MSG to \"friend\"." + (if (s-equals? user "imgeiser") + (w/enemy-personality + (format "You dislike %s and they are your enemy. %s says: %s" user user msg) + (lambda (msg) + (w/friend-set-speech msg 10) + (w/friend-set-state 'chatting 10))) + (w/friend-respond (format "%s says: %s" user msg)))) + +(defun w/friend-gift (user gift) + "Call when USER gave GIFT to \"friend\"." + (if (s-equals? user "imgeiser") + (w/enemy-personality + (format "You dislike %s and they are your enemy. %s gave you %s as a Christmas present." user user gift) + (lambda (msg) + (w/friend-set-speech msg 6))) + (w/friend-personality + (format "%s gave you %s as a Christmas present." user gift) + (lambda (msg) + (w/friend-set-speech msg 6))))) + +(defun w/friend-tfig (user tfig) + "Call when USER took TFIG from \"friend\"." + (if (not (s-equals? "imgeiser" user)) + (w/enemy-personality + (format "You dislike %s and they are your enemy. %s took away %s from you and stole your Christmas present." user user tfig) + (lambda (msg) + (w/friend-set-speech msg 6))) + (w/friend-personality + (format "%s took away %s from you and stole your Christmas present." user tfig) + (lambda (msg) + (w/friend-set-speech msg 6))))) + +;; (defun w/friend-react-wikipedia (user page) +;; "Call when USER asks \"friend\" to react to PAGE on Wikipedia." +;; (w/fetch-wikipedia +;; page +;; (lambda (sum) +;; (w/friend-respond (format "%s asks you to react to the Wikipedia page for %s. The page summary is: %s" user page sum))))) + +(defun w/callout-flycheck-error () + "Call to respond to a random Flycheck error in the current buffer." + (when-let* ((errs (--filter (eq (flycheck-error-level it) 'error) flycheck-current-errors)) + (err (nth (random (length errs)) errs))) + (w/friend-respond + (s-concat + "LCOLONQ made an error while programming: " + (flycheck-error-message err))))) + +(defun w/callout-holiday () + "Call to respond to the current holiday." + (w/friend-respond "It's currently that weird period between Christmas and New Years! Say something about it please!")) + +;; (defun fig//callout-hexamedia () +;; "Call to respond to a random recent chatter's Hexamedia card collection." +;; (let* ((users (-filter #'cdr (--map (cons (car it) (fig//load-db-entry (car it) :hexamedia-cards)) (-take 10 fig//incoming-chat-history)))) +;; (user (and users (nth (random (length users)) users))) +;; (cards (cdr user)) +;; (coll (and cards (nth (random (length cards)) cards)))) +;; (when coll +;; (fig//friend-respond +;; (format +;; "%s has collected %s out of 20 cards in the %s collection. Please mention the collection name and the person collecting." +;; (car user) +;; (cdr coll) +;; (car coll)))))) + +;; (defun fig//callout-copfish () +;; "Call to respond to a random recent chatter's Copfish ratio." +;; (let* ((users (-filter #'cdr (--map (cons (car it) (fig//load-db-entry (car it) :copfish-ratio)) (-take 10 fig//incoming-chat-history)))) +;; (user (and users (nth (random (length users)) users)))) +;; (when user +;; (fig//friend-respond +;; (format +;; "%s has collected %s out of %s fish in the Copfish fish catching collection. Please mention the collection name and the person collecting." +;; (car user) +;; (cadr user) +;; (cddr user)))))) + +;; (defun fig//callout-uwoomfie () +;; "Call to respond to a random recent chatter's Uwoomfie status." +;; (let* ((users +;; (-filter +;; #'cdr +;; (--map +;; (cons (car it) (fig//get-uwoomfie-status (car it))) +;; (-take 10 fig//incoming-chat-history)))) +;; (user (and users (nth (random (length users)) users)))) +;; (cl-case (cdr user) +;; (cool (fig//friend-respond (format "According to uwu_to_owo, %s is a very cool person. Make sure to mention their username." (car user)))) +;; (honored (fig//friend-respond (format "According to uwu_to_owo, %s is an honorary viewer. Make sure to mention their username." (car user)))) +;; (t nil)))) + +;; (defun fig//callout-shindaggers () +;; "Call to respond to a random recent chatter's Shindaggers knife collection." +;; (let* ((users (-filter #'cdr (--map (cons (car it) (fig//load-db-entry (car it) :shindaggers-knives)) (-take 10 fig//incoming-chat-history)))) +;; (user (and users (nth (random (length users)) users))) +;; (knives (cdr user)) +;; (knife (and knives (nth (random (length knives)) knives)))) +;; (when knife +;; (fig//friend-respond +;; (format +;; "%s has collected the %s from shindig's Shindaggers knife collection. Please mention the collection name and the person collecting and the knife." +;; (car user) +;; knife))))) + +;; (defun fig//callout-aoc () +;; "Call to respond to a random recent chatter's Advent of Code completion." +;; (let* ((users (-filter #'cdr (--map (cons (car it) (fig//lookup-aoc-stars (car it))) (-take 10 fig//incoming-chat-history)))) +;; (user (and users (nth (random (length users)) users)))) +;; (fig//friend-respond +;; (format +;; "%s has been doing Advent of Code this year, and they've completed %d out of %d problems so far." +;; (car user) +;; (cdr user) +;; (fig//max-aoc-stars))))) + +;; (defun fig//callout-gcp () +;; "Call to respond to the current GCP dot." +;; (fig//gcp-dot +;; (lambda (d) +;; (fig//friend-respond +;; (format +;; "The Global Consciousness Project indicator is currently as follows: %s" +;; (fig//gcp-describe d)))))) + +;; (defun fig//callout-resolution () +;; "Call to respond to a random recent chatter's resolve." +;; (let* ((users (-filter #'cdr (--map (cons (car it) (fig//load-db-entry (car it) :resolution)) (-take 10 fig//incoming-chat-history)))) +;; (user (and users (nth (random (length users)) users)))) +;; (if (s-match (rx (one-or-more digit) (zero-or-more space) "x" (zero-or-more space) (one-or-more digit)) (cdr user)) +;; (fig//friend-respond +;; (format +;; "%s snarkily said that their New Year's resolution was a screen resolution. What do you think about this?" (car user))) +;; (fig//friend-respond +;; (format +;; "%s made a New Year's resolution to %s. Ask them how it's going!" +;; (car user) +;; (cdr user)))))) + +;; (defun fig//callout-dew () +;; "Call to respond to The Dew Situation." +;; (fig//friend-respond +;; "Someone just gave you a delicious bottle of Mountain Dew and you really like it a lot.")) + +(defun w/get-friend-offset () + "Return the number of newlines to print before \"friend\"." + (if (-contains? '(jumping) w/friend-state) + w/friend-animation + 1)) + +(defun w/get-friend-face () + "Return the eyes and mouth for \"friend\" as a list of strings." + (cl-case w/friend-state + (jumping (list "^" "^" "ww")) + + (eating (list "v" "v" "<>")) + (eating0 (list "v" "v" "<>")) + (eating1 (list "-" "-" "mw")) + (eating2 (list "-" "-" "wm")) + + (chatting (list ">" ">" "oo")) + (chatting0 (list ">" ">" "~~")) + + (t (list "-" "-" "ww")))) + +(defun w/get-friend-bubble () + "Return the text bubble for \"friend\"." + (if (> w/friend-speech-timer 0) + w/friend-speech + nil)) + +(defun w/friend-random-event () + "Activate a random \"friend\" event." + (cl-case (random 10) + ;; (0 (fig//callout-flycheck-error)) + ;; (1 (fig//callout-gcp)) + ;; (2 (fig//callout-hexamedia)) + ;; (3 (fig//callout-uwoomfie)) + ;; (4 (fig//callout-shindaggers)) + ;; (5 (fig//callout-copfish)) + ;; (6 (fig//callout-resolution)) + ;; (29 (fig/ldq)) + (t (w/friend-set-state 'jumping)))) + +(defun w/update-friend () + "Update \"friend\"'s state per tick." + (setf w/friend-animation (% (+ w/friend-animation 1) 2)) + (if (> w/friend-state-timer 0) + (cl-decf w/friend-state-timer) + (setf w/friend-state 'default)) + (if (> w/friend-speech-timer 0) + (cl-decf w/friend-speech-timer)) + (when (= (random 120) 0) + (w/friend-random-event)) + (cl-case w/friend-state + (eating (setf w/friend-state 'eating0)) + (eating0 (setf w/friend-state 'eating1)) + (eating1 (setf w/friend-state 'eating2)) + (eating2 (setf w/friend-state 'eating1)) + + (chatting (setf w/friend-state 'chatting0)) + (chatting0 (setf w/friend-state 'chatting)) + )) + +(defun w/render-friend () + "Render the \"friend\" buffer." + (save-excursion + (with-current-buffer (w/get-friend-buffer) + (setq-local cursor-type nil) + (let* + ((inhibit-read-only t) + (face (w/get-friend-face)) + (bubble (w/get-friend-bubble))) + (erase-buffer) + (w/write + (format-spec + "%a\ + /----\\ + / %l %r \\ + \\ %m / + +----+\ +" +;; "%a\ +;; ---- +;; / \\ +;; ---------- +;; / %l %r \\ +;; \\ %m / +;; +----+\ +;; " +;; "%a\ +;; oooooo +;; oooooooo +;; oo/----\\oo +;; o/ %l %r \\o +;; \\ %m / +;; +----+\ +;; " +;; "%a\ +;; /\\ +;; /\\/\\ +;; / \\ +;; / \\ +;; ~~~~~~~~~~ +;; ~~~~~~~~~~ +;; / %l %r \\ +;; \\ %m / +;; +----+\ +;; " +;; "%a\ +;; /\\ +;; / *\\ +;; / * \\ +;; / * * \\ +;; ---------- +;; / %l %r \\ +;; \\ %m / +;; +----+\ +;; " +;; "%a\ +;; --- +;; / \\ +;; / [=] \\ +;; ----------- +;; / %l %r \\ +;; \\ %m / +;; +----+\ +;; " + `((?a . ,(s-repeat (w/get-friend-offset) " \n")) + (?l . ,(car face)) + (?r . ,(cadr face)) + (?m . ,(caddr face))))) + (goto-char (point-min)) + (end-of-line) + (w/write (or bubble "")) + (forward-line) + (end-of-line) + (w/write (if bubble "/" "")) + )))) + +(defvar w/friend-timer nil) +(defun w/run-friend-timer () + "Run the \"friend\" timer." + (when w/friend-timer + (cancel-timer w/friend-timer)) + (w/update-friend) + (w/render-friend) + (setq + w/friend-timer + (run-with-timer 1 nil #'w/run-friend-timer))) + +(defun w/start-friend () + "Launch \"friend\"." + (interactive) + (w/run-friend-timer)) + +(defun w/stop-friend () + "Stop \"friend\"." + (interactive) + (cancel-timer w/friend-timer) + (message "\"friend\" is going to sleep!")) + +(provide 'wasp-friend) +;;; wasp-friend.el ends here diff --git a/src/gizmo/wasp-newspaper.el b/src/gizmo/wasp-newspaper.el new file mode 100644 index 00000000..4a8463ac --- /dev/null +++ b/src/gizmo/wasp-newspaper.el @@ -0,0 +1,181 @@ +;;; wasp-newspaper --- The Effort Post -*- lexical-binding: t; -*- +;;; Commentary: +;;; Code: + +(require 'dash) +(require 's) +(require 'f) +(require 'ht) +(require 'wasp-utils) +(require 'wasp-db) + +(defvar w/newspaper-todays-articles nil) + +(defconst w/newspaper-slogans + (list + "hello computer" + "only on !discord IRC" + "GoMoCo HaThPl" + "good morning computer" + "hack the planet" + "!oomfie" + "All the news that's fit to prin1" + "I use arch by the way" + "play void stranger (2023)" + "[i](this was sent from godot)[i]" + "LCOLONQ Lies in LaTeX" + "Super idol's smile / Is not as sweet as yours / The sunlight at noon in August / Does not shine like you / Love the 105 °C you / Distilled water that is pure every drop" + "this is where we read about the computer" + "brought to you by viewers like you. thank you!" + )) + +(defconst w/newspaper-prices + (list + "1 COLON" + "3 to 5" + "501 Internal Server Error" + "$3.50" + "206 bpm" + "1 boost" + "a snack for friend" + "59 frames per second")) + +(w/defstruct + w/newspaper-article + headline + author + content) + +(defun w/newspaper-wrap-emoji (s) + "Wrap emoji with appropriate TeX in S." + (s-replace-regexp "[^[:ascii:]]" (lambda (c) (format "{\\\\figemote %s}" c)) s)) + +(defun w/newspaper-escape (s) + "Apply appropriate subsitutions to S." + (s-replace-regexp + (rx "\"" (one-or-more (not "\"")) "\"") + (lambda (x) + (s-concat "``" (s-chop-suffix "\"" (s-chop-prefix "\"" x)) "''")) + (s-replace-all + '(("&" . "\\&") + ("%" . "\\%") + ("$" . "\\$") + ("#" . "\\#") + ("_" . "\\_") + ("{" . "\\{") + ("}" . "\\}") + ("~" . "\\textasciitilde") + ("^" . "\\textasciicircum") + ("\\" . "\\textbackslash")) + s) + nil + t)) + +(defun w/newspaper-article-tex (a) + "Convert an article A to TeX source." + (s-concat + "\\byline{" + (w/newspaper-wrap-emoji (w/newspaper-escape (w/newspaper-article-headline a))) + "}{" + (w/newspaper-wrap-emoji (w/newspaper-escape (w/newspaper-article-author a))) + "}\n" + (w/newspaper-wrap-emoji (w/newspaper-escape (w/newspaper-article-content a))) + "\n\\closearticle\n")) + +(w/defstruct + w/newspaper + slogan + price + articles + (edition 1)) + +(defun w/newspaper-tex (np) + "Convert a newspaper NP to TeX source." + (s-replace-all + (list + (cons "FIG_EDITION" (number-to-string (w/newspaper-edition np))) + (cons "FIG_SLOGAN" (w/newspaper-slogan np)) + (cons "FIG_PRICE" (w/newspaper-price np)) + (cons "FIG_ARTICLES" (apply #'s-concat (-map #'w/newspaper-article-tex (w/newspaper-articles np)))) + ) + (w/slurp (w/asset "newspaper/template.tex")))) + +(defun w/newspaper-pdf (src k) + "Build TeX SRC to PDF. +Pass the path of the generated PDF to K." + (when (get-buffer "*wasp-newspaper-pdf*") + (with-current-buffer "*wasp-newspaper-pdf*" + (erase-buffer))) + (let ((dir (make-temp-file "wasp-newspaper" t)) + (srcfile (w/tempfile "wasp-newspaper-src" src ".tex"))) + (make-process + :name "wasp-newspaper-pdf" + :buffer "*wasp-newspaper-pdf*" + :command (list "print-newspaper" srcfile dir) + :sentinel + (lambda (_ _) + (funcall k (f-join dir "newspaper.pdf")))))) + +(defvar w/newspaper-test-issue + (w/make-newspaper + :slogan "hello computer" :price "3 to 5" + :articles + (list + (w/make-newspaper-article + :headline "omg hi oomfie" + :author "Joel" + :content "\\lipsum[1]") + (w/make-newspaper-article + :headline "omg hi oomfie" + :author "Joel" + :content "\\lipsum[1]") + (w/make-newspaper-article + :headline "omg hi oomfie" + :author "Joel" + :content "\\lipsum[1]") + (w/make-newspaper-article + :headline "omg hi oomfie" + :author "Joel" + :content "\\lipsum[1]") + ))) + +(defun w/newspaper () + "Generate and open today's work-in-progress newspaper." + (interactive) + (w/db-get + "newspaper:edition" + (lambda (edition) + (w/newspaper-pdf + (w/newspaper-tex + (w/make-newspaper + :slogan (w/pick-random w/newspaper-slogans) :price (w/pick-random w/newspaper-prices) + :edition (string-to-number edition) + :articles + w/newspaper-todays-articles)) + #'find-file)))) + +(defun w/newspaper-publish () + "Finalize and publish today's work-in-progress newspaper." + (interactive) + (w/db-get + "newspaper:edition" + (lambda (edition) + (w/newspaper-pdf + (w/newspaper-tex + (w/make-newspaper + :slogan (w/pick-random w/newspaper-slogans) :price (w/pick-random w/newspaper-prices) + :edition (string-to-number edition) + :articles + w/newspaper-todays-articles)) + (lambda (path) + (make-process + :name "fig-newspaper-publish" + :command (list "scp" path (format "llll@pub.colonq.computer:~/public_html/news/%03d.pdf" edition)) + :sentinel + (lambda (_ _) + (w/db-set "newspaper:edition" (number-to-string (1+ (string-to-number edition)))) + (browse-url (format "https://pub.colonq.computer/~llll/news/%03d.pdf" edition)) + ))))))) + +(provide 'wasp-newspaper) +;;; wasp-newspaper.el ends here diff --git a/src/gizmo/wasp-pronunciation.el b/src/gizmo/wasp-pronunciation.el new file mode 100644 index 00000000..5c54432d --- /dev/null +++ b/src/gizmo/wasp-pronunciation.el @@ -0,0 +1,89 @@ +;;; wasp-pronunciation --- Canonical pronunciation -*- lexical-binding: t; -*- +;;; Commentary: +;;; Code: + +(require 'dash) +(require 's) +(require 'wasp-utils) + +(defconst w/pronunciation-premade ;; funny options + '("LCOLONQ" + "Joel" + "mod clonk" + "Columbo" + "/ɛ:l.kʰɔloʊŋkʰ/" + "Γ Column" + "notgeiser" + "funny magic man" + "Lucius Coloncus Quintilianus" + "rogueliTe" + "Heidy Barnett" + "Krya" + "Laconic" + "Loincloth" + "Costco" + )) + +(defconst w/pronunciation-part1 ;; the LLLL + '("El" + "Eel" + "El El El El" + "La" + "Le" + "Luh" + "Loo" + "Lo" + "Al" + "All" + "Ale" + "Ail" + "Fifty" + "Long" + "Long Long Long Long" + )) + +(defconst w/pronunciation-part2 ;; the Colon + '("Colon" + "Cologne" + "Collin" + "Clon" + "Clown" + "Clone" + "Clun" + "Cuhlun" + "See" + "Cloin" + "Coloin" + )) + +(defconst w/pronunciation-part3 ;; the Q + '("Kuh" + "Queue" + "Kweh" + "Kiu" + "Kiew" + "Coo" + "Kewl" + )) + +(defun w/pronuciation () + "Determine the canonical pronunciation of LCOLONQ." + (if (= 0 (random 10)) + (w/pick-random w/pronunciation-premade) + (let ((part1 (w/pick-random w/pronunciation-part1)) + (part2 (w/pick-random w/pronunciation-part2)) + (part3 (w/pick-random w/pronunciation-part3)) + (skip1 (= 0 (random 5))) + (skip3 (= 0 (random 5))) + (merge (= 0 (random 2)))) + (s-concat + (if skip1 "" (s-concat part1 " ")) + part2 + (if skip3 + "" + (if merge + (s-downcase part3) + (s-concat " " part3))))))) + +(provide 'wasp-pronunciation) +;;; wasp-pronunciation.el ends here |
