From 782c667e824d426b5443591afeefc37d0ae17785 Mon Sep 17 00:00:00 2001 From: LLLL Colonq Date: Tue, 26 Mar 2024 23:34:28 -0400 Subject: We streamed for 9 hours and (mostly) fixed everything. --- src/wasp-chat.el | 258 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 258 insertions(+) create mode 100644 src/wasp-chat.el (limited to 'src/wasp-chat.el') diff --git a/src/wasp-chat.el b/src/wasp-chat.el new file mode 100644 index 00000000..e21664d5 --- /dev/null +++ b/src/wasp-chat.el @@ -0,0 +1,258 @@ +;;; wasp-chat --- Chat display -*- lexical-binding: t; -*- +;;; Commentary: +;;; Code: + +(require 'dash) +(require 's) +(require 'evil) +(require 'wasp-utils) + +(defcustom w/chat-buffer "*wasp-chat*" + "Name of buffer used to store the chat log." + :type '(string) + :group 'wasp) + +(defvar w/chat-header-line "") + +(define-derived-mode w/chat-overlay-mode special-mode "ClonkHead Stats" + "Major mode for displaying chatter statistics." + :group 'wasp + (setq mode-line-format nil)) + +(defun w/get-chat-overlay-buffer (user) + "Return the stats buffer for USER." + (let ((name (format "*wasp-chatter %s*" user))) + (unless (get-buffer name) + (with-current-buffer (get-buffer-create name) + (w/chat-overlay-mode))) + (get-buffer name))) + +(defface w/chat-overlay-title + '((t + :foreground "white" + :height 300 + )) + "Face for title." + :group 'wasp) + +(defface w/chat-overlay-category + '((t + :foreground "green" + )) + "Face for title." + :group 'wasp) + +(defconst w/chat-overlay-element-display-info + '(("fire" "🔥" "red") + ("water" "🌊" "blue") + ("wind" "🍃️" "green") + ("earth" "🪨" "brown") + ("lightning" "⚡" "yellow") + ("heart" "🩷" "pink") + )) +(defun w/chat-overlay-display-element (e) + "Return a propertized string representing E." + (if-let ((dinfo (alist-get e w/chat-overlay-element-display-info nil nil #'s-equals?))) + (propertize + (format "%s %s" (car dinfo) e) + 'face (list :foreground (cadr dinfo))) + "O.O unknown?")) + +(defun w/chat-overlay-render (user) + "Render the stats buffer for USER." + (with-current-buffer (w/get-chat-overlay-buffer user) + (let* ((inhibit-read-only t)) + (erase-buffer) + (w/write-line user 'w/chat-overlay-title) + (w/write-line "N/A") + (goto-char (point-min))))) + +(defvar w/chat-overlay-frame nil) +(defvar w/chat-overlay-cur nil) +(defun w/create-chat-overlay-frame () + "Build a frame for displaying chatter stats on mouseover." + (when (framep w/chat-overlay-frame) + (delete-frame w/chat-overlay-frame)) + (setf + w/chat-overlay-frame + (make-frame + (append + `((name . "clonkhead-io") + (wasp-prevent-focus . t) + (unsplittable . t) + (undecorated . t) + (no-accept-focus . t) + (no-focus-on-map . t) + (override-redirect . t) + (user-size . t) + (width . 30) + (height . 15) + (user-position . t) + (left . -1) + (top . -1) + (default-minibuffer-frame . ,(selected-frame)) + (minibuffer . nil) + (left-fringe . 0) + (right-fringe . 0) + (cursor-type . nil) + (background-color . "black")))))) + +(defun w/show-chat-overlay-frame (vis) + "If VIS is non-nil, make the chat overlay frame visible. +Otherwise make it invisible." + (if vis + (make-frame-visible w/chat-overlay-frame) + (setq w/chat-overlay-cur nil) + (make-frame-invisible w/chat-overlay-frame))) +(defun w/move-chat-overlay-frame (x y) + "Move the chat overlay frame to X, Y." + (modify-frame-parameters + w/chat-overlay-frame + (list + (cons 'top y) + (cons 'left x)))) +(defun w/display-chat-overlay (user &optional x y) + "Display the chat overlay buffer for USER. +Optionally display the window at X, Y" + (unless w/chat-overlay-frame + (w/create-chat-overlay-frame)) + (let ((window (frame-selected-window w/chat-overlay-frame))) + (if (and x y) + (w/move-chat-overlay-frame x y) + (w/move-chat-overlay-frame -1 -1)) + (w/chat-overlay-render user) + (setq w/chat-overlay-cur user) + (set-window-buffer window (w/get-chat-overlay-buffer user)) + (w/show-chat-overlay-frame t))) +(defun w/update-chat-overlay (user pos) + "Update the chat overlay frame for USER based on POS." + (if (and user pos) + (progn + (unless (equal (cons user pos) w/chat-overlay-cur) + (w/display-chat-overlay user (car pos) (cdr pos))) + ) + (w/show-chat-overlay-frame nil))) +(defun w/handle-chat-overlay () + "Handle point movement for chat overlay popup." + (with-current-buffer (w/get-chat-buffer) + (w/update-chat-overlay + (get-text-property (point) 'wasp-user) + (window-absolute-pixel-position (point))))) + +(define-derived-mode w/chat-mode special-mode "Chat" + "Major mode for displaying chat." + :group 'wasp + (add-hook 'post-command-hook #'w/handle-chat-overlay nil t) + (advice-add 'handle-switch-frame :before-while #'w/prevent-focus-frame) + (setq-local window-point-insertion-type t) + (cond + (t (setq-local header-line-format '(:eval w/chat-header-line))))) + +(defun w/get-chat-buffer (&optional nm) + "Return the chat buffer. +Optionally, return the buffer NM in chat mode." + (let ((bufnm (or nm w/chat-buffer))) + (unless (get-buffer bufnm) + (with-current-buffer (get-buffer-create bufnm) + (w/chat-mode))) + (get-buffer bufnm))) + +(defun w/clear-chat () + "Clear the chat buffer." + (interactive) + (with-current-buffer (w/get-chat-buffer) + (let ((inhibit-read-only t)) + (erase-buffer)))) + +(defvar-keymap w/chat-mode-map + :suppress t + "C-l" #'w/clear-chat) +(evil-define-key 'motion w/chat-mode-map (kbd "") #'w/open-link) + +(defun w/write-chat-event (ev) + "Write the string EV to the chat buffer as an event (italicized)." + (let ((inhibit-read-only t)) + (with-current-buffer (w/get-chat-buffer) + (goto-char (point-max)) + (insert (propertize ev 'face 'italic)) + (insert "\n")))) + +(w/defstruct + w/chat-message + user + id + text + user-color + sigil + faction + biblicality) + +(defun w/chat-button-action (b) + "Action run on button press for button B." + (let ((user (get-text-property (button-start b) 'wasp-user))) + (message user))) + +(defconst w/chat-substitution-godot-logo + (w/image-text (w/asset "misc/godot.png"))) +(defconst w/chat-substitution-powershell-logo + (w/image-text (w/asset "misc/powershell_small.png"))) +(defconst w/chat-substitutions + `(("[i](this was sent from godot)[/i]" . ,w/chat-substitution-godot-logo) + ("bald" . "ball") + ("pokemon" . "pal") + ("Pokemon" . "Pal") + ("POKEMON" . "PAL") + ("pal" . "pokemon") + ("Pal" . "Pokemon") + ("PAL" . "POKEMON") + ("hunter2" . "*******") + ("*******" . "hunter2"))) + +(defun w/write-chat-message (msg) + "Write MSG to the chat buffer as USER with USERID and COLOR." + (let ((inhibit-read-only t)) + (with-current-buffer (w/get-chat-buffer) + (goto-char (point-max)) + (insert-text-button + (s-concat + (if (w/. sigil msg) (s-concat (w/. sigil msg) " ") "") + (w/. user msg)) + 'face (list :foreground (or (w/. user-color msg) "#ffffff") :weight 'bold) + 'wasp-user (w/. user msg) + 'wasp-user-id (w/. id msg) + 'action #'w/chat-button-action) + (insert + (propertize + ": " + 'face + (list + :foreground + (cl-case (w/. faction msg) + (nate "pink") + (lever "lightblue") + (tony "lightgreen") + (t "white")) + ) + )) + (insert (s-replace-all w/chat-substitutions (w/. text msg))) + (when (w/. biblicality msg) + (let* ((wwidth (- (window-total-width (get-buffer-window (current-buffer))) 3)) + (bible-button-text (format "[biblicality %.2f]" (w/. biblicality msg))) + (msgwidth (line-beginning-position)) + (lines (+ 1 (/ msgwidth wwidth)))) + (insert + (propertize + " " 'display + `(space + :align-to + ,(- (+ (* wwidth lines) (- lines 1)) + (length bible-button-text) + )))) + (insert + (propertize + bible-button-text + 'face '(:foreground "#bbbbbb"))))) + (insert "\n")))) + +(provide 'wasp-chat) +;;; wasp-chat.el ends here -- cgit v1.2.3