;;; color.el --- Color manipulation library -*- coding: utf-8; -*-
-;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2014 Free Software Foundation, Inc.
;; Authors: Julien Danjou <julien@danjou.info>
;; Drew Adams <drew.adams@oracle.com>
;;; Code:
-(eval-when-compile
- (require 'cl))
-
;; Emacs < 23.3
(eval-and-compile
(unless (boundp 'float-pi)
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
+Optional argument 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."
;; `colors-values' maximum value is either 65535 or 65280 depending on the
- ;; display system. So we use a white conversion to get the max value.
+ ;; display system. So we use a white conversion to get the max value.
(let ((valmax (float (car (color-values "#ffffff")))))
(mapcar (lambda (x) (/ x valmax)) (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."
+RED, GREEN, and BLUE should be numbers between 0.0 and 1.0, inclusive."
(format "#%02x%02x%02x"
(* red 255) (* green 255) (* blue 255)))
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)))))
+ (list (- 1.0 (nth 0 color))
+ (- 1.0 (nth 1 color))
+ (- 1.0 (nth 2 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
+color STOP. It does not include the START and STOP color in the
resulting list."
(let* ((r (nth 0 start))
(g (nth 1 start))
result))
(nreverse result)))
+(defun color-hue-to-rgb (v1 v2 h)
+ "Compute hue from V1 and V2 H.
+Used internally by `color-hsl-to-rgb'."
+ (cond
+ ((< h (/ 1.0 6)) (+ v1 (* (- v2 v1) h 6.0)))
+ ((< h 0.5) v2)
+ ((< h (/ 2.0 3)) (+ v1 (* (- v2 v1) (- (/ 2.0 3) h) 6.0)))
+ (t v1)))
+
+(defun color-hsl-to-rgb (H S L)
+ "Convert hue, saturation and luminance to their RGB representation.
+H, S, and L should each be numbers between 0.0 and 1.0, inclusive.
+Return a list (RED GREEN BLUE), where each element is between 0.0 and 1.0,
+inclusive."
+ (if (= S 0.0)
+ (list L L L)
+ (let* ((m2 (if (<= L 0.5)
+ (* L (+ 1.0 S))
+ (- (+ L S) (* L S))))
+ (m1 (- (* 2.0 L) m2)))
+ (list
+ (color-hue-to-rgb m1 m2 (mod (+ H (/ 1.0 3)) 1))
+ (color-hue-to-rgb m1 m2 H)
+ (color-hue-to-rgb m1 m2 (mod (- H (/ 1.0 3)) 1))))))
+
(defun color-complement-hex (color)
"Return the color that is the complement of COLOR, in hexadecimal format."
(apply 'color-rgb-to-hex (color-complement color)))
(defun color-rgb-to-hsv (red green blue)
- "Convert RED, GREEN, and BLUE color components to HSV.
+ "Convert RGB 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
+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))
(max (max r g b))
(min (min r g b)))
(if (< (- max min) 1e-8)
- (list 0.0 0.0 0.0)
+ (list 0.0 0.0 min)
(list
(/ (* 2 float-pi
(cond ((and (= r g) (= g b)) 0)
(+ 240 (* 60 (/ (- r g) (- max min)))))))
360)
(if (= max 0) 0 (- 1 (/ min max)))
- (/ max 255.0)))))
+ max))))
(defun color-rgb-to-hsl (red green blue)
- "Convert RED GREEN BLUE colors to their HSL representation.
+ "Convert RGB colors to their HSL representation.
RED, GREEN, and BLUE should each be numbers between 0.0 and 1.0,
-inclusive.
-
-Return a list (HUE, SATURATION, LUMINANCE), where HUE is in radians
-and both SATURATION and LUMINANCE are between 0.0 and 1.0,
-inclusive."
+inclusive. Return a list (HUE SATURATION LUMINANCE), where
+each element is between 0.0 and 1.0, inclusive."
(let* ((r red)
(g green)
(b blue)
(min (min r g b))
(delta (- max min))
(l (/ (+ max min) 2.0)))
- (list
- (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))
- (t
- (+ (/ (- r g) delta) 4)))
- 6)))
- (if (= max min)
- 0
- (if (> l 0.5)
- (/ delta (- 2 (+ max min)))
- (/ delta (+ max min))))
- l)))
+ (if (= delta 0)
+ (list 0.0 0.0 l)
+ (let* ((s (if (<= l 0.5) (/ delta (+ max min))
+ (/ delta (- 2.0 max min))))
+ (rc (/ (- max r) delta))
+ (gc (/ (- max g) delta))
+ (bc (/ (- max b) delta))
+ (h (mod
+ (/
+ (cond
+ ((= r max) (- bc gc))
+ ((= g max) (+ 2.0 rc (- bc)))
+ (t (+ 4.0 gc (- rc))))
+ 6.0) 1.0)))
+ (list h s l)))))
(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."
+RED, GREEN and BLUE should be between 0.0 and 1.0, inclusive."
(let ((r (if (<= red 0.04045)
(/ red 12.95)
(expt (/ (+ red 0.055) 1.055) 2.4)))
(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'."
+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))
(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'."
+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)))
(expt (/ ΔH′ (* Sh kH)) 2.0)
(* Rt (/ ΔC′ (* Sc kC)) (/ ΔH′ (* Sh kH)))))))))
+(defun color-clamp (value)
+ "Make sure VALUE is a number between 0.0 and 1.0 inclusive."
+ (min 1.0 (max 0.0 value)))
+
+(defun color-saturate-hsl (H S L percent)
+ "Make a color more saturated by a specified amount.
+Given a color defined in terms of hue, saturation, and luminance
+\(arguments H, S, and L), return a color that is PERCENT more
+saturated. Returns a list (HUE SATURATION LUMINANCE)."
+ (list H (color-clamp (+ S (/ percent 100.0))) L))
+
+(defun color-saturate-name (name percent)
+ "Make a color with a specified NAME more saturated by PERCENT.
+See `color-saturate-hsl'."
+ (apply 'color-rgb-to-hex
+ (apply 'color-hsl-to-rgb
+ (apply 'color-saturate-hsl
+ (append
+ (apply 'color-rgb-to-hsl
+ (color-name-to-rgb name))
+ (list percent))))))
+
+(defun color-desaturate-hsl (H S L percent)
+ "Make a color less saturated by a specified amount.
+Given a color defined in terms of hue, saturation, and luminance
+\(arguments H, S, and L), return a color that is PERCENT less
+saturated. Returns a list (HUE SATURATION LUMINANCE)."
+ (color-saturate-hsl H S L (- percent)))
+
+(defun color-desaturate-name (name percent)
+ "Make a color with a specified NAME less saturated by PERCENT.
+See `color-desaturate-hsl'."
+ (color-saturate-name name (- percent)))
+
+(defun color-lighten-hsl (H S L percent)
+ "Make a color lighter by a specified amount.
+Given a color defined in terms of hue, saturation, and luminance
+\(arguments H, S, and L), return a color that is PERCENT lighter.
+Returns a list (HUE SATURATION LUMINANCE)."
+ (list H S (color-clamp (+ L (/ percent 100.0)))))
+
+(defun color-lighten-name (name percent)
+ "Make a color with a specified NAME lighter by PERCENT.
+See `color-lighten-hsl'."
+ (apply 'color-rgb-to-hex
+ (apply 'color-hsl-to-rgb
+ (apply 'color-lighten-hsl
+ (append
+ (apply 'color-rgb-to-hsl
+ (color-name-to-rgb name))
+ (list percent))))))
+
+(defun color-darken-hsl (H S L percent)
+ "Make a color darker by a specified amount.
+Given a color defined in terms of hue, saturation, and luminance
+\(arguments H, S, and L), return a color that is PERCENT darker.
+Returns a list (HUE SATURATION LUMINANCE)."
+ (color-lighten-hsl H S L (- percent)))
+
+(defun color-darken-name (name percent)
+ "Make a color with a specified NAME darker by PERCENT.
+See `color-darken-hsl'."
+ (color-lighten-name name (- percent)))
+
(provide 'color)
;;; color.el ends here
projects / gnus / blobdiff