(defconst colour-triplet-regex
"\\([0-9A-Fa-f]{2}\\)\\([0-9A-Fa-f]{2}\\)\\([0-9A-Fa-f]{2}\\)")
(defun parse-colour (colour)
(cond ((and (stringp colour) (string-match colour-triplet-regex colour))
(mapcar
(lambda (x)
(* (string-to-int (match-string x colour) 16) 257)) '(1 2 3)))
((stringp colour)
(if (fboundp 'color-values)
(color-values colour)
(x-color-values colour)))
((consp colour) colour)
(t (error "colour (%S) is not a colour name, #xxxxxx or list"))) )
(defun colour-distance (colour-a colour-b &optional frame)
"Return an integer distance between COLOR1 and COLOR2 on FRAME.
COLOR1 and COLOR2 may be either strings containing the color name,
or lists of the form (RED GREEN BLUE).
If FRAME is unspecified or nil, the current frame is used."
(if frame nil (setq frame (selected-frame)))
(setq colour-a (parse-colour colour-a)
colour-b (parse-colour colour-b)
;; now work out the various bit-shift values
r (lsh (- (car colour-a) (car colour-b)) -8)
g (lsh (- (cadr colour-a) (cadr colour-b)) -8)
b (lsh (- (caddr colour-a) (caddr colour-b)) -8)
rmu (lsh (+ (car colour-a) (car colour-b)) -9))
;; and now the magic formula-fu
(+ (lsh (* (+ 512 rmu) r r) -8) (* 4 g g) (lsh (* (- 767 rmu) b b) -8)) )
(defconst colour-triplet-regex
"\\([0-9A-Fa-f]{2}\\)\\([0-9A-Fa-f]{2}\\)\\([0-9A-Fa-f]{2}\\)")
(defun parse-colour (colour frame)
(cond ((and (stringp colour) (string-match colour-triplet-regex colour))
(mapcar
(lambda (x)
(* (string-to-int (match-string x colour) 16) 257)) '(1 2 3)))
((stringp colour)
(if (fboundp 'color-values)
(color-values colour frame)
(x-color-values colour frame)))
((consp colour) colour)
(t (error "colour (%S) is not a colour name, #xxxxxx or list"))) )
(defun colour-distance (colour-a colour-b &optional frame)
"Return an integer distance between COLOUR-A and COLOUR-B on FRAME.
COLOUR-A and COLOUR-B may be either strings containing the color name,
or lists of the form (RED GREEN BLUE).
If FRAME is unspecified or nil, the current frame is used."
(if frame nil (setq frame (selected-frame)))
(setq colour-a (parse-colour colour-a frame)
colour-b (parse-colour colour-b frame)
;; now work out the various bit-shift values
r (lsh (- (car colour-a) (car colour-b)) -8)
g (lsh (- (cadr colour-a) (cadr colour-b)) -8)
b (lsh (- (caddr colour-a) (caddr colour-b)) -8)
rmu (lsh (+ (car colour-a) (car colour-b)) -9))
;; and now the magic formula-fu
(+ (lsh (* (+ 512 rmu) r r) -8) (* 4 g g) (lsh (* (- 767 rmu) b b) -8)) )(defun colour-distance (colour-a colour-b &optional frame)
"Return an integer distance between COLOUR-A and COLOUR-B on FRAME.
COLOUR-A and COLOUR-B may be either strings containing the color name,
or lists of the form (RED GREEN BLUE).
If FRAME is unspecified or nil, the current frame is used."
(if frame nil (setq frame (selected-frame)))
(let* ((colour-a (parse-colour colour-a frame))
(colour-b (parse-colour colour-b frame))
;; now work out the various bit-shift values
(r (lsh (- (car colour-a) (car colour-b)) -8))
(g (lsh (- (cadr colour-a) (cadr colour-b)) -8))
(b (lsh (- (caddr colour-a) (caddr colour-b)) -8))
(rmu (lsh (+ (car colour-a) (car colour-b)) -9)))
;; and now the magic formula-fu
(+ (lsh (* (+ 512 rmu) r r) -8) (* 4 g g) (lsh (* (- 767 rmu) b b) -8)) ))