* color.el
@ 2011-02-17 0:23 Drew Adams
2011-02-19 18:33 ` color.el Chong Yidong
0 siblings, 1 reply; 8+ messages in thread
From: Drew Adams @ 2011-02-17 0:23 UTC (permalink / raw)
To: emacs-devel
[-- Attachment #1: Type: text/plain, Size: 991 bytes --]
I thought that `hexrgb.el' and `color-lab.el' were going to be merged.
I suggested the name `color.el' for the combination, which was accepted.
See the thread, from 2010/11:
http://lists.gnu.org/archive/html/emacs-devel/2010-11/msg00897.html
http://lists.gnu.org/archive/html/emacs-devel/2010-11/msg00894.html
Instead, it seems that all that has happened so far is that `color-lab.el' was
renamed `color.el'. AFAICT there is nothing from `hexrgb.el' in the file. In
addition, Yidong mentioned moving `read-color' there, but that has not been done
yet either.
I've merged the two libraries now, moved `read-color' to it, and cleaned things
up (e.g. doc). When there was overlap I kept the best version (e.g. most
precise or most general). I did not include anything from `eyedropper.el' (e.g.
for `read-color').
Attached is the result, both a patch from the latest `color.el' and the new
result. (`read-color' also needs to be removed from `faces.el' - I did not
include that patch.)
[-- Attachment #2: color-2011-02-16.patch --]
[-- Type: application/octet-stream, Size: 36833 bytes --]
diff -c -w color-BZR-2011-02-16.el color-2011-02-16.el
*** color-BZR-2011-02-16.el Wed Feb 16 14:40:04 2011
--- color-2011-02-16.el Wed Feb 16 15:46:08 2011
***************
*** 1,9 ****
! ;;; color.el --- Color manipulation laboratory routines -*- coding: utf-8; -*-
! ;; Copyright (C) 2010-2011 Free Software Foundation, Inc.
! ;; Author: Julien Danjou <julien@danjou.info>
! ;; Keywords: html
;; This file is part of GNU Emacs.
--- 1,10 ----
! ;;; color.el --- Color manipulation -*- coding: utf-8; -*-
! ;; Copyright (C) 2011 Free Software Foundation, Inc.
! ;; Author: Drew Adams <drew.adams@oracle.com>
! ;; Julien Danjou <julien@danjou.info>
! ;; Keywords: color, hex, rgb, hsv, hsl, cie-lab, background, display, face
;; This file is part of GNU Emacs.
***************
*** 22,71 ****
;;; Commentary:
! ;; This package provides color manipulation functions.
;;; Code:
! (eval-when-compile
! (require 'cl))
;; Emacs < 23.3
(eval-and-compile
(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."
! (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)))
! (list (- 1.0 (car color))
! (- 1.0 (cadr color))
! (- 1.0 (caddr color)))))
(defun color-gradient (start stop step-number)
"Return a list with STEP-NUMBER colors from START to STOP.
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)))))
! (defun color-complement-hex (color)
! "Return the color that is the complement of COLOR, in hexadecimal format."
! (apply 'color-rgb->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."
--- 23,468 ----
;;; Commentary:
! ;; This library provides color manipulation functions.
! ;;
! ;; It provides functions for converting between RGB (red, green,
! ;; blue), HSV (hue, saturation, value), HSL (hue, saturation,
! ;; luminence), sRGB, CIE XYZ, and CIE L*a*b* color components. It
! ;; helps you convert among all of the following:
! ;;
! ;; * Emacs RGB color components (aka color "values"), which are whole
! ;; numbers from 0 through 65535
! ;; * RGB, HSV, HSL, sRGB, CIE XYZ, and CIE L*a*b* floating-point
! ;; components (0.0 through 1.0)
! ;; * Emacs color-name strings, such as "blue"
! ;; * RGB triplet strings, such as "#FC43A7912"
! ;;
! ;; An RGB triplet string has 1 + (3 * n) characters, the first of
! ;; which is "#". The other characters are hexadecimal digits, in
! ;; three groups representing (from the left): red, green, and blue
! ;; components.
! ;;
! ;; It also provides functions to do the following:
! ;; * Increment an RGB triplet (string) in various ways
! ;; * Return the complement of a color as an RGB triplet or components
! ;; * Return the CIEDE2000 color distance between two colors
! ;; * Return an individual floating-point RGB or HSV component of a
! ;; color-name or RGB triplet string
! ;;
! ;; FIXME/TODO (?):
! ;;
! ;; Add functions:
! ;; color-hex-to-hsl, color-hsl-to-hex, color-hsl-to-rgb,
! ;; color-hsv-radians-to-rgb, color-luminance
! ;; color-cie-ε: Add doc string
! ;; color-cie-κ: Add doc string
! ;; color-cie-de2000: Specify return value in doc string
! ;; color-lab-to-srgb: Specify return value in doc string
! ;; color-lab-to-xyz: Specify return value in doc string
! ;; color-srgb-to-lab: Specify return value in doc string
! ;; color-srgb-to-xyz: Specify return value in doc string
! ;; color-xyz-to-lab: Specify return value in doc string
! ;; color-xyz-to-srgb: Specify return value in doc string
;;; Code:
! (eval-when-compile (require 'cl)) ; loop
;; Emacs < 23.3
(eval-and-compile
(unless (boundp 'float-pi)
! (defconst float-pi (* 4 (atan 1)) "The math constant pi (3.141592653589793...).")))
!
! (eval-and-compile
! (defun color-canonicalize-defined-colors (list)
! "Copy of LIST with color names canonicalized.
! LIST is a list of color names (strings).
! Canonical names are lowercase, with no whitespace.
! There are no duplicate names."
! (let ((tail list)
! this new)
! (while tail
! (setq this (car tail)
! this (color-delete-whitespace-from-string (downcase this) 0 (length this)))
! (unless (member this new) (push this new))
! (pop tail))
! (nreverse new)))
!
! (defun color-delete-whitespace-from-string (string &optional from to)
! "Remove whitespace from substring of STRING from FROM to TO.
! If FROM is nil, then start at the beginning of STRING (FROM = 0).
! If TO is nil, then end at the end of STRING (TO = length of STRING).
! FROM and TO are zero-based indexes into STRING.
! Character FROM is affected (possibly deleted). Character TO is not."
! (setq from (or from 0)
! to (or to (length string)))
! (with-temp-buffer
! (insert string)
! (goto-char (+ from (point-min)))
! (let ((count from)
! char)
! (while (and (not (eobp)) (< count to))
! (setq char (char-after))
! (if (memq char '(?\ ?\t ?\n)) (delete-char 1) (forward-char 1))
! (setq count (1+ count)))
! (buffer-string)))))
!
! (defconst color-defined-colors (eval-when-compile (and window-system (x-defined-colors)))
! "List of all supported colors.")
!
! (defconst color-defined-colors-no-dups
! (eval-when-compile
! (and window-system (color-canonicalize-defined-colors (x-defined-colors))))
! "List of all supported color names, with no duplicates.
! Names are all lowercase, without any spaces.")
!
! (defconst color-d65-xyz '(0.950455 1.0 1.088753)
! "D65 white point in CIE XYZ.")
!
! ;; FIXME/TODO? Add doc string
! (defconst color-cie-ε (/ 216 24389.0))
!
! ;; FIXME/TODO? Add doc string
! (defconst color-cie-κ (/ 24389 27.0))
!
! (defcustom color-canonicalize-defined-colors-flag t
! "*Non-nil means remove duplicate color names.
! Names are considered duplicates if they are the same when abstracting
! from whitespace and letter case."
! :type 'boolean :group 'faces)
!
! ;; Use function `color-defined-colors', not the constants, so users
! ;; can change the behavior by customizing `color-canonicalize-defined-colors-flag'.
!
! (defun color-defined-colors ()
! "List of supported color names.
! If `color-canonicalize-defined-colors-flag' is non-nil, then names
! are lowercased, whitespace is removed, and there are no duplicates."
! (if color-canonicalize-defined-colors-flag
! color-defined-colors-no-dups
! color-defined-colors))
!
! (defun read-color (&optional prompt convert-to-RGB allow-empty-name msg)
! "Read a color name or RGB triplet.
! Completion is available for color names, but not for RGB triplets.
!
! RGB triplets have the form #XXXXXXXXXXXX, where each X is a
! hexadecimal digit. The number of X's must be a multiple of 3, with
! the same number of X's for each of red, green, and blue. The order of
! the color components is red, green, blue.
!
! Color names that are normally considered equivalent are canonicalized:
! They are lowercased, whitespace is removed, and duplicates are
! eliminated. E.g. \"LightBlue\" and \"light blue\" are both replaced
! by \"lightblue\". If you do not want this behavior, but want to
! choose names that might contain whitespace or uppercase letters, then
! customize option `color-canonicalize-defined-colors-flag' to nil.
!
! In addition to standard color names and RGB hex components, the
! following are available as color candidates. In each case, the
! corresponding color is used.
!
! * `foreground at point' - foreground under the cursor
! * `background at point' - background under the cursor
!
! Optional arg PROMPT is the prompt; if nil, use a default prompt.
!
! Interactively, or with optional arg CONVERT-TO-RGB non-nil, convert an
! input color name to an RGB triplet string. Return the triplet string.
! Otherwise, return the user input (color name or triplet) as a string.
!
! If optional arg ALLOW-EMPTY-NAME is non-nil, the user is allowed
! to enter an empty color name (the empty string).
!
! Interactively, or with optional arg MSG non-nil, print the returned
! string in the echo area."
! (interactive "i\np\ni\np") ; Always convert to RGB interactively.
! (let* ((completion-ignore-case t)
! (colors (or facemenu-color-alist
! (append '("foreground at point" "background at point")
! (if allow-empty-name '(""))
! (color-defined-colors))))
! (color (completing-read
! (or prompt "Color (name or #RGB triplet): ")
! ;; Completing function for colors - accepts color names & RGB triplets.
! (lambda (string pred flag)
! (cond
! ((null flag) ; Try completion.
! (or (try-completion string colors pred)
! (if (color-defined-p string) string)))
! ((eq flag t) ; List all completions.
! (or (all-completions string colors pred)
! (if (color-defined-p string) (list string))))
! ((eq flag 'lambda) ; Test completion.
! (or (memq string colors) (color-defined-p string)))))
! nil t))
! hex-string)
! (when (member color colors)
! (cond ((string-equal color "foreground at point")
! (setq color (foreground-color-at-point)))
! ((string-equal color "background at point")
! (setq color (background-color-at-point))))
! (when (and convert-to-RGB (not (string-equal color "")))
! (setq color (color-name-to-hex color))))
! (when msg (message "Color: `%s'" color))
! color))
!
! (defun color-rgb-hex-string-p (color &optional laxp)
! "Non-nil if COLOR is an RGB triplet string \"#XXXXXXXXXXXX\".
! Each X is a hexadecimal digit. The number of X's must be a multiple
! of 3, with the same number of X's for each of red, green, and blue.
! The first group of X's is for red, the second is for green, the third
! is for blue.
!
! Non-nil optional arg LAXP means that the initial `#' is optional. In
! that case, for a valid string of hex digits: when # is present 0 is
! returned; otherwise, t is returned."
! (or (string-match "^#\\([a-fA-F0-9][a-fA-F0-9][a-fA-F0-9]\\)+$" color)
! (and laxp (string-match "^\\([a-fA-F0-9][a-fA-F0-9][a-fA-F0-9]\\)+$" color) t)))
!
! ;; This version is thanks to Juri Linkov <juri@jurta.org>.
! (defun color-int-to-hex (int &optional nb-digits)
! "Convert integer argument INT to a RGB triplet string.
! The string satisfies `color-rgb-hex-string-p'.
! NB-DIGITS is the number of hex digits. If INT is too large to be
! represented with NB-DIGITS, then the result is truncated from the
! left. So for example, INT=256 and NB-DIGITS=2 returns \"00\", since
! the hex equivalent of 256 decimal is 100, which is more than 2 digits."
! (setq nb-digits (or nb-digits 4))
! (substring (format (concat "%0" (int-to-string nb-digits) "X") int) (- nb-digits)))
!
! ;; These are the color "values" of `x-color-values', `ps-color-values', and
! ;; `ps-e-x-color-values'. But especially given the use of "value" in HSV, "components" is
! ;; better in the name than "values".
! (defun color-components-to-hex (components)
! "Convert list of rgb color COMPONENTS to an RGB triplet string.
! Input COMPONENTS is as for the output of `x-color-values'."
! ;; Just hard-code 4 as the number of hex digits, since `x-color-values'
! ;; seems to produce appropriate integer values.
! (concat "#" (color-int-to-hex (nth 0 components) 4) ; red
! (color-int-to-hex (nth 1 components) 4) ; green
! (color-int-to-hex (nth 2 components) 4))) ; blue
!
! (defun color-name-to-hex (color)
! "Return the RGB triplet string for COLOR.
! COLOR is a color name.
! It can also be an RGB triplet, which is just returned as is.
! The string returned satisfies `color-rgb-hex-string-p'."
! (let ((components (x-color-values color)))
! (unless components (error "No such color: %S" color))
! (unless (color-rgb-hex-string-p color)
! (setq color (color-components-to-hex components))))
! color)
!
! (defun color-rgb-to-hex (red green blue)
! "Return the RBG triplet for inputs RED, GREEN, BLUE.
! The inputs are each in the range 0 to 1, inclusive.
! The string returned satisfies `color-rgb-hex-string-p'."
! (color-components-to-hex
! (mapcar (lambda (x) (floor (* x 65535.0))) (list red green blue))))
!
! (defun color-hsv-to-hex (hue saturation value)
! "Return the RBG triplet string for inputs HUE, SATURATION, and VALUE.
! The inputs are each in the range 0 to 1, inclusive.
! The string returned satisfies `color-rgb-hex-string-p'."
! (color-components-to-hex
! (mapcar (lambda (x) (floor (* x 65535.0))) (color-hsv-to-rgb hue saturation value))))
!
! ;; FIXME/TODO? (defun color-hsl-to-hex ...)
!
! ;; Same as `hexl-hex-char-to-integer', defined in `hexl.el'.
! (defun color-hex-char-to-integer (character)
! "Take a CHARACTER and return its value as if it were a hex digit."
! (if (and (>= character ?0) (<= character ?9))
! (- character ?0)
! (let ((ch (logior character 32)))
! (if (and (>= ch ?a) (<= ch ?f))
! (- ch (- ?a 10))
! (error "Invalid hex digit `%c'" ch)))))
!
! (defun color-hex-to-int (hex)
! "Convert hexadecimal string HEX to a whole-number value.
! The characters of HEX must be hexadecimal-digit characters."
! (let* ((factor 1)
! (len (length hex))
! (indx (1- len))
! (int 0))
! (while (>= indx 0)
! (setq int (+ int (* factor (color-hex-char-to-integer (aref hex indx))))
! indx (1- indx)
! factor (* 16 factor)))
! int))
!
! (defun color-hex-to-components (rgb-triplet)
! "Return the RGB color components for RGB-TRIPLET.
! RGB-TRIPLET is an RGB triplet string (`color-rgb-hex-string-p').
! The output list is as for `x-color-values'."
! (let* ((hex-strgp (string-match
! "^\\(#\\)?\\(\\([a-fA-F0-9][a-fA-F0-9][a-fA-F0-9]\\)+\\)$"
! rgb-triplet))
! (ndigits (/ (if (eq (match-beginning 1) (match-end 1))
! (length rgb-triplet)
! (1- (length rgb-triplet)))
! 3))
! red green blue)
! (unless hex-strgp (error "Invalid RGB triplet string: %s" rgb-triplet))
! (setq rgb-triplet (substring rgb-triplet (match-beginning 2) (match-end 2))
! red (color-hex-to-int (substring rgb-triplet 0 ndigits))
! green (color-hex-to-int (substring rgb-triplet ndigits (* 2 ndigits)))
! blue (color-hex-to-int (substring rgb-triplet (* 2 ndigits) (* 3 ndigits))))
! (list red green blue)))
!
! (defun color-hex-to-rgb (color)
! "Return a list of RGB (red, green, blue) color components.
! Each component is a value from 0.0 to 1.0, inclusive.
! COLOR is a color name or RGB triplet string (satisfies
! `color-rgb-hex-string-p')."
! (unless (color-rgb-hex-string-p color) (setq color (color-name-to-hex color)))
! (let ((len (/ (1- (length color)) 3)))
! (list (/ (color-hex-to-int (substring color 1 (1+ len))) 65535.0)
! (/ (color-hex-to-int (substring color (1+ len) (+ 1 len len))) 65535.0)
! (/ (color-hex-to-int (substring color (+ 1 len len))) 65535.0))))
!
! (defun color-hex-to-hsv (color)
! "Return a list of HSV (hue, saturation, value) color components.
! Each component is a value from 0.0 to 1.0, inclusive.
! COLOR is a color name or RGB triplet string (satisfies
! `color-rgb-hex-string-p')."
! (let ((rgb-components (color-hex-to-rgb color)))
! (apply #'color-rgb-to-hsv rgb-components)))
!
! ;; FIXME/TODO? (defun color-hex-to-hsl ...)
!
! (defun color-red (color)
! "Return the red component of COLOR, in range 0 to 1, inclusive.
! COLOR is a color name or RGB triplet string."
! (interactive (list (read-color)))
! (setq color (color-name-to-hex color))
! (/ (color-hex-to-int (substring color 1 (1+ (/ (1- (length color)) 3))))
! (expt 16.0 (/ (1- (length color)) 3.0))))
!
! (defun color-green (color)
! "Return the green component of COLOR, in range 0 to 1, inclusive.
! COLOR is a color name or RGB triplet string."
! (interactive (list (read-color)))
! (setq color (color-name-to-hex color))
! (let* ((len (/ (1- (length color)) 3))
! (start (1+ len)))
! (/ (color-hex-to-int (substring color start (+ start len)))
! (expt 16.0 (/ (1- (length color)) 3.0)))))
!
! (defun color-blue (color)
! "Return the blue component of COLOR, in range 0 to 1, inclusive.
! COLOR is a color name or RGB triplet string."
! (interactive (list (read-color)))
! (setq color (color-name-to-hex color))
! (let* ((len (/ (1- (length color)) 3))
! (start (+ 1 len len)))
! (/ (color-hex-to-int (substring color start (+ start len)))
! (expt 16.0 (/ (1- (length color)) 3.0)))))
!
! (defun color-hue (color)
! "Return the hue component of COLOR, in range 0 to 1, inclusive.
! COLOR is a color name or RGB triplet string."
! (interactive (list (read-color)))
! (setq color (color-name-to-hex color))
! (car (color-rgb-to-hsv (color-red color) (color-green color) (color-blue color))))
!
! (defun color-saturation (color)
! "Return the saturation component of COLOR, in range 0 to 1, inclusive.
! COLOR is a color name or RGB triplet string."
! (interactive (list (read-color)))
! (setq color (color-name-to-hex color))
! (cadr (color-rgb-to-hsv (color-red color) (color-green color) (color-blue color))))
!
! (defun color-value (color)
! "Return the value component of COLOR, in range 0 to 1, inclusive.
! COLOR is a color name or RGB triplet string."
! (interactive (list (read-color)))
! (setq color (color-name-to-hex color))
! (caddr (color-rgb-to-hsv (color-red color) (color-green color) (color-blue color))))
!
! ;; FIXME/TODO? (defun color-luminance ...)
!
! (defun color-rgb-normalize (color)
! "Return the normalized RGB components of COLOR as a list.
! COLOR is a color name or RGB triplet string.
! Each component returned is 0 to 1, inclusive."
! (mapcar (lambda (x) (/ x 65535.0)) (x-color-values color)))
! (defun color-complement-hex (color-name)
! "Return the complement of COLOR-NAME as an RGB triplet.
! \(COLOR-NAME can also be an RGB triplet - it is just returned.)
! Interactively, you are prompted for COLOR-NAME."
! (interactive (list (read-color)))
! (apply 'color-rgb-to-hex (color-complement-components color-name)))
!
! (defun color-complement-components (color)
! "Return the RGB color components for the complement of COLOR.
! COLOR is a color name or RGB triplet string."
! (let ((color (color-rgb-normalize color)))
! (list (- 1.0 (car color)) (- 1.0 (cadr color)) (- 1.0 (caddr color)))))
(defun color-gradient (start stop step-number)
"Return a list with STEP-NUMBER colors from START to STOP.
The color list builds a color gradient starting at color START to
! color STOP. It does not include the START and STOP colors 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)))))
! ;; From Elisp Info manual, node "Comparison of Numbers".
! (defun color-approx-equal (x y &optional rfuzz afuzz)
! "Return non-nil if numbers X and Y are approximately equal.
! RFUZZ is a relative fuzz factor. AFUZZ is an absolute fuzz factor.
! RFUZZ defaults to 1.0e-8. AFUZZ defaults to (/ RFUZZ 10).
! RFUZZ and AFUZZ are converted to their absolute values.
! The algorithm is:
! (< (abs (- X Y)) (+ AFUZZ (* RFUZZ (+ (abs X) (abs Y)))))."
! (setq rfuzz (or rfuzz 1.0e-8)
! rfuzz (abs rfuzz)
! afuzz (or afuzz (/ rfuzz 10))
! afuzz (abs afuzz))
! (< (abs (- x y)) (+ afuzz (* rfuzz (+ (abs x) (abs y))))))
!
! (defun color-rgb-to-hsv (red green blue)
! "Convert RED, GREEN, BLUE components to HSV (hue, saturation, value).
! Each input component is 0.0 to 1.0, inclusive.
! Returns a list of HSV components of value 0.0 to 1.0, inclusive."
! (let* ((min (min red green blue))
! (max (max red green blue))
! (value max)
! (delta (- max min))
! hue saturation)
! (if (color-approx-equal 0.0 delta)
! (setq hue 0.0
! saturation 0.0) ; Gray scale - no color; only value.
! (if (and (condition-case nil
! (setq saturation (/ delta max))
! (arith-error nil))
! ;; Must be a number, not a NaN. Standard test for a NaN is (not (= N N)),
! (= saturation saturation))
! (if (color-approx-equal 0.0 saturation)
! (setq hue 0.0
! saturation 0.0) ; Again, no color - only value.
! (setq hue (if (color-approx-equal red max)
! (/ (- green blue) delta) ; Between yellow & magenta.
! (if (color-approx-equal green max)
! (+ 2.0 (/ (- blue red) delta)) ; Between cyan & yellow.
! (+ 4.0 (/ (- red green) delta)))) ; Between magenta & cyan.
! hue (/ hue 6.0))
! (when (< hue 0.0) (setq hue (+ hue 1.0)))
! (when (> hue 1.0) (setq hue (- hue 1.0))))
! (setq hue 0.0 ; Div by zero (max=0): H:=0, S:=0. (Hue undefined.)
! saturation 0.0)))
! (list hue saturation value)))
! (defun color-rgb-to-hsv-radians (red green blue)
"Convert RED GREEN BLUE values to HSV representation.
Hue is in radians. Saturation and values are between 0 and 1
inclusively."
***************
*** 93,101 ****
(- 1 (/ min max)))
(/ max 255.0))))
! (defun color-rgb->hsl (red green blue)
"Convert RED GREEN BLUE colors to their HSL representation.
! RED, GREEN and BLUE must be between 0 and 1 inclusively."
(let* ((r red)
(g green)
(b blue)
--- 490,536 ----
(- 1 (/ min max)))
(/ max 255.0))))
! ;; FIXME/TODO? (defun color-hsv-radians-to-rgb ...)
!
! (defun color-hsv-to-rgb (hue saturation value)
! "Convert HUE, SATURATION, VALUE components to RGB (red, green, blue).
! Each input component is 0.0 to 1.0, inclusive.
! Returns a list of RGB components of value 0.0 to 1.0, inclusive."
! (let (red green blue int-hue fract pp qq tt ww)
! (if (color-approx-equal 0.0 saturation)
! (setq red value
! green value
! blue value) ; Gray
! (setq hue (* hue 6.0) ; Sectors: 0 to 5
! int-hue (floor hue)
! fract (- hue int-hue)
! pp (* value (- 1 saturation))
! qq (* value (- 1 (* saturation fract)))
! ww (* value (- 1 (* saturation (- 1 (- hue int-hue))))))
! (case int-hue
! ((0 6) (setq red value
! green ww
! blue pp))
! (1 (setq red qq
! green value
! blue pp))
! (2 (setq red pp
! green value
! blue ww))
! (3 (setq red pp
! green qq
! blue value))
! (4 (setq red ww
! green pp
! blue value))
! (otherwise (setq red value
! green pp
! blue qq))))
! (list 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 from 0 to 1, inclusive."
(let* ((r red)
(g green)
(b blue)
***************
*** 121,129 ****
(/ 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."
(let ((r (if (<= red 0.04045)
(/ red 12.95)
(expt (/ (+ red 0.055) 1.055) 2.4)))
--- 556,567 ----
(/ delta (+ max min))))
l)))
! ;; FIXME/TODO? (defun color-hsl-to-rgb ...)
!
! ;; FIXME/TODO? Specify return value in doc string.
! (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 from 0 to 1, inclusive."
(let ((r (if (<= red 0.04045)
(/ red 12.95)
(expt (/ (+ red 0.055) 1.055) 2.4)))
***************
*** 137,144 ****
(+ (* 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."
(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))))
--- 575,583 ----
(+ (* 0.21266729 r) (* 0.7151522 g) (* 0.0721750 b))
(+ (* 0.0193339 r) (* 0.1191920 g) (* 0.9503041 b)))))
! ;; FIXME/TODO? Specify return value in doc string.
! (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))))
***************
*** 152,165 ****
(* 12.92 b)
(- (* 1.055 (expt b (/ 1 2.4))) 0.055)))))
! (defconst color-d65-xyz '(0.950455 1.0 1.088753)
! "D65 white point in CIE XYZ.")
!
! (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."
(destructuring-bind (Xr Yr Zr) (or white-point color-d65-xyz)
--- 591,599 ----
(* 12.92 b)
(- (* 1.055 (expt b (/ 1 2.4))) 0.055)))))
! ;; FIXME/TODO? Specify return value in doc string.
! (defun color-xyz-to-lab (X Y Z &optional white-point)
! "Convert 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."
(destructuring-bind (Xr Yr Zr) (or white-point color-d65-xyz)
***************
*** 180,187 ****
(* 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."
(destructuring-bind (Xr Yr Zr) (or white-point color-d65-xyz)
--- 614,622 ----
(* 500 (- fx fy)) ; a
(* 200 (- fy fz)))))) ; b
! ;; FIXME/TODO? Specify return value in doc string.
! (defun color-lab-to-xyz (L a b &optional white-point)
! "Convert 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."
(destructuring-bind (Xr Yr Zr) (or white-point color-d65-xyz)
***************
*** 201,218 ****
(* 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-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-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."
--- 636,652 ----
(* yr Yr) ; Y
(* zr Zr))))) ; Z
! ;; FIXME/TODO? Specify return value in doc string.
! (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)))
!
! ;; FIXME/TODO? Specify return value in doc string.
! (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)))
+ ;; FIXME/TODO? Specify return value in doc string.
(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."
***************
*** 267,273 ****
(* 0.24 (cos (* h̄′ 2)))
(* 0.32 (cos (+ (* h̄′ 3) (degrees-to-radians 6))))
(- (* 0.20 (cos (- (* h̄′ 4) (degrees-to-radians 63)))))))
! (Δθ (* (degrees-to-radians 30) (exp (- (expt (/ (- h̄′ (degrees-to-radians 275)) (degrees-to-radians 25)) 2.0)))))
(Rc (* 2 (sqrt (/ (expt C̄′ 7.0) (+ (expt C̄′ 7.0) (expt 25.0 7.0))))))
(Sl (+ 1 (/ (* 0.015 (expt (- L̄′ 50) 2.0)) (sqrt (+ 20 (expt (- L̄′ 50) 2.0))))))
(Sc (+ 1 (* C̄′ 0.045)))
--- 701,709 ----
(* 0.24 (cos (* h̄′ 2)))
(* 0.32 (cos (+ (* h̄′ 3) (degrees-to-radians 6))))
(- (* 0.20 (cos (- (* h̄′ 4) (degrees-to-radians 63)))))))
! (Δθ (* (degrees-to-radians 30)
! (exp (- (expt (/ (- h̄′ (degrees-to-radians 275)) (degrees-to-radians 25))
! 2.0)))))
(Rc (* 2 (sqrt (/ (expt C̄′ 7.0) (+ (expt C̄′ 7.0) (expt 25.0 7.0))))))
(Sl (+ 1 (/ (* 0.015 (expt (- L̄′ 50) 2.0)) (sqrt (+ 20 (expt (- L̄′ 50) 2.0))))))
(Sc (+ 1 (* C̄′ 0.045)))
***************
*** 278,283 ****
--- 714,803 ----
(expt (/ ΔH′ (* Sh kH)) 2.0)
(* Rt (/ ΔC′ (* Sc kC)) (/ ΔH′ (* Sh kH)))))))))
+ (defun color-component-to-float (n)
+ "Return the floating-point equivalent of color-component value N.
+ N must be an integer between 0 and 65535, or else an error is raised."
+ (unless (and (wholenump n) (<= n 65535))
+ (error "Not a whole number less than 65536"))
+ (/ (float n) 65535.0))
+
+ (defun color-float-to-component (x)
+ "Return the color-component value equivalent of floating-point number X.
+ X must be between 0.0 and 1.0, or else an error is raised."
+ (unless (and (numberp x) (<= 0.0 x) (<= x 1.0))
+ (error "Not a floating-point number between 0.0 and 1.0"))
+ (floor (* x 65535.0)))
+
+ (defun color-increment-hex (hex nb-digits increment &optional wrap-p)
+ "Increment HEX number (a string NB-DIGITS long) by INCREMENT.
+ If optional arg WRAP-P is non-nil then the result wraps around zero.
+ For example, with NB-DIGITS 3, incrementing \"fff\" by 1 causes it
+ to wrap around to \"000\"."
+ (let* ((int (color-hex-to-int hex))
+ (new-int (+ increment int)))
+ (if (or wrap-p
+ (and (>= int 0) ; Not too large for the machine.
+ (>= new-int 0) ; For the case where increment < 0.
+ (<= (length (format (concat "%X") new-int)) nb-digits))) ; Not too long.
+ (color-int-to-hex new-int nb-digits) ; Use incremented number.
+ hex))) ; Don't increment.
+
+ (defun color-increment-red (hex nb-digits increment &optional wrap-p)
+ "Increment red component of RGB triplet string HEX by INCREMENT.
+ String HEX satisfies `color-rgb-hex-string-p'.
+ Each component in HEX is NB-DIGITS hex digits long.
+ If optional arg WRAP-P is non-nil then the result wraps around zero.
+ For example, with NB-DIGITS 3, incrementing \"#fffffffff\" by 1
+ causes it to wrap around to \"#000ffffff\"."
+ (concat "#"
+ (color-increment-hex (substring hex 1 (1+ nb-digits)) nb-digits increment wrap-p)
+ (substring hex (1+ nb-digits) (1+ (* nb-digits 2)))
+ (substring hex (1+ (* nb-digits 2)))))
+
+ (defun color-increment-green (hex nb-digits increment &optional wrap-p)
+ "Increment green component of RGB triplet string HEX by INCREMENT.
+ String HEX satisfies `color-rgb-hex-string-p'.
+ Each component in HEX is NB-DIGITS hex digits long.
+ If optional arg WRAP-P is non-nil then the result wraps around zero.
+ For example, with NB-DIGITS 3, incrementing \"#fffffffff\" by 1
+ causes it to wrap around to \"#fff000fff\"."
+ (concat
+ "#" (substring hex 1 (1+ nb-digits))
+ (color-increment-hex (substring hex (1+ nb-digits) (1+ (* nb-digits 2)))
+ nb-digits
+ increment
+ wrap-p)
+ (substring hex (1+ (* nb-digits 2)))))
+
+ (defun color-increment-blue (hex nb-digits increment &optional wrap-p)
+ "Increment blue component of RGB triplet string HEX by INCREMENT.
+ String HEX satisfies `color-rgb-hex-string-p'.
+ Each component in HEX is NB-DIGITS hex digits long.
+ If optional arg WRAP-P is non-nil then the result wraps around zero.
+ For example, with NB-DIGITS 3, incrementing \"#fffffffff\" by 1
+ causes it to wrap around to \"#ffffff000\"."
+ (concat "#" (substring hex 1 (1+ (* nb-digits 2)))
+ (color-increment-hex (substring hex (1+ (* nb-digits 2)))
+ nb-digits
+ increment
+ wrap-p)))
+
+ (defun color-increment-equal-rgb (hex nb-digits increment &optional wrap-p)
+ "Increment each color component (r,g,b) of rgb string HEX by INCREMENT.
+ String HEX starts with \"#\". Each color is NB-DIGITS hex digits long.
+ If optional arg WRAP-P is non-nil then the result wraps around zero.
+ For example, with NB-DIGITS 3, incrementing \"#fffffffff\" by 1
+ causes it to wrap around to \"#000000000\"."
+ (concat
+ "#"
+ (color-increment-hex (substring hex 1 (1+ nb-digits)) nb-digits increment wrap-p)
+ (color-increment-hex (substring hex (1+ nb-digits) (1+ (* nb-digits 2)))
+ nb-digits
+ increment
+ wrap-p)
+ (color-increment-hex (substring hex (1+ (* nb-digits 2))) nb-digits increment wrap-p)))
+
+
(provide 'color)
;;; color.el ends here
Diff finished. Wed Feb 16 15:59:47 2011
[-- Attachment #3: color-2011-02-16.el --]
[-- Type: application/octet-stream, Size: 35546 bytes --]
;;; color.el --- Color manipulation -*- coding: utf-8; -*-
;; Copyright (C) 2011 Free Software Foundation, Inc.
;; Author: Drew Adams <drew.adams@oracle.com>
;; Julien Danjou <julien@danjou.info>
;; Keywords: color, hex, rgb, hsv, hsl, cie-lab, background, display, face
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This library provides color manipulation functions.
;;
;; It provides functions for converting between RGB (red, green,
;; blue), HSV (hue, saturation, value), HSL (hue, saturation,
;; luminence), sRGB, CIE XYZ, and CIE L*a*b* color components. It
;; helps you convert among all of the following:
;;
;; * Emacs RGB color components (aka color "values"), which are whole
;; numbers from 0 through 65535
;; * RGB, HSV, HSL, sRGB, CIE XYZ, and CIE L*a*b* floating-point
;; components (0.0 through 1.0)
;; * Emacs color-name strings, such as "blue"
;; * RGB triplet strings, such as "#FC43A7912"
;;
;; An RGB triplet string has 1 + (3 * n) characters, the first of
;; which is "#". The other characters are hexadecimal digits, in
;; three groups representing (from the left): red, green, and blue
;; components.
;;
;; It also provides functions to do the following:
;; * Increment an RGB triplet (string) in various ways
;; * Return the complement of a color as an RGB triplet or components
;; * Return the CIEDE2000 color distance between two colors
;; * Return an individual floating-point RGB or HSV component of a
;; color-name or RGB triplet string
;;
;; FIXME/TODO (?):
;;
;; Add functions:
;; color-hex-to-hsl, color-hsl-to-hex, color-hsl-to-rgb,
;; color-hsv-radians-to-rgb, color-luminance
;; color-cie-ε: Add doc string
;; color-cie-κ: Add doc string
;; color-cie-de2000: Specify return value in doc string
;; color-lab-to-srgb: Specify return value in doc string
;; color-lab-to-xyz: Specify return value in doc string
;; color-srgb-to-lab: Specify return value in doc string
;; color-srgb-to-xyz: Specify return value in doc string
;; color-xyz-to-lab: Specify return value in doc string
;; color-xyz-to-srgb: Specify return value in doc string
;;; Code:
(eval-when-compile (require 'cl)) ; loop
;; Emacs < 23.3
(eval-and-compile
(unless (boundp 'float-pi)
(defconst float-pi (* 4 (atan 1)) "The math constant pi (3.141592653589793...).")))
(eval-and-compile
(defun color-canonicalize-defined-colors (list)
"Copy of LIST with color names canonicalized.
LIST is a list of color names (strings).
Canonical names are lowercase, with no whitespace.
There are no duplicate names."
(let ((tail list)
this new)
(while tail
(setq this (car tail)
this (color-delete-whitespace-from-string (downcase this) 0 (length this)))
(unless (member this new) (push this new))
(pop tail))
(nreverse new)))
(defun color-delete-whitespace-from-string (string &optional from to)
"Remove whitespace from substring of STRING from FROM to TO.
If FROM is nil, then start at the beginning of STRING (FROM = 0).
If TO is nil, then end at the end of STRING (TO = length of STRING).
FROM and TO are zero-based indexes into STRING.
Character FROM is affected (possibly deleted). Character TO is not."
(setq from (or from 0)
to (or to (length string)))
(with-temp-buffer
(insert string)
(goto-char (+ from (point-min)))
(let ((count from)
char)
(while (and (not (eobp)) (< count to))
(setq char (char-after))
(if (memq char '(?\ ?\t ?\n)) (delete-char 1) (forward-char 1))
(setq count (1+ count)))
(buffer-string)))))
(defconst color-defined-colors (eval-when-compile (and window-system (x-defined-colors)))
"List of all supported colors.")
(defconst color-defined-colors-no-dups
(eval-when-compile
(and window-system (color-canonicalize-defined-colors (x-defined-colors))))
"List of all supported color names, with no duplicates.
Names are all lowercase, without any spaces.")
(defconst color-d65-xyz '(0.950455 1.0 1.088753)
"D65 white point in CIE XYZ.")
;; FIXME/TODO? Add doc string
(defconst color-cie-ε (/ 216 24389.0))
;; FIXME/TODO? Add doc string
(defconst color-cie-κ (/ 24389 27.0))
(defcustom color-canonicalize-defined-colors-flag t
"*Non-nil means remove duplicate color names.
Names are considered duplicates if they are the same when abstracting
from whitespace and letter case."
:type 'boolean :group 'faces)
;; Use function `color-defined-colors', not the constants, so users
;; can change the behavior by customizing `color-canonicalize-defined-colors-flag'.
(defun color-defined-colors ()
"List of supported color names.
If `color-canonicalize-defined-colors-flag' is non-nil, then names
are lowercased, whitespace is removed, and there are no duplicates."
(if color-canonicalize-defined-colors-flag
color-defined-colors-no-dups
color-defined-colors))
(defun read-color (&optional prompt convert-to-RGB allow-empty-name msg)
"Read a color name or RGB triplet.
Completion is available for color names, but not for RGB triplets.
RGB triplets have the form #XXXXXXXXXXXX, where each X is a
hexadecimal digit. The number of X's must be a multiple of 3, with
the same number of X's for each of red, green, and blue. The order of
the color components is red, green, blue.
Color names that are normally considered equivalent are canonicalized:
They are lowercased, whitespace is removed, and duplicates are
eliminated. E.g. \"LightBlue\" and \"light blue\" are both replaced
by \"lightblue\". If you do not want this behavior, but want to
choose names that might contain whitespace or uppercase letters, then
customize option `color-canonicalize-defined-colors-flag' to nil.
In addition to standard color names and RGB hex components, the
following are available as color candidates. In each case, the
corresponding color is used.
* `foreground at point' - foreground under the cursor
* `background at point' - background under the cursor
Optional arg PROMPT is the prompt; if nil, use a default prompt.
Interactively, or with optional arg CONVERT-TO-RGB non-nil, convert an
input color name to an RGB triplet string. Return the triplet string.
Otherwise, return the user input (color name or triplet) as a string.
If optional arg ALLOW-EMPTY-NAME is non-nil, the user is allowed
to enter an empty color name (the empty string).
Interactively, or with optional arg MSG non-nil, print the returned
string in the echo area."
(interactive "i\np\ni\np") ; Always convert to RGB interactively.
(let* ((completion-ignore-case t)
(colors (or facemenu-color-alist
(append '("foreground at point" "background at point")
(if allow-empty-name '(""))
(color-defined-colors))))
(color (completing-read
(or prompt "Color (name or #RGB triplet): ")
;; Completing function for colors - accepts color names & RGB triplets.
(lambda (string pred flag)
(cond
((null flag) ; Try completion.
(or (try-completion string colors pred)
(if (color-defined-p string) string)))
((eq flag t) ; List all completions.
(or (all-completions string colors pred)
(if (color-defined-p string) (list string))))
((eq flag 'lambda) ; Test completion.
(or (memq string colors) (color-defined-p string)))))
nil t))
hex-string)
(when (member color colors)
(cond ((string-equal color "foreground at point")
(setq color (foreground-color-at-point)))
((string-equal color "background at point")
(setq color (background-color-at-point))))
(when (and convert-to-RGB (not (string-equal color "")))
(setq color (color-name-to-hex color))))
(when msg (message "Color: `%s'" color))
color))
(defun color-rgb-hex-string-p (color &optional laxp)
"Non-nil if COLOR is an RGB triplet string \"#XXXXXXXXXXXX\".
Each X is a hexadecimal digit. The number of X's must be a multiple
of 3, with the same number of X's for each of red, green, and blue.
The first group of X's is for red, the second is for green, the third
is for blue.
Non-nil optional arg LAXP means that the initial `#' is optional. In
that case, for a valid string of hex digits: when # is present 0 is
returned; otherwise, t is returned."
(or (string-match "^#\\([a-fA-F0-9][a-fA-F0-9][a-fA-F0-9]\\)+$" color)
(and laxp (string-match "^\\([a-fA-F0-9][a-fA-F0-9][a-fA-F0-9]\\)+$" color) t)))
;; This version is thanks to Juri Linkov <juri@jurta.org>.
(defun color-int-to-hex (int &optional nb-digits)
"Convert integer argument INT to a RGB triplet string.
The string satisfies `color-rgb-hex-string-p'.
NB-DIGITS is the number of hex digits. If INT is too large to be
represented with NB-DIGITS, then the result is truncated from the
left. So for example, INT=256 and NB-DIGITS=2 returns \"00\", since
the hex equivalent of 256 decimal is 100, which is more than 2 digits."
(setq nb-digits (or nb-digits 4))
(substring (format (concat "%0" (int-to-string nb-digits) "X") int) (- nb-digits)))
;; These are the color "values" of `x-color-values', `ps-color-values', and
;; `ps-e-x-color-values'. But especially given the use of "value" in HSV, "components" is
;; better in the name than "values".
(defun color-components-to-hex (components)
"Convert list of rgb color COMPONENTS to an RGB triplet string.
Input COMPONENTS is as for the output of `x-color-values'."
;; Just hard-code 4 as the number of hex digits, since `x-color-values'
;; seems to produce appropriate integer values.
(concat "#" (color-int-to-hex (nth 0 components) 4) ; red
(color-int-to-hex (nth 1 components) 4) ; green
(color-int-to-hex (nth 2 components) 4))) ; blue
(defun color-name-to-hex (color)
"Return the RGB triplet string for COLOR.
COLOR is a color name.
It can also be an RGB triplet, which is just returned as is.
The string returned satisfies `color-rgb-hex-string-p'."
(let ((components (x-color-values color)))
(unless components (error "No such color: %S" color))
(unless (color-rgb-hex-string-p color)
(setq color (color-components-to-hex components))))
color)
(defun color-rgb-to-hex (red green blue)
"Return the RBG triplet for inputs RED, GREEN, BLUE.
The inputs are each in the range 0 to 1, inclusive.
The string returned satisfies `color-rgb-hex-string-p'."
(color-components-to-hex
(mapcar (lambda (x) (floor (* x 65535.0))) (list red green blue))))
(defun color-hsv-to-hex (hue saturation value)
"Return the RBG triplet string for inputs HUE, SATURATION, and VALUE.
The inputs are each in the range 0 to 1, inclusive.
The string returned satisfies `color-rgb-hex-string-p'."
(color-components-to-hex
(mapcar (lambda (x) (floor (* x 65535.0))) (color-hsv-to-rgb hue saturation value))))
;; FIXME/TODO? (defun color-hsl-to-hex ...)
;; Same as `hexl-hex-char-to-integer', defined in `hexl.el'.
(defun color-hex-char-to-integer (character)
"Take a CHARACTER and return its value as if it were a hex digit."
(if (and (>= character ?0) (<= character ?9))
(- character ?0)
(let ((ch (logior character 32)))
(if (and (>= ch ?a) (<= ch ?f))
(- ch (- ?a 10))
(error "Invalid hex digit `%c'" ch)))))
(defun color-hex-to-int (hex)
"Convert hexadecimal string HEX to a whole-number value.
The characters of HEX must be hexadecimal-digit characters."
(let* ((factor 1)
(len (length hex))
(indx (1- len))
(int 0))
(while (>= indx 0)
(setq int (+ int (* factor (color-hex-char-to-integer (aref hex indx))))
indx (1- indx)
factor (* 16 factor)))
int))
(defun color-hex-to-components (rgb-triplet)
"Return the RGB color components for RGB-TRIPLET.
RGB-TRIPLET is an RGB triplet string (`color-rgb-hex-string-p').
The output list is as for `x-color-values'."
(let* ((hex-strgp (string-match
"^\\(#\\)?\\(\\([a-fA-F0-9][a-fA-F0-9][a-fA-F0-9]\\)+\\)$"
rgb-triplet))
(ndigits (/ (if (eq (match-beginning 1) (match-end 1))
(length rgb-triplet)
(1- (length rgb-triplet)))
3))
red green blue)
(unless hex-strgp (error "Invalid RGB triplet string: %s" rgb-triplet))
(setq rgb-triplet (substring rgb-triplet (match-beginning 2) (match-end 2))
red (color-hex-to-int (substring rgb-triplet 0 ndigits))
green (color-hex-to-int (substring rgb-triplet ndigits (* 2 ndigits)))
blue (color-hex-to-int (substring rgb-triplet (* 2 ndigits) (* 3 ndigits))))
(list red green blue)))
(defun color-hex-to-rgb (color)
"Return a list of RGB (red, green, blue) color components.
Each component is a value from 0.0 to 1.0, inclusive.
COLOR is a color name or RGB triplet string (satisfies
`color-rgb-hex-string-p')."
(unless (color-rgb-hex-string-p color) (setq color (color-name-to-hex color)))
(let ((len (/ (1- (length color)) 3)))
(list (/ (color-hex-to-int (substring color 1 (1+ len))) 65535.0)
(/ (color-hex-to-int (substring color (1+ len) (+ 1 len len))) 65535.0)
(/ (color-hex-to-int (substring color (+ 1 len len))) 65535.0))))
(defun color-hex-to-hsv (color)
"Return a list of HSV (hue, saturation, value) color components.
Each component is a value from 0.0 to 1.0, inclusive.
COLOR is a color name or RGB triplet string (satisfies
`color-rgb-hex-string-p')."
(let ((rgb-components (color-hex-to-rgb color)))
(apply #'color-rgb-to-hsv rgb-components)))
;; FIXME/TODO? (defun color-hex-to-hsl ...)
(defun color-red (color)
"Return the red component of COLOR, in range 0 to 1, inclusive.
COLOR is a color name or RGB triplet string."
(interactive (list (read-color)))
(setq color (color-name-to-hex color))
(/ (color-hex-to-int (substring color 1 (1+ (/ (1- (length color)) 3))))
(expt 16.0 (/ (1- (length color)) 3.0))))
(defun color-green (color)
"Return the green component of COLOR, in range 0 to 1, inclusive.
COLOR is a color name or RGB triplet string."
(interactive (list (read-color)))
(setq color (color-name-to-hex color))
(let* ((len (/ (1- (length color)) 3))
(start (1+ len)))
(/ (color-hex-to-int (substring color start (+ start len)))
(expt 16.0 (/ (1- (length color)) 3.0)))))
(defun color-blue (color)
"Return the blue component of COLOR, in range 0 to 1, inclusive.
COLOR is a color name or RGB triplet string."
(interactive (list (read-color)))
(setq color (color-name-to-hex color))
(let* ((len (/ (1- (length color)) 3))
(start (+ 1 len len)))
(/ (color-hex-to-int (substring color start (+ start len)))
(expt 16.0 (/ (1- (length color)) 3.0)))))
(defun color-hue (color)
"Return the hue component of COLOR, in range 0 to 1, inclusive.
COLOR is a color name or RGB triplet string."
(interactive (list (read-color)))
(setq color (color-name-to-hex color))
(car (color-rgb-to-hsv (color-red color) (color-green color) (color-blue color))))
(defun color-saturation (color)
"Return the saturation component of COLOR, in range 0 to 1, inclusive.
COLOR is a color name or RGB triplet string."
(interactive (list (read-color)))
(setq color (color-name-to-hex color))
(cadr (color-rgb-to-hsv (color-red color) (color-green color) (color-blue color))))
(defun color-value (color)
"Return the value component of COLOR, in range 0 to 1, inclusive.
COLOR is a color name or RGB triplet string."
(interactive (list (read-color)))
(setq color (color-name-to-hex color))
(caddr (color-rgb-to-hsv (color-red color) (color-green color) (color-blue color))))
;; FIXME/TODO? (defun color-luminance ...)
(defun color-rgb-normalize (color)
"Return the normalized RGB components of COLOR as a list.
COLOR is a color name or RGB triplet string.
Each component returned is 0 to 1, inclusive."
(mapcar (lambda (x) (/ x 65535.0)) (x-color-values color)))
(defun color-complement-hex (color-name)
"Return the complement of COLOR-NAME as an RGB triplet.
\(COLOR-NAME can also be an RGB triplet - it is just returned.)
Interactively, you are prompted for COLOR-NAME."
(interactive (list (read-color)))
(apply 'color-rgb-to-hex (color-complement-components color-name)))
(defun color-complement-components (color)
"Return the RGB color components for the complement of COLOR.
COLOR is a color name or RGB triplet string."
(let ((color (color-rgb-normalize color)))
(list (- 1.0 (car color)) (- 1.0 (cadr color)) (- 1.0 (caddr color)))))
(defun color-gradient (start stop step-number)
"Return a list with STEP-NUMBER colors from START to STOP.
The color list builds a color gradient starting at color START to
color STOP. It does not include the START and STOP colors 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)))))
;; From Elisp Info manual, node "Comparison of Numbers".
(defun color-approx-equal (x y &optional rfuzz afuzz)
"Return non-nil if numbers X and Y are approximately equal.
RFUZZ is a relative fuzz factor. AFUZZ is an absolute fuzz factor.
RFUZZ defaults to 1.0e-8. AFUZZ defaults to (/ RFUZZ 10).
RFUZZ and AFUZZ are converted to their absolute values.
The algorithm is:
(< (abs (- X Y)) (+ AFUZZ (* RFUZZ (+ (abs X) (abs Y)))))."
(setq rfuzz (or rfuzz 1.0e-8)
rfuzz (abs rfuzz)
afuzz (or afuzz (/ rfuzz 10))
afuzz (abs afuzz))
(< (abs (- x y)) (+ afuzz (* rfuzz (+ (abs x) (abs y))))))
(defun color-rgb-to-hsv (red green blue)
"Convert RED, GREEN, BLUE components to HSV (hue, saturation, value).
Each input component is 0.0 to 1.0, inclusive.
Returns a list of HSV components of value 0.0 to 1.0, inclusive."
(let* ((min (min red green blue))
(max (max red green blue))
(value max)
(delta (- max min))
hue saturation)
(if (color-approx-equal 0.0 delta)
(setq hue 0.0
saturation 0.0) ; Gray scale - no color; only value.
(if (and (condition-case nil
(setq saturation (/ delta max))
(arith-error nil))
;; Must be a number, not a NaN. Standard test for a NaN is (not (= N N)),
(= saturation saturation))
(if (color-approx-equal 0.0 saturation)
(setq hue 0.0
saturation 0.0) ; Again, no color - only value.
(setq hue (if (color-approx-equal red max)
(/ (- green blue) delta) ; Between yellow & magenta.
(if (color-approx-equal green max)
(+ 2.0 (/ (- blue red) delta)) ; Between cyan & yellow.
(+ 4.0 (/ (- red green) delta)))) ; Between magenta & cyan.
hue (/ hue 6.0))
(when (< hue 0.0) (setq hue (+ hue 1.0)))
(when (> hue 1.0) (setq hue (- hue 1.0))))
(setq hue 0.0 ; Div by zero (max=0): H:=0, S:=0. (Hue undefined.)
saturation 0.0)))
(list hue saturation value)))
(defun color-rgb-to-hsv-radians (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))
(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))))
;; FIXME/TODO? (defun color-hsv-radians-to-rgb ...)
(defun color-hsv-to-rgb (hue saturation value)
"Convert HUE, SATURATION, VALUE components to RGB (red, green, blue).
Each input component is 0.0 to 1.0, inclusive.
Returns a list of RGB components of value 0.0 to 1.0, inclusive."
(let (red green blue int-hue fract pp qq tt ww)
(if (color-approx-equal 0.0 saturation)
(setq red value
green value
blue value) ; Gray
(setq hue (* hue 6.0) ; Sectors: 0 to 5
int-hue (floor hue)
fract (- hue int-hue)
pp (* value (- 1 saturation))
qq (* value (- 1 (* saturation fract)))
ww (* value (- 1 (* saturation (- 1 (- hue int-hue))))))
(case int-hue
((0 6) (setq red value
green ww
blue pp))
(1 (setq red qq
green value
blue pp))
(2 (setq red pp
green value
blue ww))
(3 (setq red pp
green qq
blue value))
(4 (setq red ww
green pp
blue value))
(otherwise (setq red value
green pp
blue qq))))
(list 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 from 0 to 1, inclusive."
(let* ((r red)
(g green)
(b blue)
(max (max r g b))
(min (min r g b))
(delta (- max min))
(l (/ (+ max min) 2.0)))
(list
(if (= max min)
0
(* 2 float-pi
(/ (cond ((= max r)
(+ (/ (- g b) delta) (if (< g b) 6 0)))
((= max g)
(+ (/ (- b r) delta) 2))
(t
(+ (/ (- r g) delta) 4)))
6)))
(if (= max min)
0
(if (> l 0.5)
(/ delta (- 2 (+ max min)))
(/ delta (+ max min))))
l)))
;; FIXME/TODO? (defun color-hsl-to-rgb ...)
;; FIXME/TODO? Specify return value in doc string.
(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 from 0 to 1, inclusive."
(let ((r (if (<= red 0.04045)
(/ red 12.95)
(expt (/ (+ red 0.055) 1.055) 2.4)))
(g (if (<= green 0.04045)
(/ green 12.95)
(expt (/ (+ green 0.055) 1.055) 2.4)))
(b (if (<= blue 0.04045)
(/ blue 12.95)
(expt (/ (+ blue 0.055) 1.055) 2.4))))
(list (+ (* 0.4124564 r) (* 0.3575761 g) (* 0.1804375 b))
(+ (* 0.21266729 r) (* 0.7151522 g) (* 0.0721750 b))
(+ (* 0.0193339 r) (* 0.1191920 g) (* 0.9503041 b)))))
;; FIXME/TODO? Specify return value in doc string.
(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))))
(list (if (<= r 0.0031308)
(* 12.92 r)
(- (* 1.055 (expt r (/ 1 2.4))) 0.055))
(if (<= g 0.0031308)
(* 12.92 g)
(- (* 1.055 (expt g (/ 1 2.4))) 0.055))
(if (<= b 0.0031308)
(* 12.92 b)
(- (* 1.055 (expt b (/ 1 2.4))) 0.055)))))
;; FIXME/TODO? Specify return value in doc string.
(defun color-xyz-to-lab (X Y Z &optional white-point)
"Convert 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."
(destructuring-bind (Xr Yr Zr) (or white-point color-d65-xyz)
(let* ((xr (/ X Xr))
(yr (/ Y Yr))
(zr (/ Z Zr))
(fx (if (> xr color-cie-ε)
(expt xr (/ 1 3.0))
(/ (+ (* color-cie-κ xr) 16) 116.0)))
(fy (if (> yr color-cie-ε)
(expt yr (/ 1 3.0))
(/ (+ (* color-cie-κ yr) 16) 116.0)))
(fz (if (> zr color-cie-ε)
(expt zr (/ 1 3.0))
(/ (+ (* color-cie-κ zr) 16) 116.0))))
(list
(- (* 116 fy) 16) ; L
(* 500 (- fx fy)) ; a
(* 200 (- fy fz)))))) ; b
;; FIXME/TODO? Specify return value in doc string.
(defun color-lab-to-xyz (L a b &optional white-point)
"Convert 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."
(destructuring-bind (Xr Yr Zr) (or white-point color-d65-xyz)
(let* ((fy (/ (+ L 16) 116.0))
(fz (- fy (/ b 200.0)))
(fx (+ (/ a 500.0) fy))
(xr (if (> (expt fx 3.0) color-cie-ε)
(expt fx 3.0)
(/ (- (* fx 116) 16) color-cie-κ)))
(yr (if (> L (* color-cie-κ color-cie-ε))
(expt (/ (+ L 16) 116.0) 3.0)
(/ L color-cie-κ)))
(zr (if (> (expt fz 3) color-cie-ε)
(expt fz 3.0)
(/ (- (* 116 fz) 16) color-cie-κ))))
(list (* xr Xr) ; X
(* yr Yr) ; Y
(* zr Zr))))) ; Z
;; FIXME/TODO? Specify return value in doc string.
(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)))
;; FIXME/TODO? Specify return value in doc string.
(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)))
;; FIXME/TODO? Specify return value in doc string.
(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."
(destructuring-bind (L₁ a₁ b₁) color1
(destructuring-bind (L₂ a₂ b₂) color2
(let* ((kL (or kL 1))
(kC (or kC 1))
(kH (or kH 1))
(C₁ (sqrt (+ (expt a₁ 2.0) (expt b₁ 2.0))))
(C₂ (sqrt (+ (expt a₂ 2.0) (expt b₂ 2.0))))
(C̄ (/ (+ C₁ C₂) 2.0))
(G (* 0.5 (- 1 (sqrt (/ (expt C̄ 7.0) (+ (expt C̄ 7.0) (expt 25 7.0)))))))
(a′₁ (* (+ 1 G) a₁))
(a′₂ (* (+ 1 G) a₂))
(C′₁ (sqrt (+ (expt a′₁ 2.0) (expt b₁ 2.0))))
(C′₂ (sqrt (+ (expt a′₂ 2.0) (expt b₂ 2.0))))
(h′₁ (if (and (= b₁ 0) (= a′₁ 0))
0
(let ((v (atan b₁ a′₁)))
(if (< v 0)
(+ v (* 2 float-pi))
v))))
(h′₂ (if (and (= b₂ 0) (= a′₂ 0))
0
(let ((v (atan b₂ a′₂)))
(if (< v 0)
(+ v (* 2 float-pi))
v))))
(ΔL′ (- L₂ L₁))
(ΔC′ (- C′₂ C′₁))
(Δh′ (cond ((= (* C′₁ C′₂) 0)
0)
((<= (abs (- h′₂ h′₁)) float-pi)
(- h′₂ h′₁))
((> (- h′₂ h′₁) float-pi)
(- (- h′₂ h′₁) (* 2 float-pi)))
((< (- h′₂ h′₁) (- float-pi))
(+ (- h′₂ h′₁) (* 2 float-pi)))))
(ΔH′ (* 2 (sqrt (* C′₁ C′₂)) (sin (/ Δh′ 2.0))))
(L̄′ (/ (+ L₁ L₂) 2.0))
(C̄′ (/ (+ C′₁ C′₂) 2.0))
(h̄′ (cond ((= (* C′₁ C′₂) 0)
(+ h′₁ h′₂))
((<= (abs (- h′₁ h′₂)) float-pi)
(/ (+ h′₁ h′₂) 2.0))
((< (+ h′₁ h′₂) (* 2 float-pi))
(/ (+ h′₁ h′₂ (* 2 float-pi)) 2.0))
((>= (+ h′₁ h′₂) (* 2 float-pi))
(/ (+ h′₁ h′₂ (* -2 float-pi)) 2.0))))
(T (+ 1
(- (* 0.17 (cos (- h̄′ (degrees-to-radians 30)))))
(* 0.24 (cos (* h̄′ 2)))
(* 0.32 (cos (+ (* h̄′ 3) (degrees-to-radians 6))))
(- (* 0.20 (cos (- (* h̄′ 4) (degrees-to-radians 63)))))))
(Δθ (* (degrees-to-radians 30)
(exp (- (expt (/ (- h̄′ (degrees-to-radians 275)) (degrees-to-radians 25))
2.0)))))
(Rc (* 2 (sqrt (/ (expt C̄′ 7.0) (+ (expt C̄′ 7.0) (expt 25.0 7.0))))))
(Sl (+ 1 (/ (* 0.015 (expt (- L̄′ 50) 2.0)) (sqrt (+ 20 (expt (- L̄′ 50) 2.0))))))
(Sc (+ 1 (* C̄′ 0.045)))
(Sh (+ 1 (* 0.015 C̄′ T)))
(Rt (- (* (sin (* Δθ 2)) Rc))))
(sqrt (+ (expt (/ ΔL′ (* Sl kL)) 2.0)
(expt (/ ΔC′ (* Sc kC)) 2.0)
(expt (/ ΔH′ (* Sh kH)) 2.0)
(* Rt (/ ΔC′ (* Sc kC)) (/ ΔH′ (* Sh kH)))))))))
(defun color-component-to-float (n)
"Return the floating-point equivalent of color-component value N.
N must be an integer between 0 and 65535, or else an error is raised."
(unless (and (wholenump n) (<= n 65535))
(error "Not a whole number less than 65536"))
(/ (float n) 65535.0))
(defun color-float-to-component (x)
"Return the color-component value equivalent of floating-point number X.
X must be between 0.0 and 1.0, or else an error is raised."
(unless (and (numberp x) (<= 0.0 x) (<= x 1.0))
(error "Not a floating-point number between 0.0 and 1.0"))
(floor (* x 65535.0)))
(defun color-increment-hex (hex nb-digits increment &optional wrap-p)
"Increment HEX number (a string NB-DIGITS long) by INCREMENT.
If optional arg WRAP-P is non-nil then the result wraps around zero.
For example, with NB-DIGITS 3, incrementing \"fff\" by 1 causes it
to wrap around to \"000\"."
(let* ((int (color-hex-to-int hex))
(new-int (+ increment int)))
(if (or wrap-p
(and (>= int 0) ; Not too large for the machine.
(>= new-int 0) ; For the case where increment < 0.
(<= (length (format (concat "%X") new-int)) nb-digits))) ; Not too long.
(color-int-to-hex new-int nb-digits) ; Use incremented number.
hex))) ; Don't increment.
(defun color-increment-red (hex nb-digits increment &optional wrap-p)
"Increment red component of RGB triplet string HEX by INCREMENT.
String HEX satisfies `color-rgb-hex-string-p'.
Each component in HEX is NB-DIGITS hex digits long.
If optional arg WRAP-P is non-nil then the result wraps around zero.
For example, with NB-DIGITS 3, incrementing \"#fffffffff\" by 1
causes it to wrap around to \"#000ffffff\"."
(concat "#"
(color-increment-hex (substring hex 1 (1+ nb-digits)) nb-digits increment wrap-p)
(substring hex (1+ nb-digits) (1+ (* nb-digits 2)))
(substring hex (1+ (* nb-digits 2)))))
(defun color-increment-green (hex nb-digits increment &optional wrap-p)
"Increment green component of RGB triplet string HEX by INCREMENT.
String HEX satisfies `color-rgb-hex-string-p'.
Each component in HEX is NB-DIGITS hex digits long.
If optional arg WRAP-P is non-nil then the result wraps around zero.
For example, with NB-DIGITS 3, incrementing \"#fffffffff\" by 1
causes it to wrap around to \"#fff000fff\"."
(concat
"#" (substring hex 1 (1+ nb-digits))
(color-increment-hex (substring hex (1+ nb-digits) (1+ (* nb-digits 2)))
nb-digits
increment
wrap-p)
(substring hex (1+ (* nb-digits 2)))))
(defun color-increment-blue (hex nb-digits increment &optional wrap-p)
"Increment blue component of RGB triplet string HEX by INCREMENT.
String HEX satisfies `color-rgb-hex-string-p'.
Each component in HEX is NB-DIGITS hex digits long.
If optional arg WRAP-P is non-nil then the result wraps around zero.
For example, with NB-DIGITS 3, incrementing \"#fffffffff\" by 1
causes it to wrap around to \"#ffffff000\"."
(concat "#" (substring hex 1 (1+ (* nb-digits 2)))
(color-increment-hex (substring hex (1+ (* nb-digits 2)))
nb-digits
increment
wrap-p)))
(defun color-increment-equal-rgb (hex nb-digits increment &optional wrap-p)
"Increment each color component (r,g,b) of rgb string HEX by INCREMENT.
String HEX starts with \"#\". Each color is NB-DIGITS hex digits long.
If optional arg WRAP-P is non-nil then the result wraps around zero.
For example, with NB-DIGITS 3, incrementing \"#fffffffff\" by 1
causes it to wrap around to \"#000000000\"."
(concat
"#"
(color-increment-hex (substring hex 1 (1+ nb-digits)) nb-digits increment wrap-p)
(color-increment-hex (substring hex (1+ nb-digits) (1+ (* nb-digits 2)))
nb-digits
increment
wrap-p)
(color-increment-hex (substring hex (1+ (* nb-digits 2))) nb-digits increment wrap-p)))
(provide 'color)
;;; color.el ends here
^ permalink raw reply [flat|nested] 8+ messages in thread
* Re: color.el
2011-02-17 0:23 color.el Drew Adams
@ 2011-02-19 18:33 ` Chong Yidong
2011-02-20 0:17 ` color.el Drew Adams
2011-02-20 1:10 ` color.el Miles Bader
0 siblings, 2 replies; 8+ messages in thread
From: Chong Yidong @ 2011-02-19 18:33 UTC (permalink / raw)
To: Drew Adams; +Cc: emacs-devel
"Drew Adams" <drew.adams@oracle.com> writes:
> I thought that `hexrgb.el' and `color-lab.el' were going to be merged.
>
> I've merged the two libraries now, moved `read-color' to it, and
> cleaned things up (e.g. doc). When there was overlap I kept the best
> version (e.g. most precise or most general). I did not include
> anything from `eyedropper.el' (e.g. for `read-color').
Thanks. I'll start applying some parts of the patch shortly, but here
are a few points worth discussing:
1. Renaming color-rgb->hsv to color-rgb-to-hsv, etc.
The latter is a bit more in line with other Emacs Lisp function
names, though we do have a few named "X->Y".
Any thoughts from Emacs developers? I am not sure myself.
2. Returning HUE in [0,1], rather than radians, by default.
If we do this, I'd rather not add a separate *-radians function; we
should just decide on whether Emacs should represent hue as [0,1], as
radians, or as [0,360], and use that everywhere.
For what it's worth, the Gimp, the Java color library, and the
Eclipse API all use [0,360]. Maybe we should do follow suit. Any
objections?
3. The functions for incrementing color components don't look very
useful to me. Surely it's simple enough for a Lisp program to
increment a member of a list. Is there any real world example of a
program using this part of hexrgb?
^ permalink raw reply [flat|nested] 8+ messages in thread
* RE: color.el
2011-02-19 18:33 ` color.el Chong Yidong
@ 2011-02-20 0:17 ` Drew Adams
2011-02-20 1:10 ` color.el Miles Bader
1 sibling, 0 replies; 8+ messages in thread
From: Drew Adams @ 2011-02-20 0:17 UTC (permalink / raw)
To: 'Chong Yidong'; +Cc: emacs-devel
[-- Attachment #1: Type: text/plain, Size: 6647 bytes --]
> Thanks. I'll start applying some parts of the patch shortly, but here
> are a few points worth discussing:
>
> 1. Renaming color-rgb->hsv to color-rgb-to-hsv, etc.
>
> The latter is a bit more in line with other Emacs Lisp function
> names, though we do have a few named "X->Y".
>
> Any thoughts from Emacs developers? I am not sure myself.
I applied the renamings for the following reasons, but you can choose whatever
names you like:
a. There is already another function `color-rgb-to-hsv', in `facemenu.el'. As I
said, I did not send a patch for `facemenu.el'. Presumably that function as
well as `read-color' would be removed from `facemenu.el' in favor of those
functions in `color.el'. (You might also consider moving `list-colors-display'
to `color.el'.)
b. There was one of the *->* functions that was not in fact a *-to-* function:
`color-rgb->normalize'. IOW, it probably should not have followed the same
naming convention. I renamed it to `color-rgb-normalize', not to
`color-rgb-to-normalize'. (When the name includes *-to-* it is arguably easier
to see it as a conversion function.)
c. The hexrgb.el functions that were merged follow the *-to-* naming convention.
d. Only two more characters are needed for *-to-* than for *->*, and the former
is more readable, IMO - clear to anyone without wondering what the meaning of ->
might be.
e. There are many, many *-to-* functions in Emacs, and many (most?) of them
represent conversions of some kind. On the other hand, the only *->* functions
in Emacs are the internal functions `compilation--*->*' and
`completion-pcm--pattern->regex', in all of which I think the `->' represents
essentially field selection, not format or data conversion.
Yes, those are all relatively minor reasons, but they are the reasons behind the
names used.
> 2. Returning HUE in [0,1], rather than radians, by default.
>
> If we do this, I'd rather not add a separate *-radians function; we
> should just decide on whether Emacs should represent hue
> as [0,1], as radians, or as [0,360], and use that everywhere.
The code I sent does not use [0,360] or radians. It uses decimal [0,1] for hue
just as for all the other color components (red, green, blue, saturation,
value). It uses the same units and ranges for component inputs and outputs, as
well as for all component types.
In practice, both [0,360] and [0,1] are common representations for hue,
depending somewhat on the emphasis wrt use. But [0,255] is also common for RGB
- and even for HSV. [0,360] is not used for any component other than hue,
AFAIK.
I don't see a problem with having two different functions that return these two
kinds of values, for that reason: convenience for different uses.
I have used the `hexrgb.el' version of RGB-to-HSV for a long time and find that
it handles corner cases well. I can't vouch for the radians version provided.
That function is not used in the rest of the `color.el' code - I don't know if
it has been used in any Emacs code yet.
(Note: I meant to also add a FIXME/TODO? comment for that radians version: the
acceptable input RGB values need to be described. They are apparently [0,255],
not [0,1].)
In my own use I've found using decimal numbers for all components, and for both
input and output values, to be convenient. Same kind of number, same range
[0,1], for everything. Simple.
That is easily interpreted by users (e.g. as percentages), easily incremented
etc. in the same way over and over, and so on. That's to be contrasted with
sometimes using [0,255] for RGB input; sometimes using [0,1] for RGB input;
using [0,1] for S and V; and using [0,360] for H.
And you will notice that no conversions have yet been provided by the
`color-lab.el' code for radian HSV or HSL to RGB (see the FIXME/TODO? comments I
added for that). Which RGB units and range would be used for the output of such
functions - [0,1] or [0,255]?
The interpretation of hue as an angle around a color cone or color wheel is fine
for explaining things but is not always so useful in practice (e.g. GUI's).
Look, for instance, at these typical color editors from the Wikipedia page
describing HSV and HSL:
http://en.wikipedia.org/wiki/File:Hsl-hsv-colorpickers.svg. Even though the
explanation of hue that accompanies that illustration (on the HSV/HSL page)
shows a color cone to introduce the concepts, this illustration indicates that
in practice GUIs often use the same unit and range for all HSV components.
As another commonly used example, see the attached screenshot of the color
editor used in MS Word - it uses [0,255] for each component, for both RGB and
HSL. (On the other hand, both Gimp and Photoshop use [0,360] for hue.)
> For what it's worth, the Gimp, the Java color library, and the
> Eclipse API all use [0,360]. Maybe we should do follow suit. Any
> objections?
I would object, but perhaps that doesn't count. ;-) IMO, Occam's razor argues
for using the same units and ranges for all components and for both input and
output.
Unless a user is really thinking in terms of a color cone or color wheel, there
is little reason to employ 0-360 or radians, IMO. Percentage is sensible enough
to users. (That's so even though it is true that 0% hue = 100% hue - just as 0
deg = 360 deg and 0 rad = 2 pi rad.)
And using the same units and ranges for input and output facilitates iteration
and chaining.
> 3. The functions for incrementing color components don't look very
> useful to me. Surely it's simple enough for a Lisp program to
> increment a member of a list. Is there any real world example of a
> program using this part of hexrgb?
The input and output are both RGB triplets, so you can apply the functions
iteratively. Since such string triplets are used directly by Emacs for faces
and frame parameter values, you can iteratively adjust those values directly.
Staying within RGB triplets is quite handy, including wrt wraparound (F->0,
0->F) and wrt feedback for users.
I use those increment functions in `doremi-frm.el' for defining commands that
repeatedly increment various color components of different objects (faces, frame
fg/bg).
For example, command `doremi-face-fg+' lets a user incrementally change the
foreground color of a given face - s?he can switch the color component
(r,g,b,h,s,v) to be incremented at any time, and s?he can change the increment
size at any time.
There are other, similar such Do Re Mi commands. Those command definitions
build on other `doremi-frm.el' functions, which in turn build on the
`hexrgb-increment-*' functions.
http://www.emacswiki.org/emacs/doremi-frm.el
[-- Attachment #2: throw-MS-Word-color-editor.PNG --]
[-- Type: image/png, Size: 18291 bytes --]
^ permalink raw reply [flat|nested] 8+ messages in thread
* Re: color.el
2011-02-19 18:33 ` color.el Chong Yidong
2011-02-20 0:17 ` color.el Drew Adams
@ 2011-02-20 1:10 ` Miles Bader
2011-02-20 3:19 ` color.el Drew Adams
1 sibling, 1 reply; 8+ messages in thread
From: Miles Bader @ 2011-02-20 1:10 UTC (permalink / raw)
To: Chong Yidong; +Cc: Drew Adams, emacs-devel
Chong Yidong <cyd@stupidchicken.com> writes:
> 2. Returning HUE in [0,1], rather than radians, by default.
>
> If we do this, I'd rather not add a separate *-radians function; we
> should just decide on whether Emacs should represent hue as [0,1], as
> radians, or as [0,360], and use that everywhere.
>
> For what it's worth, the Gimp, the Java color library, and the
> Eclipse API all use [0,360]. Maybe we should do follow suit. Any
> objections?
Radians seem cleaner; an argument range of 0-360 only seems useful if an
interface is primarily user-level (e.g. a spec in a web page or something).
-miles
--
Run away! Run away!
^ permalink raw reply [flat|nested] 8+ messages in thread
* RE: color.el
2011-02-20 1:10 ` color.el Miles Bader
@ 2011-02-20 3:19 ` Drew Adams
2011-02-20 4:07 ` color.el Miles Bader
0 siblings, 1 reply; 8+ messages in thread
From: Drew Adams @ 2011-02-20 3:19 UTC (permalink / raw)
To: 'Miles Bader', 'Chong Yidong'; +Cc: emacs-devel
> Radians seem cleaner; an argument range of 0-360 only seems
> useful if an interface is primarily user-level (e.g. a spec
> in a web page or something).
Cleaner than what? than [0,360]? than [0,1]? than both?
And why? In particular, why would [0,2*pi] be cleaner than [0,1]?
I agree (if you are saying this) that the input and return values of these
functions should not assume only or even primarily user-level use cases (e.g.
web-page color spec). They should be general functions. This is essentially a
utility library of building-block functions.
IMO, the values should be of the same type (a) for all components (r,g,b,h,s,v),
and (b) for both input and return values. We should not be sometimes passing in
[0,1] for RGB and other times passing in [0,255] for RGB. Similarly for return
values. And we should not use [0,360] for H but [0,1] for S and V.
^ permalink raw reply [flat|nested] 8+ messages in thread
* Re: color.el
2011-02-20 3:19 ` color.el Drew Adams
@ 2011-02-20 4:07 ` Miles Bader
2011-02-20 15:44 ` color.el Drew Adams
2011-02-21 17:30 ` color.el Chong Yidong
0 siblings, 2 replies; 8+ messages in thread
From: Miles Bader @ 2011-02-20 4:07 UTC (permalink / raw)
To: Drew Adams; +Cc: 'Chong Yidong', emacs-devel
"Drew Adams" <drew.adams@oracle.com> writes:
>> Radians seem cleaner; an argument range of 0-360 only seems
>> useful if an interface is primarily user-level (e.g. a spec
>> in a web page or something).
>
> Cleaner than what? than [0,360]? than [0,1]? than both?
> And why? In particular, why would [0,2*pi] be cleaner than [0,1]?
Actually I was just comparing to 0-360; I agree that 0-1 is probably the
best of them all.
[A possible exception might be if you're trying very hard to avoid
consing; then maybe any use of floats is undesirable. It doesn't seem
that's considered an issue with this API tho...]
> I agree (if you are saying this) that the input and return values of these
> functions should not assume only or even primarily user-level use cases (e.g.
> web-page color spec). They should be general functions. This is essentially a
> utility library of building-block functions.
Agree.
> IMO, the values should be of the same type (a) for all components (r,g,b,h,s,v),
> and (b) for both input and return values. We should not be sometimes passing in
> [0,1] for RGB and other times passing in [0,255] for RGB. Similarly for return
> values. And we should not use [0,360] for H but [0,1] for S and V.
I agree.
I'd rather not ever use 0-255 in the interface though. _If_ it's
sometimes desirable to use integers instead of floats for color
components, 0-65535 gives higher resolution, is already in use by Emacs
color functions (`color-values'), and can be efficiently (without
division) converted to 0-255 internally when that range is desirable
(for backends or whatever).
-Miles
--
Dinanzi a me non fuor cose create
se non etterne, e io etterno duro.
Lasciate ogne speranza, voi ch'intrate.
^ permalink raw reply [flat|nested] 8+ messages in thread
* RE: color.el
2011-02-20 4:07 ` color.el Miles Bader
@ 2011-02-20 15:44 ` Drew Adams
2011-02-21 17:30 ` color.el Chong Yidong
1 sibling, 0 replies; 8+ messages in thread
From: Drew Adams @ 2011-02-20 15:44 UTC (permalink / raw)
To: 'Miles Bader'; +Cc: 'Chong Yidong', emacs-devel
> > IMO, the values should be of the same type (a) for all
> > components (r,g,b,h,s,v), and (b) for both input and
> > return values. We should not be sometimes passing in
> > [0,1] for RGB and other times passing in [0,255] for RGB.
> > Similarly for return values. And we should not use [0,360]
> > for H but [0,1] for S and V.
>
> I agree.
>
> I'd rather not ever use 0-255 in the interface though. _If_ it's
> sometimes desirable to use integers instead of floats for color
> components, 0-65535 gives higher resolution, is already in use by
> Emacs color functions (`color-values'), and can be efficiently (without
> division) converted to 0-255 internally when that range is desirable
> (for backends or whatever).
I agree.
^ permalink raw reply [flat|nested] 8+ messages in thread
* Re: color.el
2011-02-20 4:07 ` color.el Miles Bader
2011-02-20 15:44 ` color.el Drew Adams
@ 2011-02-21 17:30 ` Chong Yidong
1 sibling, 0 replies; 8+ messages in thread
From: Chong Yidong @ 2011-02-21 17:30 UTC (permalink / raw)
To: Miles Bader; +Cc: Drew Adams, emacs-devel
Miles Bader <miles@gnu.org> writes:
>>> Radians seem cleaner; an argument range of 0-360 only seems useful
>>> if an interface is primarily user-level (e.g. a spec in a web page
>>> or something).
>>
>> Cleaner than what? than [0,360]? than [0,1]? than both? And why?
>> In particular, why would [0,2*pi] be cleaner than [0,1]?
>
> Actually I was just comparing to 0-360; I agree that 0-1 is probably
> the best of them all.
Fair enough; let's go with [0,1].
^ permalink raw reply [flat|nested] 8+ messages in thread
end of thread, other threads:[~2011-02-21 17:30 UTC | newest]
Thread overview: 8+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2011-02-17 0:23 color.el Drew Adams
2011-02-19 18:33 ` color.el Chong Yidong
2011-02-20 0:17 ` color.el Drew Adams
2011-02-20 1:10 ` color.el Miles Bader
2011-02-20 3:19 ` color.el Drew Adams
2011-02-20 4:07 ` color.el Miles Bader
2011-02-20 15:44 ` color.el Drew Adams
2011-02-21 17:30 ` color.el Chong Yidong
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).