| 1 | ;;; color.el --- Color manipulation library -*- coding: utf-8; lexical-binding:t -*- |
| 2 | |
| 3 | ;; Copyright (C) 2010-2014 Free Software Foundation, Inc. |
| 4 | |
| 5 | ;; Authors: Julien Danjou <julien@danjou.info> |
| 6 | ;; Drew Adams <drew.adams@oracle.com> |
| 7 | ;; Keywords: lisp, faces, color, hex, rgb, hsv, hsl, cie-lab, background |
| 8 | |
| 9 | ;; This file is part of GNU Emacs. |
| 10 | |
| 11 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
| 12 | ;; it under the terms of the GNU General Public License as published by |
| 13 | ;; the Free Software Foundation, either version 3 of the License, or |
| 14 | ;; (at your option) any later version. |
| 15 | |
| 16 | ;; GNU Emacs is distributed in the hope that it will be useful, |
| 17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 19 | ;; GNU General Public License for more details. |
| 20 | |
| 21 | ;; You should have received a copy of the GNU General Public License |
| 22 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
| 23 | |
| 24 | ;;; Commentary: |
| 25 | |
| 26 | ;; This package provides functions for manipulating colors, including |
| 27 | ;; converting between color representations, computing color |
| 28 | ;; complements, and computing CIEDE2000 color distances. |
| 29 | ;; |
| 30 | ;; Supported color representations include RGB (red, green, blue), HSV |
| 31 | ;; (hue, saturation, value), HSL (hue, saturation, luminance), sRGB, |
| 32 | ;; CIE XYZ, and CIE L*a*b* color components. |
| 33 | |
| 34 | ;;; Code: |
| 35 | |
| 36 | ;; Emacs < 23.3 |
| 37 | (eval-and-compile |
| 38 | (unless (boundp 'float-pi) |
| 39 | (defconst float-pi (* 4 (atan 1)) "The value of Pi (3.1415926...)."))) |
| 40 | |
| 41 | ;;;###autoload |
| 42 | (defun color-name-to-rgb (color &optional frame) |
| 43 | "Convert COLOR string to a list of normalized RGB components. |
| 44 | COLOR should be a color name (e.g. \"white\") or an RGB triplet |
| 45 | string (e.g. \"#ff12ec\"). |
| 46 | |
| 47 | Normally the return value is a list of three floating-point |
| 48 | numbers, (RED GREEN BLUE), each between 0.0 and 1.0 inclusive. |
| 49 | |
| 50 | Optional argument FRAME specifies the frame where the color is to be |
| 51 | displayed. If FRAME is omitted or nil, use the selected frame. |
| 52 | If FRAME cannot display COLOR, return nil." |
| 53 | ;; `colors-values' maximum value is either 65535 or 65280 depending on the |
| 54 | ;; display system. So we use a white conversion to get the max value. |
| 55 | (let ((valmax (float (car (color-values "#ffffff"))))) |
| 56 | (mapcar (lambda (x) (/ x valmax)) (color-values color frame)))) |
| 57 | |
| 58 | (defun color-rgb-to-hex (red green blue) |
| 59 | "Return hexadecimal notation for the color RED GREEN BLUE. |
| 60 | RED, GREEN, and BLUE should be numbers between 0.0 and 1.0, inclusive." |
| 61 | (format "#%02x%02x%02x" |
| 62 | (* red 255) (* green 255) (* blue 255))) |
| 63 | |
| 64 | (defun color-complement (color-name) |
| 65 | "Return the color that is the complement of COLOR-NAME. |
| 66 | COLOR-NAME should be a string naming a color (e.g. \"white\"), or |
| 67 | a string specifying a color's RGB components (e.g. \"#ff12ec\")." |
| 68 | (let ((color (color-name-to-rgb color-name))) |
| 69 | (list (- 1.0 (nth 0 color)) |
| 70 | (- 1.0 (nth 1 color)) |
| 71 | (- 1.0 (nth 2 color))))) |
| 72 | |
| 73 | (defun color-gradient (start stop step-number) |
| 74 | "Return a list with STEP-NUMBER colors from START to STOP. |
| 75 | The color list builds a color gradient starting at color START to |
| 76 | color STOP. It does not include the START and STOP color in the |
| 77 | resulting list." |
| 78 | (let* ((r (nth 0 start)) |
| 79 | (g (nth 1 start)) |
| 80 | (b (nth 2 start)) |
| 81 | (r-step (/ (- (nth 0 stop) r) (1+ step-number))) |
| 82 | (g-step (/ (- (nth 1 stop) g) (1+ step-number))) |
| 83 | (b-step (/ (- (nth 2 stop) b) (1+ step-number))) |
| 84 | result) |
| 85 | (dotimes (_ step-number) |
| 86 | (push (list (setq r (+ r r-step)) |
| 87 | (setq g (+ g g-step)) |
| 88 | (setq b (+ b b-step))) |
| 89 | result)) |
| 90 | (nreverse result))) |
| 91 | |
| 92 | (defun color-hue-to-rgb (v1 v2 h) |
| 93 | "Compute hue from V1 and V2 H. |
| 94 | Used internally by `color-hsl-to-rgb'." |
| 95 | (cond |
| 96 | ((< h (/ 1.0 6)) (+ v1 (* (- v2 v1) h 6.0))) |
| 97 | ((< h 0.5) v2) |
| 98 | ((< h (/ 2.0 3)) (+ v1 (* (- v2 v1) (- (/ 2.0 3) h) 6.0))) |
| 99 | (t v1))) |
| 100 | |
| 101 | (defun color-hsl-to-rgb (H S L) |
| 102 | "Convert hue, saturation and luminance to their RGB representation. |
| 103 | H, S, and L should each be numbers between 0.0 and 1.0, inclusive. |
| 104 | Return a list (RED GREEN BLUE), where each element is between 0.0 and 1.0, |
| 105 | inclusive." |
| 106 | (if (= S 0.0) |
| 107 | (list L L L) |
| 108 | (let* ((m2 (if (<= L 0.5) |
| 109 | (* L (+ 1.0 S)) |
| 110 | (- (+ L S) (* L S)))) |
| 111 | (m1 (- (* 2.0 L) m2))) |
| 112 | (list |
| 113 | (color-hue-to-rgb m1 m2 (mod (+ H (/ 1.0 3)) 1)) |
| 114 | (color-hue-to-rgb m1 m2 H) |
| 115 | (color-hue-to-rgb m1 m2 (mod (- H (/ 1.0 3)) 1)))))) |
| 116 | |
| 117 | (defun color-complement-hex (color) |
| 118 | "Return the color that is the complement of COLOR, in hexadecimal format." |
| 119 | (apply 'color-rgb-to-hex (color-complement color))) |
| 120 | |
| 121 | (defun color-rgb-to-hsv (red green blue) |
| 122 | "Convert RGB color components to HSV. |
| 123 | RED, GREEN, and BLUE should each be numbers between 0.0 and 1.0, |
| 124 | inclusive. Return a list (HUE SATURATION VALUE), where HUE is |
| 125 | in radians and both SATURATION and VALUE are between 0.0 and 1.0, |
| 126 | inclusive." |
| 127 | (let* ((r (float red)) |
| 128 | (g (float green)) |
| 129 | (b (float blue)) |
| 130 | (max (max r g b)) |
| 131 | (min (min r g b))) |
| 132 | (if (< (- max min) 1e-8) |
| 133 | (list 0.0 0.0 min) |
| 134 | (list |
| 135 | (/ (* 2 float-pi |
| 136 | (cond ((and (= r g) (= g b)) 0) |
| 137 | ((and (= r max) |
| 138 | (>= g b)) |
| 139 | (* 60 (/ (- g b) (- max min)))) |
| 140 | ((and (= r max) |
| 141 | (< g b)) |
| 142 | (+ 360 (* 60 (/ (- g b) (- max min))))) |
| 143 | ((= max g) |
| 144 | (+ 120 (* 60 (/ (- b r) (- max min))))) |
| 145 | ((= max b) |
| 146 | (+ 240 (* 60 (/ (- r g) (- max min))))))) |
| 147 | 360) |
| 148 | (if (= max 0) 0 (- 1 (/ min max))) |
| 149 | max)))) |
| 150 | |
| 151 | (defun color-rgb-to-hsl (red green blue) |
| 152 | "Convert RGB colors to their HSL representation. |
| 153 | RED, GREEN, and BLUE should each be numbers between 0.0 and 1.0, |
| 154 | inclusive. Return a list (HUE SATURATION LUMINANCE), where |
| 155 | each element is between 0.0 and 1.0, inclusive." |
| 156 | (let* ((r red) |
| 157 | (g green) |
| 158 | (b blue) |
| 159 | (max (max r g b)) |
| 160 | (min (min r g b)) |
| 161 | (delta (- max min)) |
| 162 | (l (/ (+ max min) 2.0))) |
| 163 | (if (= delta 0) |
| 164 | (list 0.0 0.0 l) |
| 165 | (let* ((s (if (<= l 0.5) (/ delta (+ max min)) |
| 166 | (/ delta (- 2.0 max min)))) |
| 167 | (rc (/ (- max r) delta)) |
| 168 | (gc (/ (- max g) delta)) |
| 169 | (bc (/ (- max b) delta)) |
| 170 | (h (mod |
| 171 | (/ |
| 172 | (cond |
| 173 | ((= r max) (- bc gc)) |
| 174 | ((= g max) (+ 2.0 rc (- bc))) |
| 175 | (t (+ 4.0 gc (- rc)))) |
| 176 | 6.0) 1.0))) |
| 177 | (list h s l))))) |
| 178 | |
| 179 | (defun color-srgb-to-xyz (red green blue) |
| 180 | "Convert RED GREEN BLUE colors from the sRGB color space to CIE XYZ. |
| 181 | RED, GREEN and BLUE should be between 0.0 and 1.0, inclusive." |
| 182 | (let ((r (if (<= red 0.04045) |
| 183 | (/ red 12.95) |
| 184 | (expt (/ (+ red 0.055) 1.055) 2.4))) |
| 185 | (g (if (<= green 0.04045) |
| 186 | (/ green 12.95) |
| 187 | (expt (/ (+ green 0.055) 1.055) 2.4))) |
| 188 | (b (if (<= blue 0.04045) |
| 189 | (/ blue 12.95) |
| 190 | (expt (/ (+ blue 0.055) 1.055) 2.4)))) |
| 191 | (list (+ (* 0.4124564 r) (* 0.3575761 g) (* 0.1804375 b)) |
| 192 | (+ (* 0.21266729 r) (* 0.7151522 g) (* 0.0721750 b)) |
| 193 | (+ (* 0.0193339 r) (* 0.1191920 g) (* 0.9503041 b))))) |
| 194 | |
| 195 | (defun color-xyz-to-srgb (X Y Z) |
| 196 | "Convert CIE X Y Z colors to sRGB color space." |
| 197 | (let ((r (+ (* 3.2404542 X) (* -1.5371385 Y) (* -0.4985314 Z))) |
| 198 | (g (+ (* -0.9692660 X) (* 1.8760108 Y) (* 0.0415560 Z))) |
| 199 | (b (+ (* 0.0556434 X) (* -0.2040259 Y) (* 1.0572252 Z)))) |
| 200 | (list (if (<= r 0.0031308) |
| 201 | (* 12.92 r) |
| 202 | (- (* 1.055 (expt r (/ 1 2.4))) 0.055)) |
| 203 | (if (<= g 0.0031308) |
| 204 | (* 12.92 g) |
| 205 | (- (* 1.055 (expt g (/ 1 2.4))) 0.055)) |
| 206 | (if (<= b 0.0031308) |
| 207 | (* 12.92 b) |
| 208 | (- (* 1.055 (expt b (/ 1 2.4))) 0.055))))) |
| 209 | |
| 210 | (defconst color-d65-xyz '(0.950455 1.0 1.088753) |
| 211 | "D65 white point in CIE XYZ.") |
| 212 | |
| 213 | (defconst color-cie-ε (/ 216 24389.0)) |
| 214 | (defconst color-cie-κ (/ 24389 27.0)) |
| 215 | |
| 216 | (defun color-xyz-to-lab (X Y Z &optional white-point) |
| 217 | "Convert CIE XYZ to CIE L*a*b*. |
| 218 | WHITE-POINT specifies the (X Y Z) white point for the |
| 219 | conversion. If omitted or nil, use `color-d65-xyz'." |
| 220 | (pcase-let* ((`(,Xr ,Yr ,Zr) (or white-point color-d65-xyz)) |
| 221 | (xr (/ X Xr)) |
| 222 | (yr (/ Y Yr)) |
| 223 | (zr (/ Z Zr)) |
| 224 | (fx (if (> xr color-cie-ε) |
| 225 | (expt xr (/ 1 3.0)) |
| 226 | (/ (+ (* color-cie-κ xr) 16) 116.0))) |
| 227 | (fy (if (> yr color-cie-ε) |
| 228 | (expt yr (/ 1 3.0)) |
| 229 | (/ (+ (* color-cie-κ yr) 16) 116.0))) |
| 230 | (fz (if (> zr color-cie-ε) |
| 231 | (expt zr (/ 1 3.0)) |
| 232 | (/ (+ (* color-cie-κ zr) 16) 116.0)))) |
| 233 | (list |
| 234 | (- (* 116 fy) 16) ; L |
| 235 | (* 500 (- fx fy)) ; a |
| 236 | (* 200 (- fy fz))))) ; b |
| 237 | |
| 238 | (defun color-lab-to-xyz (L a b &optional white-point) |
| 239 | "Convert CIE L*a*b* to CIE XYZ. |
| 240 | WHITE-POINT specifies the (X Y Z) white point for the |
| 241 | conversion. If omitted or nil, use `color-d65-xyz'." |
| 242 | (pcase-let* ((`(,Xr ,Yr ,Zr) (or white-point color-d65-xyz)) |
| 243 | (fy (/ (+ L 16) 116.0)) |
| 244 | (fz (- fy (/ b 200.0))) |
| 245 | (fx (+ (/ a 500.0) fy)) |
| 246 | (xr (if (> (expt fx 3.0) color-cie-ε) |
| 247 | (expt fx 3.0) |
| 248 | (/ (- (* fx 116) 16) color-cie-κ))) |
| 249 | (yr (if (> L (* color-cie-κ color-cie-ε)) |
| 250 | (expt (/ (+ L 16) 116.0) 3.0) |
| 251 | (/ L color-cie-κ))) |
| 252 | (zr (if (> (expt fz 3) color-cie-ε) |
| 253 | (expt fz 3.0) |
| 254 | (/ (- (* 116 fz) 16) color-cie-κ)))) |
| 255 | (list (* xr Xr) ; X |
| 256 | (* yr Yr) ; Y |
| 257 | (* zr Zr)))) ; Z |
| 258 | |
| 259 | (defun color-srgb-to-lab (red green blue) |
| 260 | "Convert RGB to CIE L*a*b*." |
| 261 | (apply 'color-xyz-to-lab (color-srgb-to-xyz red green blue))) |
| 262 | |
| 263 | (defun color-lab-to-srgb (L a b) |
| 264 | "Convert CIE L*a*b* to RGB." |
| 265 | (apply 'color-xyz-to-srgb (color-lab-to-xyz L a b))) |
| 266 | |
| 267 | (defun color-cie-de2000 (color1 color2 &optional kL kC kH) |
| 268 | "Return the CIEDE2000 color distance between COLOR1 and COLOR2. |
| 269 | Both COLOR1 and COLOR2 should be in CIE L*a*b* format, as |
| 270 | returned by `color-srgb-to-lab' or `color-xyz-to-lab'." |
| 271 | (pcase-let* |
| 272 | ((`(,L₁ ,a₁ ,b₁) color1) |
| 273 | (`(,L₂ ,a₂ ,b₂) color2) |
| 274 | (kL (or kL 1)) |
| 275 | (kC (or kC 1)) |
| 276 | (kH (or kH 1)) |
| 277 | (C₁ (sqrt (+ (expt a₁ 2.0) (expt b₁ 2.0)))) |
| 278 | (C₂ (sqrt (+ (expt a₂ 2.0) (expt b₂ 2.0)))) |
| 279 | (C̄ (/ (+ C₁ C₂) 2.0)) |
| 280 | (G (* 0.5 (- 1 (sqrt (/ (expt C̄ 7.0) |
| 281 | (+ (expt C̄ 7.0) (expt 25 7.0))))))) |
| 282 | (a′₁ (* (+ 1 G) a₁)) |
| 283 | (a′₂ (* (+ 1 G) a₂)) |
| 284 | (C′₁ (sqrt (+ (expt a′₁ 2.0) (expt b₁ 2.0)))) |
| 285 | (C′₂ (sqrt (+ (expt a′₂ 2.0) (expt b₂ 2.0)))) |
| 286 | (h′₁ (if (and (= b₁ 0) (= a′₁ 0)) |
| 287 | 0 |
| 288 | (let ((v (atan b₁ a′₁))) |
| 289 | (if (< v 0) |
| 290 | (+ v (* 2 float-pi)) |
| 291 | v)))) |
| 292 | (h′₂ (if (and (= b₂ 0) (= a′₂ 0)) |
| 293 | 0 |
| 294 | (let ((v (atan b₂ a′₂))) |
| 295 | (if (< v 0) |
| 296 | (+ v (* 2 float-pi)) |
| 297 | v)))) |
| 298 | (ΔL′ (- L₂ L₁)) |
| 299 | (ΔC′ (- C′₂ C′₁)) |
| 300 | (Δh′ (cond ((= (* C′₁ C′₂) 0) |
| 301 | 0) |
| 302 | ((<= (abs (- h′₂ h′₁)) float-pi) |
| 303 | (- h′₂ h′₁)) |
| 304 | ((> (- h′₂ h′₁) float-pi) |
| 305 | (- (- h′₂ h′₁) (* 2 float-pi))) |
| 306 | ((< (- h′₂ h′₁) (- float-pi)) |
| 307 | (+ (- h′₂ h′₁) (* 2 float-pi))))) |
| 308 | (ΔH′ (* 2 (sqrt (* C′₁ C′₂)) (sin (/ Δh′ 2.0)))) |
| 309 | (L̄′ (/ (+ L₁ L₂) 2.0)) |
| 310 | (C̄′ (/ (+ C′₁ C′₂) 2.0)) |
| 311 | (h̄′ (cond ((= (* C′₁ C′₂) 0) |
| 312 | (+ h′₁ h′₂)) |
| 313 | ((<= (abs (- h′₁ h′₂)) float-pi) |
| 314 | (/ (+ h′₁ h′₂) 2.0)) |
| 315 | ((< (+ h′₁ h′₂) (* 2 float-pi)) |
| 316 | (/ (+ h′₁ h′₂ (* 2 float-pi)) 2.0)) |
| 317 | ((>= (+ h′₁ h′₂) (* 2 float-pi)) |
| 318 | (/ (+ h′₁ h′₂ (* -2 float-pi)) 2.0)))) |
| 319 | (T (+ 1 |
| 320 | (- (* 0.17 (cos (- h̄′ (degrees-to-radians 30))))) |
| 321 | (* 0.24 (cos (* h̄′ 2))) |
| 322 | (* 0.32 (cos (+ (* h̄′ 3) (degrees-to-radians 6)))) |
| 323 | (- (* 0.20 (cos (- (* h̄′ 4) (degrees-to-radians 63))))))) |
| 324 | (Δθ (* (degrees-to-radians 30) |
| 325 | (exp (- (expt (/ (- h̄′ (degrees-to-radians 275)) |
| 326 | (degrees-to-radians 25)) 2.0))))) |
| 327 | (Rc (* 2 (sqrt (/ (expt C̄′ 7.0) (+ (expt C̄′ 7.0) (expt 25.0 7.0)))))) |
| 328 | (Sl (+ 1 (/ (* 0.015 (expt (- L̄′ 50) 2.0)) |
| 329 | (sqrt (+ 20 (expt (- L̄′ 50) 2.0)))))) |
| 330 | (Sc (+ 1 (* C̄′ 0.045))) |
| 331 | (Sh (+ 1 (* 0.015 C̄′ T))) |
| 332 | (Rt (- (* (sin (* Δθ 2)) Rc)))) |
| 333 | (sqrt (+ (expt (/ ΔL′ (* Sl kL)) 2.0) |
| 334 | (expt (/ ΔC′ (* Sc kC)) 2.0) |
| 335 | (expt (/ ΔH′ (* Sh kH)) 2.0) |
| 336 | (* Rt (/ ΔC′ (* Sc kC)) (/ ΔH′ (* Sh kH))))))) |
| 337 | |
| 338 | (defun color-clamp (value) |
| 339 | "Make sure VALUE is a number between 0.0 and 1.0 inclusive." |
| 340 | (min 1.0 (max 0.0 value))) |
| 341 | |
| 342 | (defun color-saturate-hsl (H S L percent) |
| 343 | "Make a color more saturated by a specified amount. |
| 344 | Given a color defined in terms of hue, saturation, and luminance |
| 345 | \(arguments H, S, and L), return a color that is PERCENT more |
| 346 | saturated. Returns a list (HUE SATURATION LUMINANCE)." |
| 347 | (list H (color-clamp (+ S (/ percent 100.0))) L)) |
| 348 | |
| 349 | (defun color-saturate-name (name percent) |
| 350 | "Make a color with a specified NAME more saturated by PERCENT. |
| 351 | See `color-saturate-hsl'." |
| 352 | (apply 'color-rgb-to-hex |
| 353 | (apply 'color-hsl-to-rgb |
| 354 | (apply 'color-saturate-hsl |
| 355 | (append |
| 356 | (apply 'color-rgb-to-hsl |
| 357 | (color-name-to-rgb name)) |
| 358 | (list percent)))))) |
| 359 | |
| 360 | (defun color-desaturate-hsl (H S L percent) |
| 361 | "Make a color less saturated by a specified amount. |
| 362 | Given a color defined in terms of hue, saturation, and luminance |
| 363 | \(arguments H, S, and L), return a color that is PERCENT less |
| 364 | saturated. Returns a list (HUE SATURATION LUMINANCE)." |
| 365 | (color-saturate-hsl H S L (- percent))) |
| 366 | |
| 367 | (defun color-desaturate-name (name percent) |
| 368 | "Make a color with a specified NAME less saturated by PERCENT. |
| 369 | See `color-desaturate-hsl'." |
| 370 | (color-saturate-name name (- percent))) |
| 371 | |
| 372 | (defun color-lighten-hsl (H S L percent) |
| 373 | "Make a color lighter by a specified amount. |
| 374 | Given a color defined in terms of hue, saturation, and luminance |
| 375 | \(arguments H, S, and L), return a color that is PERCENT lighter. |
| 376 | Returns a list (HUE SATURATION LUMINANCE)." |
| 377 | (list H S (color-clamp (+ L (/ percent 100.0))))) |
| 378 | |
| 379 | (defun color-lighten-name (name percent) |
| 380 | "Make a color with a specified NAME lighter by PERCENT. |
| 381 | See `color-lighten-hsl'." |
| 382 | (apply 'color-rgb-to-hex |
| 383 | (apply 'color-hsl-to-rgb |
| 384 | (apply 'color-lighten-hsl |
| 385 | (append |
| 386 | (apply 'color-rgb-to-hsl |
| 387 | (color-name-to-rgb name)) |
| 388 | (list percent)))))) |
| 389 | |
| 390 | (defun color-darken-hsl (H S L percent) |
| 391 | "Make a color darker by a specified amount. |
| 392 | Given a color defined in terms of hue, saturation, and luminance |
| 393 | \(arguments H, S, and L), return a color that is PERCENT darker. |
| 394 | Returns a list (HUE SATURATION LUMINANCE)." |
| 395 | (color-lighten-hsl H S L (- percent))) |
| 396 | |
| 397 | (defun color-darken-name (name percent) |
| 398 | "Make a color with a specified NAME darker by PERCENT. |
| 399 | See `color-darken-hsl'." |
| 400 | (color-lighten-name name (- percent))) |
| 401 | |
| 402 | (provide 'color) |
| 403 | |
| 404 | ;;; color.el ends here |