-;;; color.el --- Color manipulation library -*- coding: utf-8; lexical-binding:t -*-
+;;; color.el --- Color manipulation library -*- lexical-binding:t -*-
-;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2016 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)
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.
"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 (/ 6.0)) (+ 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)))
(- (+ 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 (mod (+ H (/ 3.0)) 1))
(color-hue-to-rgb m1 m2 H)
- (color-hue-to-rgb m1 m2 (mod (- H (/ 1.0 3)) 1))))))
+ (color-hue-to-rgb m1 m2 (mod (- H (/ 3.0)) 1))))))
(defun color-complement-hex (color)
"Return the color that is the complement of COLOR, in hexadecimal format."
(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 RGB colors to their HSL representation.
(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))
+ (- (* 1.055 (expt r (/ 2.4))) 0.055))
(if (<= g 0.0031308)
(* 12.92 g)
- (- (* 1.055 (expt g (/ 1 2.4))) 0.055))
+ (- (* 1.055 (expt g (/ 2.4))) 0.055))
(if (<= b 0.0031308)
(* 12.92 b)
- (- (* 1.055 (expt b (/ 1 2.4))) 0.055)))))
+ (- (* 1.055 (expt b (/ 2.4))) 0.055)))))
(defconst color-d65-xyz '(0.950455 1.0 1.088753)
"D65 white point in CIE XYZ.")
(yr (/ Y Yr))
(zr (/ Z Zr))
(fx (if (> xr color-cie-ε)
- (expt xr (/ 1 3.0))
+ (expt xr (/ 3.0))
(/ (+ (* color-cie-κ xr) 16) 116.0)))
(fy (if (> yr color-cie-ε)
- (expt yr (/ 1 3.0))
+ (expt yr (/ 3.0))
(/ (+ (* color-cie-κ yr) 16) 116.0)))
(fz (if (> zr color-cie-ε)
- (expt zr (/ 1 3.0))
+ (expt zr (/ 3.0))
(/ (+ (* color-cie-κ zr) 16) 116.0))))
(list
(- (* 116 fy) 16) ; L