1 ;;; shr-color.el --- Simple HTML Renderer color management
3 ;; Copyright (C) 2010 Free Software Foundation, Inc.
5 ;; Author: Julien Danjou <julien@danjou.info>
8 ;; This file is part of GNU Emacs.
10 ;; GNU Emacs is free software: you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation, either version 3 of the License, or
13 ;; (at your option) any later version.
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
25 ;; This package handles colors display for shr.
31 (defgroup shr-color nil
32 "Simple HTML Renderer colors"
35 (defcustom shr-color-visible-luminance-min 40
36 "Minimum luminance distance between two colors to be considered visible.
37 Must be between 0 and 100."
41 (defcustom shr-color-visible-distance-min 5
42 "Minimum color distance between two colors to be considered visible.
43 This value is used to compare result for `ciede2000'. Its an
44 absolute value without any unit."
48 (defun set-minimum-interval (val1 val2 min max interval &optional fixed)
49 "Set minimum interval between VAL1 and VAL2 to INTERVAL.
50 The values are bound by MIN and MAX.
51 If FIXED is t, then val1 will not be touched."
52 (let ((diff (abs (- val1 val2))))
53 (unless (>= diff interval)
55 (let* ((missing (- interval diff))
56 ;; If val2 > val1, try to increase val2
57 ;; That's the "good direction"
60 (min max (+ val2 missing))
61 (max min (- val2 missing))))
62 (diff-val2-good-direction-val1 (abs (- val2-good-direction val1))))
63 (if (>= diff-val2-good-direction-val1 interval)
64 (setq val2 val2-good-direction)
65 ;; Good-direction is not so good, compute bad-direction
66 (let* ((val2-bad-direction
68 (max min (- val1 interval))
69 (min max (+ val1 interval))))
70 (diff-val2-bad-direction-val1 (abs (- val2-bad-direction val1))))
71 (if (>= diff-val2-bad-direction-val1 interval)
72 (setq val2 val2-bad-direction)
73 ;; Still not good, pick the best and prefer good direction
75 (if (>= diff-val2-good-direction-val1 diff-val2-bad-direction-val1)
77 val2-bad-direction))))))
78 ;; No fixed, move val1 and val2
79 (let ((missing (/ (- interval diff) 2.0)))
81 (setq val1 (max min (- val1 missing))
82 val2 (min max (+ val2 missing)))
83 (setq val2 (max min (- val2 missing))
84 val1 (min max (+ val1 missing))))
85 (setq diff (abs (- val1 val2))) ; Recompute diff
86 (unless (>= diff interval)
87 ;; Not ok, we hit a boundary
88 (let ((missing (- interval diff)))
90 (setq val2 (+ val2 missing)))
92 (setq val1 (+ val1 missing)))
94 (setq val2 (- val2 missing)))
96 (setq val1 (- val1 missing)))))))))
99 (defun shr-color-visible (bg fg &optional fixed-background)
100 "Check that BG and FG colors are visible if they are drawn on each other.
101 Return t if they are. If they are too similar, two new colors are
103 If FIXED-BACKGROUND is set, and if the color are not visible, a
104 new background color will not be computed. Only the foreground
105 color will be adapted to be visible on BG."
106 ;; Convert fg and bg to CIE Lab
107 (let* ((fg-lab (apply 'rgb->lab (rgb->normalize fg)))
108 (bg-lab (apply 'rgb->lab (rgb->normalize bg)))
109 ;; Compute color distance using CIE DE 2000
110 (fg-bg-distance (color-lab-ciede2000 fg-lab bg-lab))
111 ;; Compute luminance distance (substract L component)
112 (luminance-distance (abs (- (car fg-lab) (car bg-lab)))))
113 (if (and (>= fg-bg-distance shr-color-visible-distance-min)
114 (>= luminance-distance shr-color-visible-luminance-min))
116 ;; Not visible, try to change luminance to make them visible
117 (let ((Ls (set-minimum-interval (car bg-lab) (car fg-lab) 0 100
118 shr-color-visible-luminance-min
120 (setcar bg-lab (car Ls))
121 (setcar fg-lab (cadr Ls))
123 (apply 'format "#%02x%02x%02x"
124 (mapcar (lambda (x) (* (max (min 1 x) 0) 255)) (apply 'lab->rgb bg-lab)))
125 (apply 'format "#%02x%02x%02x"
126 (mapcar (lambda (x) (* (max (min 1 x) 0) 255)) (apply 'lab->rgb fg-lab))))))))
130 ;;; shr-color.el ends here