Function: shr-color-visible

shr-color-visible is an autoloaded and byte-compiled function defined in shr-color.el.gz.

Signature

(shr-color-visible BG FG &optional FIXED-BACKGROUND)

Documentation

Check that BG and FG colors are visible if they are drawn on each other.

Return (bg fg) if they are. If they are too similar, two new colors are returned instead. If FIXED-BACKGROUND is set, and if the color are not visible, a new background color will not be computed. Only the foreground color will be adapted to be visible on BG.

Source Code

;; Defined in /usr/src/emacs/lisp/net/shr-color.el.gz
(defun shr-color-visible (bg fg &optional fixed-background)
  "Check that BG and FG colors are visible if they are drawn on each other.
Return (bg fg) if they are.  If they are too similar, two new
colors are returned instead.
If FIXED-BACKGROUND is set, and if the color are not visible, a
new background color will not be computed.  Only the foreground
color will be adapted to be visible on BG."
  ;; Convert fg and bg to CIE Lab
  (let ((fg-norm (color-name-to-rgb fg))
	(bg-norm (color-name-to-rgb bg)))
    (if (or (null fg-norm)
	    (null bg-norm))
	(list bg fg)
      (let* ((fg-lab (apply #'color-srgb-to-lab fg-norm))
	     (bg-lab (apply #'color-srgb-to-lab bg-norm))
	     ;; Compute color distance using CIE DE 2000
	     (fg-bg-distance (color-cie-de2000 fg-lab bg-lab))
	     ;; Compute luminance distance (subtract L component)
	     (luminance-distance (abs (- (car fg-lab) (car bg-lab)))))
	(if (and (>= fg-bg-distance shr-color-visible-distance-min)
		 (>= luminance-distance shr-color-visible-luminance-min))
	    (list bg fg)
	  ;; Not visible, try to change luminance to make them visible
	  (let ((Ls (shr-color-set-minimum-interval
		     (car bg-lab) (car fg-lab) 0 100
		     shr-color-visible-luminance-min fixed-background)))
	    (unless fixed-background
	      (setcar bg-lab (car Ls)))
	    (setcar fg-lab (cadr Ls))
	    (list
	     (if fixed-background
		 bg
	       (apply #'format "#%02x%02x%02x"
		      (mapcar (lambda (x) (* (max (min 1 x) 0) 255))
			      (apply #'color-lab-to-srgb bg-lab))))
	     (apply #'format "#%02x%02x%02x"
		    (mapcar (lambda (x) (* (max (min 1 x) 0) 255))
			    (apply #'color-lab-to-srgb fg-lab))))))))))