Change: (ement-prism-color) Arguments

This change isn't yet visible, but it makes more sense and is more
flexible.  Also, the TODO is a good idea.
This commit is contained in:
Adam Porter 2022-05-30 04:01:12 -05:00
parent 30b5dfdc5a
commit 5b101206ca
2 changed files with 11 additions and 8 deletions

View file

@ -3263,11 +3263,13 @@ ROOM defaults to the value of `ement-room'."
(color-name-to-rgb (face-foreground 'default)))))
(apply #'color-rgb-to-hex (append color-rgb (list 2))))))
(defun ement-prism-color (string)
(cl-defun ement-prism-color (string &key (contrast-with (face-background 'default)))
"Return a computed color for STRING.
Useful for user messages, generated room avatars, etc."
;; TODO: Use this instead of `ement-room--user-color'. (Same algorithm ,just takes a
;; string as argument.)
;; TODO: Try using HSV somehow so we could avoid having so many strings return a
;; nearly-black color.
(cl-labels ((relative-luminance
;; Copy of `modus-themes-wcag-formula', an elegant
;; implementation by Protesilaos Stavrou. Also see
@ -3301,10 +3303,10 @@ Useful for user messages, generated room avatars, etc."
(color-rgb (list (/ (float (logand color-num 255)) 255)
(/ (float (lsh (logand color-num 65280) -8)) 255)
(/ (float (lsh (logand color-num 16711680) -16)) 255)))
(background-rgb (color-name-to-rgb (face-background 'default))))
(when (< (contrast-ratio color-rgb background-rgb) ement-room-prism-minimum-contrast)
(setf color-rgb (increase-contrast color-rgb background-rgb ement-room-prism-minimum-contrast
(color-name-to-rgb (face-foreground 'default)))))
(contrast-with-rgb (color-name-to-rgb contrast-with)))
(when (< (contrast-ratio color-rgb contrast-with-rgb) ement-room-prism-minimum-contrast)
(setf color-rgb (increase-contrast color-rgb contrast-with-rgb ement-room-prism-minimum-contrast
contrast-with-rgb)))
(apply #'color-rgb-to-hex (append color-rgb (list 2))))))
;;;;; Compose buffer

View file

@ -249,9 +249,10 @@
nil (frame-char-height)))
;; Room has no avatar: make one.
(let* ((string (or display-name (ement--room-display-name room)))
(_ (when (string-match (rx bos (or "#" "!" "@")) string)
(setf string (substring string 1))))
(color (ement-prism-color string)))
(ement-room-prism-minimum-contrast 1)
(color (ement-prism-color string :contrast-with "white")))
(when (string-match (rx bos (or "#" "!" "@")) string)
(setf string (substring string 1)))
(propertize " " 'display (svg-lib-tag (substring string 0 1) nil
:background color :foreground "white"
:stroke 0))))))