path: root/src/wasp-chat.el

;;; wasp-chat --- Chat display -*- lexical-binding: t; -*-
;;; Commentary:
;;; Code:

(require 'dash)
(require 's)
(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."
  :type '(string)
  :group 'wasp)

(defcustom w/chat-event-buffer "*wasp-chat-events*"
  "Name of buffer used to store the chat event log."
  :type '(string)
  :group 'wasp)

(defvar w/chat-joel-count 0)
(defvar w/chat-plus2-count 0)
(defvar w/chat-minus2-count 0)
(defvar w/chat-icant-count 0)
(defvar w/chat-bpm-count 0)
(defvar w/chat-apology-count 0)
(defvar w/chat-john-count 0)
(defvar w/chat-ostensibly-count 0)

(defvar w/chat-header-line "")

(defun w/chat-update-header-line ()
  "Update `w/chat-header-line'."
  (setf
   w/chat-header-line
   (s-concat
    "  Joel: " (format "%s" w/chat-joel-count)
    " | ICANT: " (format "%s" w/chat-icant-count)
    " | +2: " (format "%s" w/chat-plus2-count)
    " | -2: " (format "%s" w/chat-minus2-count)
    " | apology: " (format "%s" w/chat-apology-count)
    " | John Counter: " (format "%s" w/chat-john-count)
    " | ostensibly,: " (format "%s" w/chat-ostensibly-count)
    )))

(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/chat-get-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)

(defun w/chat-overlay-display-element (e)
  "Return a propertized string representing E."
  (if-let* ((dinfo (alist-get e w/user-elements 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."
  (w/user-get
   user
   (lambda (db)
     (with-current-buffer (w/chat-get-overlay-buffer user)
       (let* ((inhibit-read-only t)
              (faction (alist-get :faction db))
              (element (alist-get :element db))
              (boosts (alist-get :boost db)))
         (erase-buffer)
         (w/write-line user 'w/chat-overlay-title)
         (w/write
          (format
           "Faction: %s"
           (propertize
            (format "%s" (or faction "EXEMPT"))
            'face
            (list
             :foreground
             (cl-case faction
               (nate "pink")
               (lever "lightblue")
               (tony "lightgreen")
               (t "white"))))))
         (w/write-line
          (cond
           ((not boosts) " (objector)")
           ((> boosts 0) (format " (boost %s)" boosts))
           (t (format " (%s tsoob)" boosts))))
         (w/write-line
          (format
           "Element: %s"
           (w/chat-overlay-display-element element)))
         (goto-char (point-min)))))))

(defvar w/chat-overlay-frame nil)
(defvar w/chat-overlay-cur nil)
(defun w/chat-create-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/chat-show-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/chat-move-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/chat-display-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/chat-create-overlay-frame))
  (let ((window (frame-selected-window w/chat-overlay-frame)))
    (if (and x y)
        (w/chat-move-overlay-frame x y)
      (w/chat-move-overlay-frame -1 -1))
    (w/chat-overlay-render user)
    (setq w/chat-overlay-cur user)
    (set-window-buffer window (w/chat-get-overlay-buffer user))
    (w/chat-show-overlay-frame t)))
(defun w/chat-update-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/chat-display-overlay user (car pos) (cdr pos)))
        )
    (w/chat-show-overlay-frame nil)))
(defun w/chat-handle-overlay ()
  "Handle point movement for chat overlay popup."
  (with-current-buffer (w/chat-get-buffer)
    (w/chat-update-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/chat-handle-overlay nil t)
  (advice-add 'handle-switch-frame :before-while #'w/prevent-focus-frame)
  (setq-local window-point-insertion-type t)
  (setq-local cursor-type nil)
  (cond
   (t (setq-local header-line-format '(:eval w/chat-header-line)))))

(defun w/chat-get-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)))

(define-derived-mode w/chat-event-mode special-mode "Chat Events"
  "Major mode for displaying chat."
  :group 'wasp)

(defun w/chat-get-event-buffer ()
  "Return the chat event buffer."
  (let ((bufnm w/chat-event-buffer))
    (unless (get-buffer bufnm)
      (with-current-buffer (get-buffer-create bufnm)
        (w/chat-event-mode)))
    (get-buffer bufnm)))

(defun w/chat-clear ()
  "Clear the chat buffer."
  (interactive)
  (with-current-buffer (w/chat-get-buffer)
    (let ((inhibit-read-only t))
      (erase-buffer))))

(defvar-keymap w/chat-mode-map
  :suppress t
  "C-l" #'w/chat-clear)
(evil-define-key 'motion w/chat-mode-map (kbd "<return>") #'w/open-link)

(defun w/chat-write-event (ev)
  "Write the string EV to the chat buffer as an event (italicized)."
  (let ((inhibit-read-only t))
    (with-current-buffer (w/chat-get-buffer)
      (goto-char (point-max))
      (insert (propertize ev 'face 'italic))
      (insert "\n"))
    (with-current-buffer (w/chat-get-event-buffer)
      (goto-char (point-max))
      (insert (propertize ev 'face 'italic))
      (insert "\n"))
    (w/gizmo-upload (w/chat-get-event-buffer))))

(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")
    ("Amazon" . "Microsoft")
    ("Microsoft" . "Google")
    ("Google" . "Facebook")
    ("Facebook" . "Apple")
    ("Apple" . "Amazon")
    ("darkrai" . "*******")
    ("hunter2" . "*******")
    ("*******" . "hunter2")))

(defun w/chat-write-message (msg &optional buf)
  "Write MSG to BUF as USER with USERID and COLOR."
  (w/daily-log (format "%s: %s" (w/. user msg) (w/. text msg)))
  (let ((inhibit-read-only t))
    (with-current-buffer (w/chat-get-buffer buf)
      (setq-local cursor-type nil)
      (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)))
      (insert " ")
      (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 "[medicality %.2f]" (w/. biblicality msg)))
               ;; (bible-button-text (format "[pollicality %.2f]" (w/. biblicality msg)))
               (msgwidth (- (point) (line-beginning-position)))
               (lines (+ 1 (/ msgwidth wwidth))))
          (w/overlay-chat msg)
          (insert
           (propertize
            " " 'display
            `(space
              :align-to
              ,(- (+ (* wwidth lines) (- lines 1))
                  (length bible-button-text)
                  ))))
          (insert
           (propertize
            bible-button-text
           'face '(:foreground "#bbbbbb")))))
      (insert "\n"))
    (when-let* ((win (get-buffer-window (w/chat-get-buffer))))
      (with-selected-window win
        (goto-char (point-max))))))

(provide 'wasp-chat)
;;; wasp-chat.el ends here