We streamed for 9 hours and (mostly) fixed everything.

1 files changed, 258 insertions, 0 deletions

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