;;; shr-color.el --- Simple HTML Renderer color management
-;; Copyright (C) 2010 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
;; Author: Julien Danjou <julien@danjou.info>
;; Keywords: html
;;; Code:
(require 'color)
+(eval-when-compile (require 'cl))
(defgroup shr-color nil
"Simple HTML Renderer colors"
(defcustom shr-color-visible-distance-min 5
"Minimum color distance between two colors to be considered visible.
-This value is used to compare result for `ciede2000'. Its an
+This value is used to compare result for `ciede2000'. It's an
absolute value without any unit."
:group 'shr
:type 'integer)
Each entry should have the form (COLOR-NAME . HEXADECIMAL-COLOR).")
(defun shr-color-relative-to-absolute (number)
- "Convert a relative NUMBER to absolute. If NUMBER is absolute, return NUMBER.
+ "Convert a relative NUMBER to absolute.
+If NUMBER is absolute, return NUMBER.
This will convert \"80 %\" to 204, \"100 %\" to 255 but \"123\" to \"123\"."
(let ((string-length (- (length number) 1)))
;; Is this a number with %?
(l (/ (string-to-number (match-string-no-properties 3 color)) 100.0)))
(destructuring-bind (r g b)
(shr-color-hsl-to-rgb-fractions h s l)
- (format "#%02X%02X%02X" (* r 255) (* g 255) (* b 255)))))
+ (color-rgb-to-hex r g b))))
;; Color names
((cdr (assoc-string color shr-color-html-colors-alist t)))
;; Unrecognized color :(
(t
nil))))
-(defun set-minimum-interval (val1 val2 min max interval &optional fixed)
+(defun shr-color-set-minimum-interval (val1 val2 min max interval
+ &optional fixed)
"Set minimum interval between VAL1 and VAL2 to INTERVAL.
The values are bound by MIN and MAX.
-If FIXED is t, then val1 will not be touched."
+If FIXED is t, then VAL1 will not be touched."
(let ((diff (abs (- val1 val2))))
(unless (>= diff interval)
(if fixed
(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
+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
+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-rgb->normalize fg))
- (bg-norm (color-rgb->normalize bg)))
+ (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-rgb->lab fg-norm))
- (bg-lab (apply 'color-rgb->lab bg-norm))
+ (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 (substract L component)
+ ;; 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 (set-minimum-interval (car bg-lab) (car fg-lab) 0 100
- shr-color-visible-luminance-min
- fixed-background)))
+ (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))
bg
(apply 'format "#%02x%02x%02x"
(mapcar (lambda (x) (* (max (min 1 x) 0) 255))
- (apply 'color-lab->rgb bg-lab))))
+ (apply 'color-lab-to-srgb bg-lab))))
(apply 'format "#%02x%02x%02x"
(mapcar (lambda (x) (* (max (min 1 x) 0) 255))
- (apply 'color-lab->rgb fg-lab))))))))))
+ (apply 'color-lab-to-srgb fg-lab))))))))))
(provide 'shr-color)