mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-12-22 10:26:20 +00:00
Merge some code from hexrgb.el into color.el.
* lisp/color.el (color-name-to-rgb): Rename from color-rgb->normalize. Autoload. Add optional arg FRAME, and pass it to color-values. (color-complement): Caller changed. Doc fix. (color-gradient): Rewrite for better clarity and efficiency. (color-rgb-to-hex): Rename from color-rgb->hex. (color-rgb-to-hsv): Rename from color-rgb->hsv. Force hue and saturation to zero if the value is too small. (color-rgb-to-hsl): Rename from color-rgb->hsl. (color-srgb-to-xyz): Rename from color-srgb->xyz. Doc fix. (color-xyz-to-srgb): Rename from color-xyz->srgb. Doc fix. (color-xyz-to-lab): Rename from color-xyz->lab. Doc fix. (color-lab-to-xyz): Rename from color-lab->xyz. Doc fix. (color-lab-to-srgb): Rename from color-lab->srgb. Doc fix. (color-cie-de2000): Doc fix. * lisp/facemenu.el (color-rgb-to-hsv): Deleted; use the version in lisp/color.el instead. (list-colors-sort-key, list-colors-print): Use color-normalized-values. * lisp/faces.el (color-values): Use cond for clarity. Doc fix. * lisp/gnus/shr-color.el (shr-color->hexadecimal): Use renamed function names color-rgb-to-hex, color-name-to-rgb, color-srgb-to-lab, and color-lab-to-srgb.
This commit is contained in:
Chong Yidong
parent
6b483b6643
commit
6d7132563c
@ -1,3 +1,31 @@
|
||||
2011-02-21 Chong Yidong <cyd@stupidchicken.com>
|
||||
|
||||
* color.el (color-name-to-rgb): Rename from color-rgb->normalize.
|
||||
Autoload. Add optional arg FRAME, and pass it to color-values.
|
||||
(color-complement): Caller changed. Doc fix.
|
||||
(color-gradient): Rewrite for better clarity and efficiency.
|
||||
|
||||
* faces.el (color-values): Use cond for clarity. Doc fix.
|
||||
|
||||
* facemenu.el (color-rgb-to-hsv): Deleted; use the version in
|
||||
color.el instead.
|
||||
(list-colors-sort-key, list-colors-print): Use
|
||||
color-normalized-values.
|
||||
|
||||
2011-02-20 Drew Adams <drew.adams@oracle.com>
|
||||
|
||||
* color.el: First part of merge from hexrgb.el.
|
||||
(color-rgb-to-hex): Rename from color-rgb->hex.
|
||||
(color-rgb-to-hsv): Rename from color-rgb->hsv. Force hue and
|
||||
saturation to zero if the value is too small.
|
||||
(color-rgb-to-hsl): Rename from color-rgb->hsl.
|
||||
(color-srgb-to-xyz): Rename from color-srgb->xyz. Doc fix.
|
||||
(color-xyz-to-srgb): Rename from color-xyz->srgb. Doc fix.
|
||||
(color-xyz-to-lab): Rename from color-xyz->lab. Doc fix.
|
||||
(color-lab-to-xyz): Rename from color-lab->xyz. Doc fix.
|
||||
(color-lab-to-srgb): Rename from color-lab->srgb. Doc fix.
|
||||
(color-cie-de2000): Doc fix.
|
||||
|
||||
2011-02-20 Alan Mackenzie <acm@muc.de>
|
||||
|
||||
* progmodes/cc-cmds.el (c-beginning-of-statement): Avoid loop in
|
||||
|
||||
174
lisp/color.el
174
lisp/color.el
@ -1,9 +1,10 @@
|
||||
;;; color.el --- Color manipulation laboratory routines -*- coding: utf-8; -*-
|
||||
;;; color.el --- Color manipulation library -*- coding: utf-8; -*-
|
||||
|
||||
;; Copyright (C) 2010-2011 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Julien Danjou <julien@danjou.info>
|
||||
;; Keywords: html
|
||||
;; Authors: Julien Danjou <julien@danjou.info>
|
||||
;; Drew Adams <drew.adams@oracle.com>
|
||||
;; Keywords: lisp, faces, color, hex, rgb, hsv, hsl, cie-lab, background
|
||||
|
||||
;; This file is part of GNU Emacs.
|
||||
|
||||
@ -22,7 +23,13 @@
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; This package provides color manipulation functions.
|
||||
;; This package provides functions for manipulating colors, including
|
||||
;; converting between color representations, computing color
|
||||
;; complements, and computing CIEDE2000 color distances.
|
||||
;;
|
||||
;; Supported color representations include RGB (red, green, blue), HSV
|
||||
;; (hue, saturation, value), HSL (hue, saturation, luminence), sRGB,
|
||||
;; CIE XYZ, and CIE L*a*b* color components.
|
||||
|
||||
;;; Code:
|
||||
|
||||
@ -34,15 +41,31 @@
|
||||
(unless (boundp 'float-pi)
|
||||
(defconst float-pi (* 4 (atan 1)) "The value of Pi (3.1415926...).")))
|
||||
|
||||
(defun color-rgb->hex (red green blue)
|
||||
"Return hexadecimal notation for RED GREEN BLUE color.
|
||||
RED GREEN BLUE must be values between 0 and 1 inclusively."
|
||||
;;;###autoload
|
||||
(defun color-name-to-rgb (color &optional frame)
|
||||
"Convert COLOR string to a list of normalized RGB components.
|
||||
COLOR should be a color name (e.g. \"white\") or an RGB triplet
|
||||
string (e.g. \"#ff12ec\").
|
||||
|
||||
Normally the return value is a list of three floating-point
|
||||
numbers, (RED GREEN BLUE), each between 0.0 and 1.0 inclusive.
|
||||
|
||||
Optional arg FRAME specifies the frame where the color is to be
|
||||
displayed. If FRAME is omitted or nil, use the selected frame.
|
||||
If FRAME cannot display COLOR, return nil."
|
||||
(mapcar (lambda (x) (/ x 65535.0)) (color-values color frame)))
|
||||
|
||||
(defun color-rgb-to-hex (red green blue)
|
||||
"Return hexadecimal notation for the color RED GREEN BLUE.
|
||||
RED GREEN BLUE must be numbers between 0.0 and 1.0 inclusive."
|
||||
(format "#%02x%02x%02x"
|
||||
(* red 255) (* green 255) (* blue 255)))
|
||||
|
||||
(defun color-complement (color)
|
||||
"Return the color that is the complement of COLOR."
|
||||
(let ((color (color-rgb->normalize color)))
|
||||
(defun color-complement (color-name)
|
||||
"Return the color that is the complement of COLOR-NAME.
|
||||
COLOR-NAME should be a string naming a color (e.g. \"white\"), or
|
||||
a string specifying a color's RGB components (e.g. \"#ff12ec\")."
|
||||
(let ((color (color-name-to-rgb color-name)))
|
||||
(list (- 1.0 (car color))
|
||||
(- 1.0 (cadr color))
|
||||
(- 1.0 (caddr color)))))
|
||||
@ -52,50 +75,62 @@ RED GREEN BLUE must be values between 0 and 1 inclusively."
|
||||
The color list builds a color gradient starting at color START to
|
||||
color STOP. It does not include the START and STOP color in the
|
||||
resulting list."
|
||||
(loop for i from 1 to step-number
|
||||
with red-step = (/ (- (car stop) (car start)) (1+ step-number))
|
||||
with green-step = (/ (- (cadr stop) (cadr start)) (1+ step-number))
|
||||
with blue-step = (/ (- (caddr stop) (caddr start)) (1+ step-number))
|
||||
collect (list
|
||||
(+ (car start) (* i red-step))
|
||||
(+ (cadr start) (* i green-step))
|
||||
(+ (caddr start) (* i blue-step)))))
|
||||
(let* ((r (nth 0 start))
|
||||
(g (nth 1 start))
|
||||
(b (nth 2 start))
|
||||
(r-step (/ (- (nth 0 stop) r) (1+ step-number)))
|
||||
(g-step (/ (- (nth 1 stop) g) (1+ step-number)))
|
||||
(b-step (/ (- (nth 2 stop) b) (1+ step-number)))
|
||||
result)
|
||||
(dotimes (n step-number)
|
||||
(push (list (setq r (+ r r-step))
|
||||
(setq g (+ g g-step))
|
||||
(setq b (+ b b-step)))
|
||||
result))
|
||||
(nreverse result)))
|
||||
|
||||
(defun color-complement-hex (color)
|
||||
"Return the color that is the complement of COLOR, in hexadecimal format."
|
||||
(apply 'color-rgb->hex (color-complement color)))
|
||||
(apply 'color-rgb-to-hex (color-complement color)))
|
||||
|
||||
(defun color-rgb->hsv (red green blue)
|
||||
"Convert RED GREEN BLUE values to HSV representation.
|
||||
Hue is in radians. Saturation and values are between 0 and 1
|
||||
inclusively."
|
||||
(let* ((r (float red))
|
||||
(defun color-rgb-to-hsv (red green blue)
|
||||
"Convert RED, GREEN, and BLUE color components to HSV.
|
||||
RED, GREEN, and BLUE should each be numbers between 0.0 and 1.0,
|
||||
inclusive. Return a list (HUE, SATURATION, VALUE), where HUE is
|
||||
in radians and both SATURATION and VALUE are between 0.0 and 1.0,
|
||||
inclusive."
|
||||
(let* ((r (float red))
|
||||
(g (float green))
|
||||
(b (float blue))
|
||||
(max (max r g b))
|
||||
(min (min r g b)))
|
||||
(list
|
||||
(/ (* 2 float-pi
|
||||
(cond ((and (= r g) (= g b)) 0)
|
||||
((and (= r max)
|
||||
(>= g b))
|
||||
(* 60 (/ (- g b) (- max min))))
|
||||
((and (= r max)
|
||||
(< g b))
|
||||
(+ 360 (* 60 (/ (- g b) (- max min)))))
|
||||
((= max g)
|
||||
(+ 120 (* 60 (/ (- b r) (- max min)))))
|
||||
((= max b)
|
||||
(+ 240 (* 60 (/ (- r g) (- max min)))))))
|
||||
360)
|
||||
(if (= max 0)
|
||||
0
|
||||
(- 1 (/ min max)))
|
||||
(/ max 255.0))))
|
||||
(if (< (- max min) 1e-8)
|
||||
(list 0.0 0.0 0.0)
|
||||
(list
|
||||
(/ (* 2 float-pi
|
||||
(cond ((and (= r g) (= g b)) 0)
|
||||
((and (= r max)
|
||||
(>= g b))
|
||||
(* 60 (/ (- g b) (- max min))))
|
||||
((and (= r max)
|
||||
(< g b))
|
||||
(+ 360 (* 60 (/ (- g b) (- max min)))))
|
||||
((= max g)
|
||||
(+ 120 (* 60 (/ (- b r) (- max min)))))
|
||||
((= max b)
|
||||
(+ 240 (* 60 (/ (- r g) (- max min)))))))
|
||||
360)
|
||||
(if (= max 0) 0 (- 1 (/ min max)))
|
||||
(/ max 255.0)))))
|
||||
|
||||
(defun color-rgb->hsl (red green blue)
|
||||
(defun color-rgb-to-hsl (red green blue)
|
||||
"Convert RED GREEN BLUE colors to their HSL representation.
|
||||
RED, GREEN and BLUE must be between 0 and 1 inclusively."
|
||||
RED, GREEN, and BLUE should each be numbers between 0.0 and 1.0,
|
||||
inclusive.
|
||||
|
||||
Return a list (HUE, SATURATION, LUMINENCE), where HUE is in radians
|
||||
and both SATURATION and LUMINENCE are between 0.0 and 1.0,
|
||||
inclusive."
|
||||
(let* ((r red)
|
||||
(g green)
|
||||
(b blue)
|
||||
@ -104,13 +139,13 @@ RED, GREEN and BLUE must be between 0 and 1 inclusively."
|
||||
(delta (- max min))
|
||||
(l (/ (+ max min) 2.0)))
|
||||
(list
|
||||
(if (= max min)
|
||||
(if (< (- max min) 1e-8)
|
||||
0
|
||||
(* 2 float-pi
|
||||
(/ (cond ((= max r)
|
||||
(+ (/ (- g b) delta) (if (< g b) 6 0)))
|
||||
((= max g)
|
||||
(+ (/ (- b r) delta) 2))
|
||||
(+ (/ (- b r) delta) 2))
|
||||
(t
|
||||
(+ (/ (- r g) delta) 4)))
|
||||
6)))
|
||||
@ -121,9 +156,9 @@ RED, GREEN and BLUE must be between 0 and 1 inclusively."
|
||||
(/ delta (+ max min))))
|
||||
l)))
|
||||
|
||||
(defun color-srgb->xyz (red green blue)
|
||||
"Converts RED GREEN BLUE colors from the sRGB color space to CIE XYZ.
|
||||
RED, BLUE and GREEN must be between 0 and 1 inclusively."
|
||||
(defun color-srgb-to-xyz (red green blue)
|
||||
"Convert RED GREEN BLUE colors from the sRGB color space to CIE XYZ.
|
||||
RED, BLUE and GREEN must be between 0 and 1, inclusive."
|
||||
(let ((r (if (<= red 0.04045)
|
||||
(/ red 12.95)
|
||||
(expt (/ (+ red 0.055) 1.055) 2.4)))
|
||||
@ -137,8 +172,8 @@ RED, BLUE and GREEN must be between 0 and 1 inclusively."
|
||||
(+ (* 0.21266729 r) (* 0.7151522 g) (* 0.0721750 b))
|
||||
(+ (* 0.0193339 r) (* 0.1191920 g) (* 0.9503041 b)))))
|
||||
|
||||
(defun color-xyz->srgb (X Y Z)
|
||||
"Converts CIE X Y Z colors to sRGB color space."
|
||||
(defun color-xyz-to-srgb (X Y Z)
|
||||
"Convert CIE X Y Z colors to sRGB color space."
|
||||
(let ((r (+ (* 3.2404542 X) (* -1.5371385 Y) (* -0.4985314 Z)))
|
||||
(g (+ (* -0.9692660 X) (* 1.8760108 Y) (* 0.0415560 Z)))
|
||||
(b (+ (* 0.0556434 X) (* -0.2040259 Y) (* 1.0572252 Z))))
|
||||
@ -158,10 +193,10 @@ RED, BLUE and GREEN must be between 0 and 1 inclusively."
|
||||
(defconst color-cie-ε (/ 216 24389.0))
|
||||
(defconst color-cie-κ (/ 24389 27.0))
|
||||
|
||||
(defun color-xyz->lab (X Y Z &optional white-point)
|
||||
"Converts CIE XYZ to CIE L*a*b*.
|
||||
WHITE-POINT can be specified as (X Y Z) white point to use. If
|
||||
none is set, `color-d65-xyz' is used."
|
||||
(defun color-xyz-to-lab (X Y Z &optional white-point)
|
||||
"Convert CIE XYZ to CIE L*a*b*.
|
||||
WHITE-POINT specifies the (X Y Z) white point for the
|
||||
conversion. If omitted or nil, use `color-d65-xyz'."
|
||||
(destructuring-bind (Xr Yr Zr) (or white-point color-d65-xyz)
|
||||
(let* ((xr (/ X Xr))
|
||||
(yr (/ Y Yr))
|
||||
@ -180,10 +215,10 @@ none is set, `color-d65-xyz' is used."
|
||||
(* 500 (- fx fy)) ; a
|
||||
(* 200 (- fy fz)))))) ; b
|
||||
|
||||
(defun color-lab->xyz (L a b &optional white-point)
|
||||
"Converts CIE L*a*b* to CIE XYZ.
|
||||
WHITE-POINT can be specified as (X Y Z) white point to use. If
|
||||
none is set, `color-d65-xyz' is used."
|
||||
(defun color-lab-to-xyz (L a b &optional white-point)
|
||||
"Convert CIE L*a*b* to CIE XYZ.
|
||||
WHITE-POINT specifies the (X Y Z) white point for the
|
||||
conversion. If omitted or nil, use `color-d65-xyz'."
|
||||
(destructuring-bind (Xr Yr Zr) (or white-point color-d65-xyz)
|
||||
(let* ((fy (/ (+ L 16) 116.0))
|
||||
(fz (- fy (/ b 200.0)))
|
||||
@ -201,21 +236,18 @@ none is set, `color-d65-xyz' is used."
|
||||
(* yr Yr) ; Y
|
||||
(* zr Zr))))) ; Z
|
||||
|
||||
(defun color-srgb->lab (red green blue)
|
||||
"Converts RGB to CIE L*a*b*."
|
||||
(apply 'color-xyz->lab (color-srgb->xyz red green blue)))
|
||||
(defun color-srgb-to-lab (red green blue)
|
||||
"Convert RGB to CIE L*a*b*."
|
||||
(apply 'color-xyz-to-lab (color-srgb-to-xyz red green blue)))
|
||||
|
||||
(defun color-rgb->normalize (color)
|
||||
"Normalize a RGB color to values between 0 and 1 inclusively."
|
||||
(mapcar (lambda (x) (/ x 65535.0)) (x-color-values color)))
|
||||
|
||||
(defun color-lab->srgb (L a b)
|
||||
"Converts CIE L*a*b* to RGB."
|
||||
(apply 'color-xyz->srgb (color-lab->xyz L a b)))
|
||||
(defun color-lab-to-srgb (L a b)
|
||||
"Convert CIE L*a*b* to RGB."
|
||||
(apply 'color-xyz-to-srgb (color-lab-to-xyz L a b)))
|
||||
|
||||
(defun color-cie-de2000 (color1 color2 &optional kL kC kH)
|
||||
"Computes the CIEDE2000 color distance between COLOR1 and COLOR2.
|
||||
Colors must be in CIE L*a*b* format."
|
||||
"Return the CIEDE2000 color distance between COLOR1 and COLOR2.
|
||||
Both COLOR1 and COLOR2 should be in CIE L*a*b* format, as
|
||||
returned by `color-srgb-to-lab' or `color-xyz-to-lab'."
|
||||
(destructuring-bind (L₁ a₁ b₁) color1
|
||||
(destructuring-bind (L₂ a₂ b₂) color2
|
||||
(let* ((kL (or kL 1))
|
||||
|
||||
@ -463,25 +463,6 @@ These special properties include `invisible', `intangible' and `read-only'."
|
||||
|
||||
(defalias 'facemenu-read-color 'read-color)
|
||||
|
||||
(defun color-rgb-to-hsv (r g b)
|
||||
"For R, G, B color components return a list of hue, saturation, value.
|
||||
R, G, B input values should be in [0..65535] range.
|
||||
Output values for hue are integers in [0..360] range.
|
||||
Output values for saturation and value are integers in [0..100] range."
|
||||
(let* ((r (/ r 65535.0))
|
||||
(g (/ g 65535.0))
|
||||
(b (/ b 65535.0))
|
||||
(max (max r g b))
|
||||
(min (min r g b))
|
||||
(h (cond ((= max min) 0)
|
||||
((= max r) (mod (+ (* 60 (/ (- g b) (- max min))) 360) 360))
|
||||
((= max g) (+ (* 60 (/ (- b r) (- max min))) 120))
|
||||
((= max b) (+ (* 60 (/ (- r g) (- max min))) 240))))
|
||||
(s (cond ((= max 0) 0)
|
||||
(t (- 1 (/ min max)))))
|
||||
(v max))
|
||||
(list (round h) (round s 0.01) (round v 0.01))))
|
||||
|
||||
(defcustom list-colors-sort nil
|
||||
"Color sort order for `list-colors-display'.
|
||||
`nil' means default implementation-dependent order (defined in `x-colors').
|
||||
@ -508,6 +489,7 @@ and excludes grayscale colors."
|
||||
"Return a list of keys for sorting colors depending on `list-colors-sort'.
|
||||
COLOR is the name of the color. When return value is nil,
|
||||
filter out the color from the output."
|
||||
(require 'color)
|
||||
(cond
|
||||
((null list-colors-sort) color)
|
||||
((eq list-colors-sort 'name)
|
||||
@ -517,12 +499,12 @@ filter out the color from the output."
|
||||
((eq (car-safe list-colors-sort) 'rgb-dist)
|
||||
(color-distance color (cdr list-colors-sort)))
|
||||
((eq list-colors-sort 'hsv)
|
||||
(apply 'color-rgb-to-hsv (color-values color)))
|
||||
(apply 'color-rgb-to-hsv (color-name-to-rgb color)))
|
||||
((eq (car-safe list-colors-sort) 'hsv-dist)
|
||||
(let* ((c-rgb (color-values color))
|
||||
(let* ((c-rgb (color-name-to-rgb color))
|
||||
(c-hsv (apply 'color-rgb-to-hsv c-rgb))
|
||||
(o-hsv (apply 'color-rgb-to-hsv
|
||||
(color-values (cdr list-colors-sort)))))
|
||||
(color-name-to-rgb (cdr list-colors-sort)))))
|
||||
(unless (and (eq (nth 0 c-rgb) (nth 1 c-rgb)) ; exclude grayscale
|
||||
(eq (nth 1 c-rgb) (nth 2 c-rgb)))
|
||||
;; 3D Euclidean distance (sqrt is not needed for sorting)
|
||||
@ -638,7 +620,7 @@ You can change the color sort order by customizing `list-colors-sort'."
|
||||
'mouse-face 'highlight
|
||||
'help-echo
|
||||
(let ((hsv (apply 'color-rgb-to-hsv
|
||||
(color-values (car color)))))
|
||||
(color-name-to-rgb (car color)))))
|
||||
(format "H:%d S:%d V:%d"
|
||||
(nth 0 hsv) (nth 1 hsv) (nth 2 hsv)))))
|
||||
(when callback
|
||||
|
||||
@ -1653,18 +1653,28 @@ If COLOR is the symbol `unspecified' or one of the strings
|
||||
|
||||
(defun color-values (color &optional frame)
|
||||
"Return a description of the color named COLOR on frame FRAME.
|
||||
The value is a list of integer RGB values--(RED GREEN BLUE).
|
||||
These values appear to range from 0 to 65280 or 65535, depending
|
||||
on the system; white is \(65280 65280 65280\) or \(65535 65535 65535\).
|
||||
COLOR should be a string naming a color (e.g. \"white\"), or a
|
||||
string specifying a color's RGB components (e.g. \"#ff12ec\").
|
||||
|
||||
Return a list of three integers, (RED GREEN BLUE), each between 0
|
||||
and either 65280 or 65535 (the maximum depends on the system).
|
||||
Use `color-name-to-rgb' if you want RGB floating-point values
|
||||
normalized to 1.0.
|
||||
|
||||
If FRAME is omitted or nil, use the selected frame.
|
||||
If FRAME cannot display COLOR, the value is nil.
|
||||
If COLOR is the symbol `unspecified' or one of the strings
|
||||
\"unspecified-fg\" or \"unspecified-bg\", the value is nil."
|
||||
(if (member color '(unspecified "unspecified-fg" "unspecified-bg"))
|
||||
nil
|
||||
(if (memq (framep (or frame (selected-frame))) '(x w32 ns))
|
||||
(xw-color-values color frame)
|
||||
(tty-color-values color frame))))
|
||||
|
||||
COLOR can also be the symbol `unspecified' or one of the strings
|
||||
\"unspecified-fg\" or \"unspecified-bg\", in which case the
|
||||
return value is nil."
|
||||
(cond
|
||||
((member color '(unspecified "unspecified-fg" "unspecified-bg"))
|
||||
nil)
|
||||
((memq (framep (or frame (selected-frame))) '(x w32 ns))
|
||||
(xw-color-values color frame))
|
||||
(t
|
||||
(tty-color-values color frame))))
|
||||
|
||||
(defalias 'x-color-values 'color-values)
|
||||
|
||||
(declare-function xw-display-color-p "xfns.c" (&optional terminal))
|
||||
|
||||
@ -1,3 +1,9 @@
|
||||
2011-02-20 Chong Yidong <cyd@stupidchicken.com>
|
||||
|
||||
* shr-color.el (shr-color->hexadecimal): Use renamed function names
|
||||
color-rgb-to-hex, color-name-to-rgb, color-srgb-to-lab, and
|
||||
color-lab-to-srgb.
|
||||
|
||||
2011-02-19 Glenn Morris <rgm@gnu.org>
|
||||
|
||||
* gnus.el (gnus-meta): Doc fix.
|
||||
|
||||
@ -259,7 +259,7 @@ Like rgb() or hsl()."
|
||||
(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)
|
||||
(color-rgb->hex r g b))))
|
||||
(color-rgb-to-hex r g b))))
|
||||
;; Color names
|
||||
((cdr (assoc-string color shr-color-html-colors-alist t)))
|
||||
;; Unrecognized color :(
|
||||
@ -325,13 +325,13 @@ 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-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-srgb->lab fg-norm))
|
||||
(bg-lab (apply 'color-srgb->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)
|
||||
@ -351,10 +351,10 @@ color will be adapted to be visible on BG."
|
||||
bg
|
||||
(apply 'format "#%02x%02x%02x"
|
||||
(mapcar (lambda (x) (* (max (min 1 x) 0) 255))
|
||||
(apply 'color-lab->srgb 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->srgb fg-lab))))))))))
|
||||
(apply 'color-lab-to-srgb fg-lab))))))))))
|
||||
|
||||
(provide 'shr-color)
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user