├── doc ├── rs-colors.pdf ├── package.texi ├── rs-colors-images │ ├── rs-colors-conversion.pdf │ ├── rs-colors-conversion.png │ ├── srgb-color-cube-HSL-views.png │ ├── srgb-color-cube-HSV-views.png │ ├── srgb-color-cube-RGB-views.png │ ├── srgb-color-cube-CIELab-views.png │ ├── srgb-color-cube-CIELuv-views.png │ ├── srgb-color-cube-CIERGB-views.png │ ├── srgb-color-cube-CIEXYZ-views.png │ ├── srgb-color-cube-CIExyY-views.png │ ├── Makefile.am │ └── rs-colors-conversion.tex ├── rs-texinfo.texi ├── texinfo.tex.diff ├── Makefile.am └── api │ ├── Makefile.am │ └── rs-colors-html.txt ├── misc ├── srgb_color_cube.m ├── GNUmakefile ├── 204_1931_col_observer.csv ├── 204_1964_col_observer.csv ├── srgb-color-cube.lisp ├── cie_1964_standard_observer.txt ├── color_matching_functions.m └── cie_1931_standard_observer.txt ├── asd-components.sh ├── configure.ac ├── dictionaries ├── rs-colors-svg.asd ├── rs-colors-x11.asd ├── rs-colors-html.asd ├── rs-colors-ral.asd ├── rs-colors-tango.asd ├── rs-colors-ral-design.asd ├── Makefile.am ├── rs-colors-material-io.asd ├── rs-colors-html.lisp ├── rs-colors-svg.lisp └── rs-colors-tango.lisp ├── rs-colors-internal.asd.in ├── rs-colors.asd.in ├── rs-colors-internal.asd ├── rs-colors-internal.lisp ├── rs-colors.asd ├── generate-doc.lisp ├── tests.lisp ├── Makefile.am ├── README ├── black-body.lisp ├── color-difference.lisp ├── ciexyz.lisp ├── ciergb.lisp ├── ciexyy.lisp ├── generic-cmy.lisp ├── cielab.lisp ├── cielch.lisp ├── cieluv.lisp ├── generic-cmyk.lisp ├── wide-gamut-rgb.lisp ├── adobe-rgb.lisp ├── srgb.lisp ├── missing ├── rs-colors.lisp ├── cie-white-points.lisp └── types.lisp /doc/rs-colors.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ralph-schleicher/rs-colors/HEAD/doc/rs-colors.pdf -------------------------------------------------------------------------------- /misc/srgb_color_cube.m: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ralph-schleicher/rs-colors/HEAD/misc/srgb_color_cube.m -------------------------------------------------------------------------------- /doc/package.texi: -------------------------------------------------------------------------------- 1 | @set PACKAGE rs-colors 2 | @set VERSION 1.1 3 | @set ADDRESS rs@@ralph-schleicher.de 4 | @set TARNAME rs-colors 5 | -------------------------------------------------------------------------------- /doc/rs-colors-images/rs-colors-conversion.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ralph-schleicher/rs-colors/HEAD/doc/rs-colors-images/rs-colors-conversion.pdf -------------------------------------------------------------------------------- /doc/rs-colors-images/rs-colors-conversion.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ralph-schleicher/rs-colors/HEAD/doc/rs-colors-images/rs-colors-conversion.png -------------------------------------------------------------------------------- /doc/rs-colors-images/srgb-color-cube-HSL-views.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ralph-schleicher/rs-colors/HEAD/doc/rs-colors-images/srgb-color-cube-HSL-views.png -------------------------------------------------------------------------------- /doc/rs-colors-images/srgb-color-cube-HSV-views.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ralph-schleicher/rs-colors/HEAD/doc/rs-colors-images/srgb-color-cube-HSV-views.png -------------------------------------------------------------------------------- /doc/rs-colors-images/srgb-color-cube-RGB-views.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ralph-schleicher/rs-colors/HEAD/doc/rs-colors-images/srgb-color-cube-RGB-views.png -------------------------------------------------------------------------------- /doc/rs-colors-images/srgb-color-cube-CIELab-views.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ralph-schleicher/rs-colors/HEAD/doc/rs-colors-images/srgb-color-cube-CIELab-views.png -------------------------------------------------------------------------------- /doc/rs-colors-images/srgb-color-cube-CIELuv-views.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ralph-schleicher/rs-colors/HEAD/doc/rs-colors-images/srgb-color-cube-CIELuv-views.png -------------------------------------------------------------------------------- /doc/rs-colors-images/srgb-color-cube-CIERGB-views.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ralph-schleicher/rs-colors/HEAD/doc/rs-colors-images/srgb-color-cube-CIERGB-views.png -------------------------------------------------------------------------------- /doc/rs-colors-images/srgb-color-cube-CIEXYZ-views.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ralph-schleicher/rs-colors/HEAD/doc/rs-colors-images/srgb-color-cube-CIEXYZ-views.png -------------------------------------------------------------------------------- /doc/rs-colors-images/srgb-color-cube-CIExyY-views.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ralph-schleicher/rs-colors/HEAD/doc/rs-colors-images/srgb-color-cube-CIExyY-views.png -------------------------------------------------------------------------------- /asd-components.sh: -------------------------------------------------------------------------------- 1 | #! /bin/sh 2 | 3 | # The empty string. 4 | COMPONENTS= 5 | 6 | for arg 7 | do 8 | case $arg in 9 | *.lisp) 10 | file=`basename "$arg" .lisp` 11 | if test "x$COMPONENTS" = x 12 | then 13 | : 14 | else 15 | # The backslash escapes the newline for sed(1). 16 | COMPONENTS="$COMPONENTS\\ 17 | " 18 | fi 19 | COMPONENTS="$COMPONENTS(:file \"$file\")" 20 | ;; 21 | esac 22 | done 23 | 24 | sed -e "s/@COMPONENTS@/$COMPONENTS/g" 25 | 26 | ## asd-components.sh ends here 27 | -------------------------------------------------------------------------------- /configure.ac: -------------------------------------------------------------------------------- 1 | dnl Process this file with autoconf to produce a configure script. 2 | 3 | AC_PREREQ([2.50]) 4 | 5 | AC_INIT([rs-colors], [1.1], [rs@ralph-schleicher.de]) 6 | AM_INIT_AUTOMAKE([foreign no-define dist-bzip2]) 7 | 8 | AC_CONFIG_SRCDIR([rs-colors.asd]) 9 | AC_CONFIG_FILES([Makefile \ 10 | dictionaries/Makefile \ 11 | doc/Makefile \ 12 | doc/api/Makefile \ 13 | doc/rs-colors-images/Makefile]) 14 | 15 | dnl Optional features. 16 | AM_MAINTAINER_MODE 17 | 18 | ax_lisp_dir="\${datadir}/lisp" 19 | AC_ARG_WITH([lisp-dir], AC_HELP_STRING([--with-lisp-dir=ARG], [use ARG as the top-level installation directory for Lisp files [DATADIR/lisp]]), 20 | [case $withval in 21 | yes | no) 22 | AC_MSG_ERROR([invalid value '$withval' for --with-lisp-dir]) 23 | ;; 24 | *) 25 | ax_lisp_dir=$withval 26 | ;; 27 | esac]) 28 | AC_MSG_CHECKING([for top-level installation directory for Lisp files]) 29 | AC_MSG_RESULT([$ax_lisp_dir]) 30 | lispdir=$ax_lisp_dir 31 | AC_SUBST([lispdir]) 32 | 33 | AC_SUBST([rs_colorsdir], ['$(lispdir)/$(PACKAGE_TARNAME)-$(PACKAGE_VERSION)']) 34 | 35 | AC_SUBST([PACKAGE_NAME]) 36 | AC_SUBST([PACKAGE_VERSION]) 37 | AC_SUBST([PACKAGE_STRING]) 38 | AC_SUBST([PACKAGE_BUGREPORT]) 39 | AC_SUBST([PACKAGE_TARNAME]) 40 | 41 | AC_OUTPUT 42 | -------------------------------------------------------------------------------- /doc/rs-texinfo.texi: -------------------------------------------------------------------------------- 1 | @c Lambda list keywords. 2 | @macro k {NAME} 3 | @r{\NAME\} 4 | @end macro 5 | 6 | @ifnottex 7 | @macro aref {ARG1, ARG2, NAME} 8 | \NAME\ 9 | @end macro 10 | @end ifnottex 11 | 12 | @macro lispref {KIND, PACKAGE, NAME} 13 | @aref{\KIND\;\PACKAGE\;\NAME\, , @code{\NAME\}} 14 | @end macro 15 | 16 | @macro typeref {PACKAGE, NAME} 17 | @lispref{type, \PACKAGE\, \NAME\} 18 | @end macro 19 | 20 | @macro structureref {PACKAGE, NAME} 21 | @lispref{structure, \PACKAGE\, \NAME\} 22 | @end macro 23 | 24 | @macro classref {PACKAGE, NAME} 25 | @lispref{class, \PACKAGE\, \NAME\} 26 | @end macro 27 | 28 | @macro conditionref {PACKAGE, NAME} 29 | @lispref{condition, \PACKAGE\, \NAME\} 30 | @end macro 31 | 32 | @macro varref {PACKAGE, NAME} 33 | @lispref{variable, \PACKAGE\, \NAME\} 34 | @end macro 35 | 36 | @macro constref {PACKAGE, NAME} 37 | @lispref{constant, \PACKAGE\, \NAME\} 38 | @end macro 39 | 40 | @macro specialref {PACKAGE, NAME} 41 | @lispref{special-operator, \PACKAGE\, \NAME\} 42 | @end macro 43 | 44 | @macro funref {PACKAGE, NAME} 45 | @lispref{function, \PACKAGE\, \NAME\} 46 | @end macro 47 | 48 | @macro genericref {PACKAGE, NAME} 49 | @lispref{generic-function, \PACKAGE\, \NAME\} 50 | @end macro 51 | 52 | @macro methodref {PACKAGE, NAME} 53 | @lispref{method, \PACKAGE\, \NAME\} 54 | @end macro 55 | 56 | @macro macroref {PACKAGE, NAME} 57 | @lispref{macro, \PACKAGE\, \NAME\} 58 | @end macro 59 | 60 | @macro slots {} 61 | @strong{Slots}@* 62 | @end macro 63 | 64 | @macro classprecedencelist {} 65 | @strong{Class Precedence List}@* 66 | @end macro 67 | -------------------------------------------------------------------------------- /doc/texinfo.tex.diff: -------------------------------------------------------------------------------- 1 | --- texinfo.tex.orig 2019-03-14 21:01:14.628917927 +0100 2 | +++ texinfo.tex 2019-03-14 21:05:44.972913653 +0100 3 | @@ -8816,13 +8816,15 @@ 4 | 5 | \def\xrefXX#1{\def\xrefXXarg{#1}\futurelet\tokenafterxref\xrefXXX} 6 | \def\xrefXXX{\expandafter\xrefX\expandafter[\xrefXXarg,,,,,,,]} 7 | +\def\aref#1{\def\xrefXXarg{#1}\futurelet\tokenafterxref\arefXXX} 8 | +\def\arefXXX{\expandafter\xrefX\expandafter[\xrefXXarg,,,,,aref,,]} 9 | % 10 | \newbox\toprefbox 11 | \newbox\printedrefnamebox 12 | \newbox\infofilenamebox 13 | \newbox\printedmanualbox 14 | % 15 | -\def\xrefX[#1,#2,#3,#4,#5,#6]{\begingroup 16 | +\def\xrefX[#1,#2,#3,#4,#5,#6,#7]{\begingroup 17 | \unsepspaces 18 | % 19 | % Get args without leading/trailing spaces. 20 | @@ -8991,14 +8993,17 @@ 21 | \setbox2 = \hbox{\ignorespaces \refx{#1-snt}{}}% 22 | \ifdim \wd2 > 0pt \refx{#1-snt}\space\fi 23 | }% 24 | - % output the `[mynode]' via the macro below so it can be overridden. 25 | - \xrefprintnodename\printedrefname 26 | - % 27 | - % But we always want a comma and a space: 28 | - ,\space 29 | - % 30 | - % output the `page 3'. 31 | - \turnoffactive \putwordpage\tie\refx{#1-pg}{}% 32 | + \def\refstyle{\ignorespaces #6}% 33 | + \ifx\refstyle\empty 34 | + % output the `[mynode]' via the macro below so it can be overridden. 35 | + \xrefprintnodename\printedrefname 36 | + % But we always want a comma and a space: 37 | + ,\space 38 | + % output the `page 3'. 39 | + \turnoffactive \putwordpage\tie\refx{#1-pg}{}% 40 | + \else 41 | + \arefprintnodename\printedrefname 42 | + \fi 43 | % Add a , if xref followed by a space 44 | \if\space\noexpand\tokenafterxref ,% 45 | \else\ifx\ \tokenafterxref ,% @TAB 46 | @@ -9045,6 +9050,7 @@ 47 | % one that Bob is working on :). 48 | % 49 | \def\xrefprintnodename#1{[#1]} 50 | +\def\arefprintnodename#1{#1} 51 | 52 | % Things referred to by \setref. 53 | % 54 | -------------------------------------------------------------------------------- /dictionaries/rs-colors-svg.asd: -------------------------------------------------------------------------------- 1 | ;;; rs-colors-svg.asd --- SVG color names. 2 | 3 | ;; Copyright (C) 2014 Ralph Schleicher 4 | 5 | ;; Redistribution and use in source and binary forms, with or without 6 | ;; modification, are permitted provided that the following conditions 7 | ;; are met: 8 | ;; 9 | ;; * Redistributions of source code must retain the above copyright 10 | ;; notice, this list of conditions and the following disclaimer. 11 | ;; 12 | ;; * Redistributions in binary form must reproduce the above copyright 13 | ;; notice, this list of conditions and the following disclaimer in 14 | ;; the documentation and/or other materials provided with the 15 | ;; distribution. 16 | ;; 17 | ;; * Neither the name of the copyright holder nor the names of its 18 | ;; contributors may be used to endorse or promote products derived 19 | ;; from this software without specific prior written permission. 20 | ;; 21 | ;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | ;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | ;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 24 | ;; FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 25 | ;; COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 26 | ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 27 | ;; BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 28 | ;; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 29 | ;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 30 | ;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 31 | ;; ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 32 | ;; POSSIBILITY OF SUCH DAMAGE. 33 | 34 | ;;; Code: 35 | 36 | (in-package :common-lisp-user) 37 | 38 | (asdf:defsystem :rs-colors-svg 39 | :description "SVG color names." 40 | :author "Ralph Schleicher " 41 | :license "Modified BSD License" 42 | :version "1.0" 43 | :depends-on (:rs-colors) 44 | :components ((:file "rs-colors-svg"))) 45 | 46 | ;;; rs-colors-svg.asd ends here 47 | -------------------------------------------------------------------------------- /dictionaries/rs-colors-x11.asd: -------------------------------------------------------------------------------- 1 | ;;; rs-colors-x11.asd --- X11 color names. 2 | 3 | ;; Copyright (C) 2014 Ralph Schleicher 4 | 5 | ;; Redistribution and use in source and binary forms, with or without 6 | ;; modification, are permitted provided that the following conditions 7 | ;; are met: 8 | ;; 9 | ;; * Redistributions of source code must retain the above copyright 10 | ;; notice, this list of conditions and the following disclaimer. 11 | ;; 12 | ;; * Redistributions in binary form must reproduce the above copyright 13 | ;; notice, this list of conditions and the following disclaimer in 14 | ;; the documentation and/or other materials provided with the 15 | ;; distribution. 16 | ;; 17 | ;; * Neither the name of the copyright holder nor the names of its 18 | ;; contributors may be used to endorse or promote products derived 19 | ;; from this software without specific prior written permission. 20 | ;; 21 | ;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | ;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | ;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 24 | ;; FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 25 | ;; COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 26 | ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 27 | ;; BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 28 | ;; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 29 | ;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 30 | ;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 31 | ;; ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 32 | ;; POSSIBILITY OF SUCH DAMAGE. 33 | 34 | ;;; Code: 35 | 36 | (in-package :common-lisp-user) 37 | 38 | (asdf:defsystem :rs-colors-x11 39 | :description "X11 color names." 40 | :author "Ralph Schleicher " 41 | :license "Modified BSD License" 42 | :version "1.0" 43 | :depends-on (:rs-colors) 44 | :components ((:file "rs-colors-x11"))) 45 | 46 | ;;; rs-colors-x11.asd ends here 47 | -------------------------------------------------------------------------------- /dictionaries/rs-colors-html.asd: -------------------------------------------------------------------------------- 1 | ;;; rs-colors-html.asd --- HTML basic colors. 2 | 3 | ;; Copyright (C) 2014 Ralph Schleicher 4 | 5 | ;; Redistribution and use in source and binary forms, with or without 6 | ;; modification, are permitted provided that the following conditions 7 | ;; are met: 8 | ;; 9 | ;; * Redistributions of source code must retain the above copyright 10 | ;; notice, this list of conditions and the following disclaimer. 11 | ;; 12 | ;; * Redistributions in binary form must reproduce the above copyright 13 | ;; notice, this list of conditions and the following disclaimer in 14 | ;; the documentation and/or other materials provided with the 15 | ;; distribution. 16 | ;; 17 | ;; * Neither the name of the copyright holder nor the names of its 18 | ;; contributors may be used to endorse or promote products derived 19 | ;; from this software without specific prior written permission. 20 | ;; 21 | ;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | ;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | ;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 24 | ;; FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 25 | ;; COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 26 | ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 27 | ;; BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 28 | ;; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 29 | ;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 30 | ;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 31 | ;; ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 32 | ;; POSSIBILITY OF SUCH DAMAGE. 33 | 34 | ;;; Code: 35 | 36 | (in-package :common-lisp-user) 37 | 38 | (asdf:defsystem :rs-colors-html 39 | :description "HTML basic colors." 40 | :author "Ralph Schleicher " 41 | :license "Modified BSD License" 42 | :version "1.0" 43 | :depends-on (:rs-colors) 44 | :components ((:file "rs-colors-html"))) 45 | 46 | ;;; rs-colors-html.asd ends here 47 | -------------------------------------------------------------------------------- /dictionaries/rs-colors-ral.asd: -------------------------------------------------------------------------------- 1 | ;;; rs-colors-ral.asd --- RAL Classic color names. 2 | 3 | ;; Copyright (C) 2014 Ralph Schleicher 4 | 5 | ;; Redistribution and use in source and binary forms, with or without 6 | ;; modification, are permitted provided that the following conditions 7 | ;; are met: 8 | ;; 9 | ;; * Redistributions of source code must retain the above copyright 10 | ;; notice, this list of conditions and the following disclaimer. 11 | ;; 12 | ;; * Redistributions in binary form must reproduce the above copyright 13 | ;; notice, this list of conditions and the following disclaimer in 14 | ;; the documentation and/or other materials provided with the 15 | ;; distribution. 16 | ;; 17 | ;; * Neither the name of the copyright holder nor the names of its 18 | ;; contributors may be used to endorse or promote products derived 19 | ;; from this software without specific prior written permission. 20 | ;; 21 | ;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | ;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | ;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 24 | ;; FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 25 | ;; COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 26 | ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 27 | ;; BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 28 | ;; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 29 | ;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 30 | ;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 31 | ;; ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 32 | ;; POSSIBILITY OF SUCH DAMAGE. 33 | 34 | ;;; Code: 35 | 36 | (in-package :common-lisp-user) 37 | 38 | (asdf:defsystem :rs-colors-ral 39 | :description "RAL Classic color names." 40 | :author "Ralph Schleicher " 41 | :license "Modified BSD License" 42 | :version "1.0" 43 | :depends-on (:rs-colors) 44 | :components ((:file "rs-colors-ral"))) 45 | 46 | ;;; rs-colors-ral.asd ends here 47 | -------------------------------------------------------------------------------- /doc/Makefile.am: -------------------------------------------------------------------------------- 1 | ## Makefile.am --- make file for RS-COLORS. 2 | 3 | # Copyright (C) 2014 Ralph Schleicher 4 | 5 | # Redistribution and use in source and binary forms, with or without 6 | # modification, are permitted provided that the following conditions 7 | # are met: 8 | # 9 | # * Redistributions of source code must retain the above copyright 10 | # notice, this list of conditions and the following disclaimer. 11 | # 12 | # * Redistributions in binary form must reproduce the above copyright 13 | # notice, this list of conditions and the following disclaimer in 14 | # the documentation and/or other materials provided with the 15 | # distribution. 16 | # 17 | # * The name of the author may not be used to endorse or promote 18 | # products derived from this software without specific prior 19 | # written permission. 20 | # 21 | # THIS SOFTWARE IS PROVIDED BY THE AUTHOR "AS IS" AND ANY EXPRESS 22 | # OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 23 | # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 24 | # ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, 25 | # INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES 26 | # (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 27 | # SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 28 | # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, 29 | # STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING 30 | # IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 31 | # POSSIBILITY OF SUCH DAMAGE. 32 | 33 | ## Code: 34 | 35 | SUBDIRS = rs-colors-images api 36 | 37 | info_TEXINFOS = rs-colors.texi 38 | rs_colors_TEXINFOS = package.texi rs-texinfo.texi 39 | 40 | EXTRA_DIST = rs-colors.pdf 41 | 42 | $(srcdir)/package.texi: $(srcdir)/../configure.ac 43 | cd $(srcdir) && \ 44 | ( echo 'set PACKAGE $(PACKAGE_NAME)' ; \ 45 | echo 'set VERSION $(PACKAGE_VERSION)' ; \ 46 | echo 'set ADDRESS $(PACKAGE_BUGREPORT)' ; \ 47 | echo 'set TARNAME $(PACKAGE_TARNAME)' ) | \ 48 | sed -e 's,@,@@,g' -e 's,^,@,' > package.texi 49 | 50 | ## Makefile.am ends here 51 | -------------------------------------------------------------------------------- /dictionaries/rs-colors-tango.asd: -------------------------------------------------------------------------------- 1 | ;;; rs-colors-tango.asd --- Tango desktop project colors. 2 | 3 | ;; Copyright (C) 2014 Ralph Schleicher 4 | 5 | ;; Redistribution and use in source and binary forms, with or without 6 | ;; modification, are permitted provided that the following conditions 7 | ;; are met: 8 | ;; 9 | ;; * Redistributions of source code must retain the above copyright 10 | ;; notice, this list of conditions and the following disclaimer. 11 | ;; 12 | ;; * Redistributions in binary form must reproduce the above copyright 13 | ;; notice, this list of conditions and the following disclaimer in 14 | ;; the documentation and/or other materials provided with the 15 | ;; distribution. 16 | ;; 17 | ;; * Neither the name of the copyright holder nor the names of its 18 | ;; contributors may be used to endorse or promote products derived 19 | ;; from this software without specific prior written permission. 20 | ;; 21 | ;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | ;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | ;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 24 | ;; FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 25 | ;; COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 26 | ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 27 | ;; BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 28 | ;; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 29 | ;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 30 | ;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 31 | ;; ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 32 | ;; POSSIBILITY OF SUCH DAMAGE. 33 | 34 | ;;; Code: 35 | 36 | (in-package :common-lisp-user) 37 | 38 | (asdf:defsystem :rs-colors-tango 39 | :description "Tango desktop project colors." 40 | :author "Ralph Schleicher " 41 | :license "Modified BSD License" 42 | :version "1.0" 43 | :depends-on (:rs-colors) 44 | :components ((:file "rs-colors-tango"))) 45 | 46 | ;;; rs-colors-tango.asd ends here 47 | -------------------------------------------------------------------------------- /rs-colors-internal.asd.in: -------------------------------------------------------------------------------- 1 | ;;; rs-colors-internal.asd --- ASDF system definition. 2 | 3 | ;; Copyright (C) 2014 Ralph Schleicher 4 | 5 | ;; Redistribution and use in source and binary forms, with or without 6 | ;; modification, are permitted provided that the following conditions 7 | ;; are met: 8 | ;; 9 | ;; * Redistributions of source code must retain the above copyright 10 | ;; notice, this list of conditions and the following disclaimer. 11 | ;; 12 | ;; * Redistributions in binary form must reproduce the above copyright 13 | ;; notice, this list of conditions and the following disclaimer in 14 | ;; the documentation and/or other materials provided with the 15 | ;; distribution. 16 | ;; 17 | ;; * Neither the name of the copyright holder nor the names of its 18 | ;; contributors may be used to endorse or promote products derived 19 | ;; from this software without specific prior written permission. 20 | ;; 21 | ;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | ;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | ;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 24 | ;; FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 25 | ;; COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 26 | ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 27 | ;; BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 28 | ;; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 29 | ;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 30 | ;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 31 | ;; ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 32 | ;; POSSIBILITY OF SUCH DAMAGE. 33 | 34 | ;;; Code: 35 | 36 | (in-package :common-lisp-user) 37 | 38 | (asdf:defsystem :rs-colors-internal 39 | :description "Internal definitions for RS-COLORS." 40 | :author "Ralph Schleicher " 41 | :license "Modified BSD License" 42 | :version "@VERSION@" 43 | :depends-on (:iterate) 44 | :serial t 45 | :components (@COMPONENTS@)) 46 | 47 | ;;; rs-colors-internal.asd ends here 48 | -------------------------------------------------------------------------------- /dictionaries/rs-colors-ral-design.asd: -------------------------------------------------------------------------------- 1 | ;;; rs-colors-ral-design.asd --- RAL Design color names. 2 | 3 | ;; Copyright (C) 2018 Ralph Schleicher 4 | 5 | ;; Redistribution and use in source and binary forms, with or without 6 | ;; modification, are permitted provided that the following conditions 7 | ;; are met: 8 | ;; 9 | ;; * Redistributions of source code must retain the above copyright 10 | ;; notice, this list of conditions and the following disclaimer. 11 | ;; 12 | ;; * Redistributions in binary form must reproduce the above copyright 13 | ;; notice, this list of conditions and the following disclaimer in 14 | ;; the documentation and/or other materials provided with the 15 | ;; distribution. 16 | ;; 17 | ;; * Neither the name of the copyright holder nor the names of its 18 | ;; contributors may be used to endorse or promote products derived 19 | ;; from this software without specific prior written permission. 20 | ;; 21 | ;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | ;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | ;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 24 | ;; FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 25 | ;; COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 26 | ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 27 | ;; BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 28 | ;; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 29 | ;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 30 | ;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 31 | ;; ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 32 | ;; POSSIBILITY OF SUCH DAMAGE. 33 | 34 | ;;; Code: 35 | 36 | (in-package :common-lisp-user) 37 | 38 | (asdf:defsystem :rs-colors-ral-design 39 | :description "RAL Design color names." 40 | :author "Ralph Schleicher " 41 | :license "Modified BSD License" 42 | :version "1.0" 43 | :depends-on (:rs-colors) 44 | :components ((:file "rs-colors-ral-design"))) 45 | 46 | ;;; rs-colors-ral-design.asd ends here 47 | -------------------------------------------------------------------------------- /dictionaries/Makefile.am: -------------------------------------------------------------------------------- 1 | ## Makefile.am --- make file for RS-COLORS. 2 | 3 | # Copyright (C) 2020 Ralph Schleicher 4 | 5 | # Redistribution and use in source and binary forms, with or without 6 | # modification, are permitted provided that the following conditions 7 | # are met: 8 | # 9 | # * Redistributions of source code must retain the above copyright 10 | # notice, this list of conditions and the following disclaimer. 11 | # 12 | # * Redistributions in binary form must reproduce the above copyright 13 | # notice, this list of conditions and the following disclaimer in 14 | # the documentation and/or other materials provided with the 15 | # distribution. 16 | # 17 | # * Neither the name of the copyright holder nor the names of its 18 | # contributors may be used to endorse or promote products derived 19 | # from this software without specific prior written permission. 20 | # 21 | # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | # "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | # LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 24 | # FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 25 | # COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 26 | # INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 27 | # BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 28 | # LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 29 | # CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 30 | # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 31 | # ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 32 | # POSSIBILITY OF SUCH DAMAGE. 33 | 34 | ## Code: 35 | 36 | EXTRA_DIST = \ 37 | rs-colors-html.asd \ 38 | rs-colors-html.lisp \ 39 | rs-colors-svg.asd \ 40 | rs-colors-svg.lisp \ 41 | rs-colors-x11.asd \ 42 | rs-colors-x11.lisp \ 43 | rs-colors-tango.asd \ 44 | rs-colors-tango.lisp \ 45 | rs-colors-material-io.asd \ 46 | rs-colors-material-io.lisp \ 47 | rs-colors-ral.asd \ 48 | rs-colors-ral.lisp \ 49 | rs-colors-ral-design.asd \ 50 | rs-colors-ral-design.lisp 51 | 52 | ## Makefile.am ends here 53 | -------------------------------------------------------------------------------- /dictionaries/rs-colors-material-io.asd: -------------------------------------------------------------------------------- 1 | ;;; rs-colors-material-io.asd --- material design color palette. 2 | 3 | ;; Copyright (C) 2017 Ralph Schleicher 4 | 5 | ;; Redistribution and use in source and binary forms, with or without 6 | ;; modification, are permitted provided that the following conditions 7 | ;; are met: 8 | ;; 9 | ;; * Redistributions of source code must retain the above copyright 10 | ;; notice, this list of conditions and the following disclaimer. 11 | ;; 12 | ;; * Redistributions in binary form must reproduce the above copyright 13 | ;; notice, this list of conditions and the following disclaimer in 14 | ;; the documentation and/or other materials provided with the 15 | ;; distribution. 16 | ;; 17 | ;; * Neither the name of the copyright holder nor the names of its 18 | ;; contributors may be used to endorse or promote products derived 19 | ;; from this software without specific prior written permission. 20 | ;; 21 | ;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | ;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | ;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 24 | ;; FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 25 | ;; COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 26 | ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 27 | ;; BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 28 | ;; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 29 | ;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 30 | ;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 31 | ;; ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 32 | ;; POSSIBILITY OF SUCH DAMAGE. 33 | 34 | ;;; Code: 35 | 36 | (in-package :common-lisp-user) 37 | 38 | (asdf:defsystem :rs-colors-material-io 39 | :description "Material design color palette." 40 | :author "Ralph Schleicher " 41 | :license "Modified BSD License" 42 | :version "1.0" 43 | :depends-on (:rs-colors) 44 | :components ((:file "rs-colors-material-io"))) 45 | 46 | ;;; rs-colors-material-io.asd ends here 47 | -------------------------------------------------------------------------------- /rs-colors.asd.in: -------------------------------------------------------------------------------- 1 | ;;; rs-colors.asd --- ASDF system definition. 2 | 3 | ;; Copyright (C) 2014 Ralph Schleicher 4 | 5 | ;; Redistribution and use in source and binary forms, with or without 6 | ;; modification, are permitted provided that the following conditions 7 | ;; are met: 8 | ;; 9 | ;; * Redistributions of source code must retain the above copyright 10 | ;; notice, this list of conditions and the following disclaimer. 11 | ;; 12 | ;; * Redistributions in binary form must reproduce the above copyright 13 | ;; notice, this list of conditions and the following disclaimer in 14 | ;; the documentation and/or other materials provided with the 15 | ;; distribution. 16 | ;; 17 | ;; * Neither the name of the copyright holder nor the names of its 18 | ;; contributors may be used to endorse or promote products derived 19 | ;; from this software without specific prior written permission. 20 | ;; 21 | ;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | ;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | ;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 24 | ;; FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 25 | ;; COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 26 | ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 27 | ;; BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 28 | ;; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 29 | ;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 30 | ;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 31 | ;; ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 32 | ;; POSSIBILITY OF SUCH DAMAGE. 33 | 34 | ;;; Code: 35 | 36 | (in-package :common-lisp-user) 37 | 38 | (asdf:defsystem :rs-colors 39 | :description "A color data type for Common Lisp." 40 | :author "Ralph Schleicher " 41 | :license "Modified BSD License" 42 | :version "@VERSION@" 43 | :depends-on (:iterate :alexandria :closer-mop :read-number :rs-colors-internal) 44 | :serial t 45 | :components (@COMPONENTS@)) 46 | 47 | ;;; rs-colors.asd ends here 48 | -------------------------------------------------------------------------------- /rs-colors-internal.asd: -------------------------------------------------------------------------------- 1 | ;;; rs-colors-internal.asd --- ASDF system definition. 2 | 3 | ;; Copyright (C) 2014 Ralph Schleicher 4 | 5 | ;; Redistribution and use in source and binary forms, with or without 6 | ;; modification, are permitted provided that the following conditions 7 | ;; are met: 8 | ;; 9 | ;; * Redistributions of source code must retain the above copyright 10 | ;; notice, this list of conditions and the following disclaimer. 11 | ;; 12 | ;; * Redistributions in binary form must reproduce the above copyright 13 | ;; notice, this list of conditions and the following disclaimer in 14 | ;; the documentation and/or other materials provided with the 15 | ;; distribution. 16 | ;; 17 | ;; * Neither the name of the copyright holder nor the names of its 18 | ;; contributors may be used to endorse or promote products derived 19 | ;; from this software without specific prior written permission. 20 | ;; 21 | ;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | ;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | ;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 24 | ;; FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 25 | ;; COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 26 | ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 27 | ;; BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 28 | ;; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 29 | ;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 30 | ;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 31 | ;; ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 32 | ;; POSSIBILITY OF SUCH DAMAGE. 33 | 34 | ;;; Code: 35 | 36 | (in-package :common-lisp-user) 37 | 38 | (asdf:defsystem :rs-colors-internal 39 | :description "Internal definitions for RS-COLORS." 40 | :author "Ralph Schleicher " 41 | :license "Modified BSD License" 42 | :version "1.1" 43 | :depends-on (:iterate) 44 | :serial t 45 | :components ((:file "rs-colors-internal") 46 | (:file "utilities"))) 47 | 48 | ;;; rs-colors-internal.asd ends here 49 | -------------------------------------------------------------------------------- /doc/api/Makefile.am: -------------------------------------------------------------------------------- 1 | ## Makefile.am --- make file for RS-COLORS. 2 | 3 | # Copyright (C) 2020 Ralph Schleicher 4 | 5 | # Redistribution and use in source and binary forms, with or without 6 | # modification, are permitted provided that the following conditions 7 | # are met: 8 | # 9 | # * Redistributions of source code must retain the above copyright 10 | # notice, this list of conditions and the following disclaimer. 11 | # 12 | # * Redistributions in binary form must reproduce the above copyright 13 | # notice, this list of conditions and the following disclaimer in 14 | # the documentation and/or other materials provided with the 15 | # distribution. 16 | # 17 | # * Neither the name of the copyright holder nor the names of its 18 | # contributors may be used to endorse or promote products derived 19 | # from this software without specific prior written permission. 20 | # 21 | # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | # "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | # LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 24 | # FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 25 | # COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 26 | # INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 27 | # BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 28 | # LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 29 | # CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 30 | # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 31 | # ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 32 | # POSSIBILITY OF SUCH DAMAGE. 33 | 34 | ## Code: 35 | 36 | EXTRA_DIST = \ 37 | rs-colors.html \ 38 | rs-colors.txt \ 39 | rs-colors-html.html \ 40 | rs-colors-html.txt \ 41 | rs-colors-svg.html \ 42 | rs-colors-svg.txt \ 43 | rs-colors-x11.html \ 44 | rs-colors-x11.txt \ 45 | rs-colors-tango.html \ 46 | rs-colors-tango.txt \ 47 | rs-colors-material-io.html \ 48 | rs-colors-material-io.txt \ 49 | rs-colors-ral.html \ 50 | rs-colors-ral.txt \ 51 | rs-colors-ral-design.html \ 52 | rs-colors-ral-design.txt 53 | 54 | ## Makefile.am ends here 55 | -------------------------------------------------------------------------------- /misc/GNUmakefile: -------------------------------------------------------------------------------- 1 | ## GNUmakefile --- make file for RS-COLORS. 2 | 3 | # Copyright (C) 2020 Ralph Schleicher 4 | 5 | # Redistribution and use in source and binary forms, with or without 6 | # modification, are permitted provided that the following conditions 7 | # are met: 8 | # 9 | # * Redistributions of source code must retain the above copyright 10 | # notice, this list of conditions and the following disclaimer. 11 | # 12 | # * Redistributions in binary form must reproduce the above copyright 13 | # notice, this list of conditions and the following disclaimer in 14 | # the documentation and/or other materials provided with the 15 | # distribution. 16 | # 17 | # * The name of the author may not be used to endorse or promote 18 | # products derived from this software without specific prior 19 | # written permission. 20 | # 21 | # THIS SOFTWARE IS PROVIDED BY THE AUTHOR "AS IS" AND ANY EXPRESS 22 | # OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 23 | # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 24 | # ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, 25 | # INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES 26 | # (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 27 | # SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 28 | # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, 29 | # STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING 30 | # IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 31 | # POSSIBILITY OF SUCH DAMAGE. 32 | 33 | ## Code: 34 | 35 | 204.xls: 36 | wget http://files.cie.co.at/204.xls 37 | 38 | 204_1931_col_observer.csv: 204.xls 39 | octave --eval "csvwrite('$@', xlsread('204.xls', '1931 col observer', 'A6:D86'))" 40 | 41 | 204_1964_col_observer.csv: 204.xls 42 | octave --eval "csvwrite('$@', xlsread('204.xls', '1964 col observer', 'A6:D86'))" 43 | 44 | cie_1931_standard_observer.txt: 204_1931_col_observer.csv 45 | octave --eval "color_matching_functions(1931)" 46 | 47 | cie_1964_standard_observer.txt: 204_1964_col_observer.csv 48 | octave --eval "color_matching_functions(1964)" 49 | 50 | ## GNUmakefile ends here 51 | -------------------------------------------------------------------------------- /doc/api/rs-colors-html.txt: -------------------------------------------------------------------------------- 1 | RS-COLORS-HTML 2 | 3 | HTML basic colors. 4 | 5 | The list of basic color keywords is: aqua, black, blue, fuchsia, gray, 6 | green, lime, maroon, navy, olive, purple, red, silver, teal, white, 7 | and yellow. The color names are case-insensitive. 8 | 9 | See . 10 | 11 | [Constant] 12 | aqua 13 | HTML basic color ‘#00FFFF’. 14 | 15 | [Constant] 16 | black 17 | HTML basic color ‘#000000’. 18 | 19 | [Constant] 20 | blue 21 | HTML basic color ‘#0000FF’. 22 | 23 | [Constant] 24 | fuchsia 25 | HTML basic color ‘#FF00FF’. 26 | 27 | [Constant] 28 | gray 29 | HTML basic color ‘#808080’. 30 | 31 | [Constant] 32 | green 33 | HTML basic color ‘#008000’. 34 | 35 | [Constant] 36 | lime 37 | HTML basic color ‘#00FF00’. 38 | 39 | [Constant] 40 | maroon 41 | HTML basic color ‘#800000’. 42 | 43 | [Constant] 44 | navy 45 | HTML basic color ‘#000080’. 46 | 47 | [Constant] 48 | olive 49 | HTML basic color ‘#808000’. 50 | 51 | [Constant] 52 | purple 53 | HTML basic color ‘#800080’. 54 | 55 | [Constant] 56 | red 57 | HTML basic color ‘#FF0000’. 58 | 59 | [Constant] 60 | silver 61 | HTML basic color ‘#C0C0C0’. 62 | 63 | [Constant] 64 | teal 65 | HTML basic color ‘#008080’. 66 | 67 | [Constant] 68 | white 69 | HTML basic color ‘#FFFFFF’. 70 | 71 | [Constant] 72 | yellow 73 | HTML basic color ‘#FFFF00’. 74 | -------------------------------------------------------------------------------- /doc/rs-colors-images/Makefile.am: -------------------------------------------------------------------------------- 1 | ## Makefile.am --- make file for RS-COLORS. 2 | 3 | # Copyright (C) 2020 Ralph Schleicher 4 | 5 | # Redistribution and use in source and binary forms, with or without 6 | # modification, are permitted provided that the following conditions 7 | # are met: 8 | # 9 | # * Redistributions of source code must retain the above copyright 10 | # notice, this list of conditions and the following disclaimer. 11 | # 12 | # * Redistributions in binary form must reproduce the above copyright 13 | # notice, this list of conditions and the following disclaimer in 14 | # the documentation and/or other materials provided with the 15 | # distribution. 16 | # 17 | # * The name of the author may not be used to endorse or promote 18 | # products derived from this software without specific prior 19 | # written permission. 20 | # 21 | # THIS SOFTWARE IS PROVIDED BY THE AUTHOR "AS IS" AND ANY EXPRESS 22 | # OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 23 | # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 24 | # ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, 25 | # INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES 26 | # (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 27 | # SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 28 | # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, 29 | # STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING 30 | # IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 31 | # POSSIBILITY OF SUCH DAMAGE. 32 | 33 | ## Code: 34 | 35 | imagedir = $(infodir)/rs-colors-images 36 | 37 | dist_image_DATA = \ 38 | rs-colors-conversion.png \ 39 | srgb-color-cube-RGB-views.png \ 40 | srgb-color-cube-HSV-views.png \ 41 | srgb-color-cube-HSL-views.png \ 42 | srgb-color-cube-CIERGB-views.png \ 43 | srgb-color-cube-CIEXYZ-views.png \ 44 | srgb-color-cube-CIExyY-views.png \ 45 | srgb-color-cube-CIELuv-views.png \ 46 | srgb-color-cube-CIELab-views.png 47 | 48 | EXTRA_DIST = rs-colors-conversion.tex rs-colors-conversion.pdf 49 | 50 | $(srcdir)/rs-colors-conversion.png: $(srcdir)/rs-colors-conversion.pdf 51 | cd $(srcdir) && \ 52 | convert -trim -density 96 rs-colors-conversion.pdf rs-colors-conversion.png 53 | 54 | $(srcdir)/rs-colors-conversion.pdf: $(srcdir)/rs-colors-conversion.tex 55 | cd $(srcdir) && \ 56 | pdflatex -halt-on-error -file-line-error rs-colors-conversion.tex && \ 57 | pdfcrop rs-colors-conversion.pdf rs-colors-conversion.pdf && \ 58 | rm -f rs-colors-conversion.log rs-colors-conversion.aux 59 | 60 | ## Makefile.am ends here 61 | -------------------------------------------------------------------------------- /rs-colors-internal.lisp: -------------------------------------------------------------------------------- 1 | ;;; rs-colors-internal.lisp --- utility definitions for RS-COLORS. 2 | 3 | ;; Copyright (C) 2014 Ralph Schleicher 4 | 5 | ;; Redistribution and use in source and binary forms, with or without 6 | ;; modification, are permitted provided that the following conditions 7 | ;; are met: 8 | ;; 9 | ;; * Redistributions of source code must retain the above copyright 10 | ;; notice, this list of conditions and the following disclaimer. 11 | ;; 12 | ;; * Redistributions in binary form must reproduce the above copyright 13 | ;; notice, this list of conditions and the following disclaimer in 14 | ;; the documentation and/or other materials provided with the 15 | ;; distribution. 16 | ;; 17 | ;; * Neither the name of the copyright holder nor the names of its 18 | ;; contributors may be used to endorse or promote products derived 19 | ;; from this software without specific prior written permission. 20 | ;; 21 | ;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | ;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | ;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 24 | ;; FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 25 | ;; COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 26 | ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 27 | ;; BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 28 | ;; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 29 | ;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 30 | ;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 31 | ;; ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 32 | ;; POSSIBILITY OF SUCH DAMAGE. 33 | 34 | ;;; Code: 35 | 36 | (in-package :common-lisp-user) 37 | 38 | (defpackage :rs-colors-internal 39 | (:use :common-lisp 40 | :iterate) 41 | (:export ;; utilities 42 | #:defconst 43 | #:defsubst 44 | #:ensure-type 45 | #:collapse 46 | #:cube 47 | #:cube-root 48 | #:radian-from-degree 49 | #:degree-from-radian 50 | #:make-vector 51 | #:copy-vector 52 | #:make-matrix 53 | #:copy-matrix 54 | #:matrix-inverse 55 | #:gemv 56 | #:gemm 57 | #:float-array 58 | #:linear-transformation 59 | #:hypot 60 | #:hypot3 61 | #:encode-triple 62 | #:decode-triple 63 | #:encode-quadruple 64 | #:decode-quadruple 65 | #:cie-L*-from-Y/Yn 66 | #:cie-Y/Yn-from-L* 67 | #:rgb-transformation-matrices 68 | #:make-rgb-color 69 | #:make-rgb-color-from-number 70 | #:multiples 71 | #:define-color-name 72 | #:define-color-names)) 73 | 74 | ;;; rs-colors-internal.lisp ends here 75 | -------------------------------------------------------------------------------- /rs-colors.asd: -------------------------------------------------------------------------------- 1 | ;;; rs-colors.asd --- ASDF system definition. 2 | 3 | ;; Copyright (C) 2014 Ralph Schleicher 4 | 5 | ;; Redistribution and use in source and binary forms, with or without 6 | ;; modification, are permitted provided that the following conditions 7 | ;; are met: 8 | ;; 9 | ;; * Redistributions of source code must retain the above copyright 10 | ;; notice, this list of conditions and the following disclaimer. 11 | ;; 12 | ;; * Redistributions in binary form must reproduce the above copyright 13 | ;; notice, this list of conditions and the following disclaimer in 14 | ;; the documentation and/or other materials provided with the 15 | ;; distribution. 16 | ;; 17 | ;; * Neither the name of the copyright holder nor the names of its 18 | ;; contributors may be used to endorse or promote products derived 19 | ;; from this software without specific prior written permission. 20 | ;; 21 | ;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | ;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | ;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 24 | ;; FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 25 | ;; COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 26 | ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 27 | ;; BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 28 | ;; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 29 | ;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 30 | ;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 31 | ;; ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 32 | ;; POSSIBILITY OF SUCH DAMAGE. 33 | 34 | ;;; Code: 35 | 36 | (in-package :common-lisp-user) 37 | 38 | (asdf:defsystem :rs-colors 39 | :description "A color data type for Common Lisp." 40 | :author "Ralph Schleicher " 41 | :license "Modified BSD License" 42 | :version "1.1" 43 | :depends-on (:iterate :alexandria :closer-mop :read-number :rs-colors-internal) 44 | :serial t 45 | :components ((:file "rs-colors") 46 | (:file "types") 47 | (:file "generic-rgb") 48 | (:file "generic-cmy") 49 | (:file "generic-cmyk") 50 | (:file "ciexyz") 51 | (:file "ciexyy") 52 | (:file "cie-white-points") 53 | (:file "cieluv") 54 | (:file "cielab") 55 | (:file "cielch") 56 | (:file "ciergb") 57 | (:file "srgb") 58 | (:file "adobe-rgb") 59 | (:file "wide-gamut-rgb") 60 | (:file "io") 61 | (:file "black-body") 62 | (:file "color-matching-functions") 63 | (:file "color-difference"))) 64 | 65 | ;;; rs-colors.asd ends here 66 | -------------------------------------------------------------------------------- /generate-doc.lisp: -------------------------------------------------------------------------------- 1 | ;;; generate-doc.lisp --- generate documentation. 2 | 3 | ;; Copyright (C) 2020 Ralph Schleicher 4 | 5 | ;; Redistribution and use in source and binary forms, with or without 6 | ;; modification, are permitted provided that the following conditions 7 | ;; are met: 8 | ;; 9 | ;; * Redistributions of source code must retain the above copyright 10 | ;; notice, this list of conditions and the following disclaimer. 11 | ;; 12 | ;; * Redistributions in binary form must reproduce the above copyright 13 | ;; notice, this list of conditions and the following disclaimer in 14 | ;; the documentation and/or other materials provided with the 15 | ;; distribution. 16 | ;; 17 | ;; * Neither the name of the copyright holder nor the names of its 18 | ;; contributors may be used to endorse or promote products derived 19 | ;; from this software without specific prior written permission. 20 | ;; 21 | ;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | ;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | ;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 24 | ;; FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 25 | ;; COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 26 | ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 27 | ;; BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 28 | ;; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 29 | ;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 30 | ;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 31 | ;; ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 32 | ;; POSSIBILITY OF SUCH DAMAGE. 33 | 34 | ;;; Code: 35 | 36 | (in-package :common-lisp-user) 37 | 38 | (ql:quickload :rs-doc) ;private 39 | 40 | (let ((dir (ensure-directories-exist 41 | (merge-pathnames 42 | (make-pathname :directory '(:relative "doc" "api")) 43 | (uiop:getcwd))))) 44 | (mapc (lambda (package) 45 | (ql:quickload package) 46 | (let ((name (string-downcase (string package)))) 47 | (rs-doc:generate-doc 48 | :package package 49 | :generic-functions t 50 | :methods nil 51 | :output (merge-pathnames (make-pathname :name name :type "html") dir) 52 | :output-format :html) 53 | (rs-doc:generate-doc 54 | :package package 55 | :generic-functions t 56 | :methods nil 57 | :output (merge-pathnames (make-pathname :name name :type "txt") dir) 58 | :output-format :text))) 59 | '(:rs-colors 60 | :rs-colors-html 61 | :rs-colors-svg 62 | :rs-colors-x11 63 | :rs-colors-tango 64 | :rs-colors-material-io 65 | :rs-colors-ral 66 | :rs-colors-ral-design))) 67 | 68 | ;;; generate-doc.lisp ends here 69 | -------------------------------------------------------------------------------- /misc/204_1931_col_observer.csv: -------------------------------------------------------------------------------- 1 | 380,0.001368,0.000039,0.006450 2 | 385,0.002236,0.000064,0.010550 3 | 390,0.004243,0.000120,0.020050 4 | 395,0.007650,0.000217,0.036210 5 | 400,0.014310,0.000396,0.067850 6 | 405,0.023190,0.000640,0.110200 7 | 410,0.043510,0.001210,0.207400 8 | 415,0.077630,0.002180,0.371300 9 | 420,0.134380,0.004000,0.645600 10 | 425,0.214770,0.007300,1.039050 11 | 430,0.283900,0.011600,1.385600 12 | 435,0.328500,0.016840,1.622960 13 | 440,0.348280,0.023000,1.747060 14 | 445,0.348060,0.029800,1.782600 15 | 450,0.336200,0.038000,1.772110 16 | 455,0.318700,0.048000,1.744100 17 | 460,0.290800,0.060000,1.669200 18 | 465,0.251100,0.073900,1.528100 19 | 470,0.195360,0.090980,1.287640 20 | 475,0.142100,0.112600,1.041900 21 | 480,0.095640,0.139020,0.812950 22 | 485,0.057950,0.169300,0.616200 23 | 490,0.032010,0.208020,0.465180 24 | 495,0.014700,0.258600,0.353300 25 | 500,0.004900,0.323000,0.272000 26 | 505,0.002400,0.407300,0.212300 27 | 510,0.009300,0.503000,0.158200 28 | 515,0.029100,0.608200,0.111700 29 | 520,0.063270,0.710000,0.078250 30 | 525,0.109600,0.793200,0.057250 31 | 530,0.165500,0.862000,0.042160 32 | 535,0.225750,0.914850,0.029840 33 | 540,0.290400,0.954000,0.020300 34 | 545,0.359700,0.980300,0.013400 35 | 550,0.433450,0.994950,0.008750 36 | 555,0.512050,1.000000,0.005750 37 | 560,0.594500,0.995000,0.003900 38 | 565,0.678400,0.978600,0.002750 39 | 570,0.762100,0.952000,0.002100 40 | 575,0.842500,0.915400,0.001800 41 | 580,0.916300,0.870000,0.001650 42 | 585,0.978600,0.816300,0.001400 43 | 590,1.026300,0.757000,0.001100 44 | 595,1.056700,0.694900,0.001000 45 | 600,1.062200,0.631000,0.000800 46 | 605,1.045600,0.566800,0.000600 47 | 610,1.002600,0.503000,0.000340 48 | 615,0.938400,0.441200,0.000240 49 | 620,0.854450,0.381000,0.000190 50 | 625,0.751400,0.321000,0.000100 51 | 630,0.642400,0.265000,0.000050 52 | 635,0.541900,0.217000,0.000030 53 | 640,0.447900,0.175000,0.000020 54 | 645,0.360800,0.138200,0.000010 55 | 650,0.283500,0.107000,0.000000 56 | 655,0.218700,0.081600,0.000000 57 | 660,0.164900,0.061000,0.000000 58 | 665,0.121200,0.044580,0.000000 59 | 670,0.087400,0.032000,0.000000 60 | 675,0.063600,0.023200,0.000000 61 | 680,0.046770,0.017000,0.000000 62 | 685,0.032900,0.011920,0.000000 63 | 690,0.022700,0.008210,0.000000 64 | 695,0.015840,0.005723,0.000000 65 | 700,0.011359,0.004102,0.000000 66 | 705,0.008111,0.002929,0.000000 67 | 710,0.005790,0.002091,0.000000 68 | 715,0.004109,0.001484,0.000000 69 | 720,0.002899,0.001047,0.000000 70 | 725,0.002049,0.000740,0.000000 71 | 730,0.001440,0.000520,0.000000 72 | 735,0.001000,0.000361,0.000000 73 | 740,0.000690,0.000249,0.000000 74 | 745,0.000476,0.000172,0.000000 75 | 750,0.000332,0.000120,0.000000 76 | 755,0.000235,0.000085,0.000000 77 | 760,0.000166,0.000060,0.000000 78 | 765,0.000117,0.000042,0.000000 79 | 770,0.000083,0.000030,0.000000 80 | 775,0.000059,0.000021,0.000000 81 | 780,0.000042,0.000015,0.000000 82 | -------------------------------------------------------------------------------- /misc/204_1964_col_observer.csv: -------------------------------------------------------------------------------- 1 | 380,0.000160,0.000017,0.000705 2 | 385,0.000662,0.000072,0.002928 3 | 390,0.002362,0.000253,0.010482 4 | 395,0.007242,0.000769,0.032344 5 | 400,0.019110,0.002004,0.086011 6 | 405,0.043400,0.004509,0.197120 7 | 410,0.084736,0.008756,0.389366 8 | 415,0.140638,0.014456,0.656760 9 | 420,0.204492,0.021391,0.972542 10 | 425,0.264737,0.029497,1.282500 11 | 430,0.314679,0.038676,1.553480 12 | 435,0.357719,0.049602,1.798500 13 | 440,0.383734,0.062077,1.967280 14 | 445,0.386726,0.074704,2.027300 15 | 450,0.370702,0.089456,1.994800 16 | 455,0.342957,0.106256,1.900700 17 | 460,0.302273,0.128201,1.745370 18 | 465,0.254085,0.152761,1.554900 19 | 470,0.195618,0.185190,1.317560 20 | 475,0.132349,0.219940,1.030200 21 | 480,0.080507,0.253589,0.772125 22 | 485,0.041072,0.297665,0.570060 23 | 490,0.016172,0.339133,0.415254 24 | 495,0.005132,0.395379,0.302356 25 | 500,0.003816,0.460777,0.218502 26 | 505,0.015444,0.531360,0.159249 27 | 510,0.037465,0.606741,0.112044 28 | 515,0.071358,0.685660,0.082248 29 | 520,0.117749,0.761757,0.060709 30 | 525,0.172953,0.823330,0.043050 31 | 530,0.236491,0.875211,0.030451 32 | 535,0.304213,0.923810,0.020584 33 | 540,0.376772,0.961988,0.013676 34 | 545,0.451584,0.982200,0.007918 35 | 550,0.529826,0.991761,0.003988 36 | 555,0.616053,0.999110,0.001091 37 | 560,0.705224,0.997340,0.000000 38 | 565,0.793832,0.982380,0.000000 39 | 570,0.878655,0.955552,0.000000 40 | 575,0.951162,0.915175,0.000000 41 | 580,1.014160,0.868934,0.000000 42 | 585,1.074300,0.825623,0.000000 43 | 590,1.118520,0.777405,0.000000 44 | 595,1.134300,0.720353,0.000000 45 | 600,1.123990,0.658341,0.000000 46 | 605,1.089100,0.593878,0.000000 47 | 610,1.030480,0.527963,0.000000 48 | 615,0.950740,0.461834,0.000000 49 | 620,0.856297,0.398057,0.000000 50 | 625,0.754930,0.339554,0.000000 51 | 630,0.647467,0.283493,0.000000 52 | 635,0.535110,0.228254,0.000000 53 | 640,0.431567,0.179828,0.000000 54 | 645,0.343690,0.140211,0.000000 55 | 650,0.268329,0.107633,0.000000 56 | 655,0.204300,0.081187,0.000000 57 | 660,0.152568,0.060281,0.000000 58 | 665,0.112210,0.044096,0.000000 59 | 670,0.081261,0.031800,0.000000 60 | 675,0.057930,0.022602,0.000000 61 | 680,0.040851,0.015905,0.000000 62 | 685,0.028623,0.011130,0.000000 63 | 690,0.019941,0.007749,0.000000 64 | 695,0.013842,0.005375,0.000000 65 | 700,0.009577,0.003718,0.000000 66 | 705,0.006605,0.002565,0.000000 67 | 710,0.004553,0.001768,0.000000 68 | 715,0.003145,0.001222,0.000000 69 | 720,0.002175,0.000846,0.000000 70 | 725,0.001506,0.000586,0.000000 71 | 730,0.001045,0.000407,0.000000 72 | 735,0.000727,0.000284,0.000000 73 | 740,0.000508,0.000199,0.000000 74 | 745,0.000356,0.000140,0.000000 75 | 750,0.000251,0.000098,0.000000 76 | 755,0.000178,0.000070,0.000000 77 | 760,0.000126,0.000050,0.000000 78 | 765,0.000090,0.000036,0.000000 79 | 770,0.000065,0.000025,0.000000 80 | 775,0.000046,0.000018,0.000000 81 | 780,0.000033,0.000013,0.000000 82 | -------------------------------------------------------------------------------- /dictionaries/rs-colors-html.lisp: -------------------------------------------------------------------------------- 1 | ;;; rs-colors-html.lisp --- HTML basic colors. 2 | 3 | ;; Copyright (C) 2014 Ralph Schleicher 4 | 5 | ;; Redistribution and use in source and binary forms, with or without 6 | ;; modification, are permitted provided that the following conditions 7 | ;; are met: 8 | ;; 9 | ;; * Redistributions of source code must retain the above copyright 10 | ;; notice, this list of conditions and the following disclaimer. 11 | ;; 12 | ;; * Redistributions in binary form must reproduce the above copyright 13 | ;; notice, this list of conditions and the following disclaimer in 14 | ;; the documentation and/or other materials provided with the 15 | ;; distribution. 16 | ;; 17 | ;; * Neither the name of the copyright holder nor the names of its 18 | ;; contributors may be used to endorse or promote products derived 19 | ;; from this software without specific prior written permission. 20 | ;; 21 | ;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | ;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | ;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 24 | ;; FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 25 | ;; COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 26 | ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 27 | ;; BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 28 | ;; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 29 | ;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 30 | ;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 31 | ;; ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 32 | ;; POSSIBILITY OF SUCH DAMAGE. 33 | 34 | ;;; Code: 35 | 36 | (in-package :common-lisp-user) 37 | 38 | (defpackage :rs-colors-html 39 | (:nicknames :html-color) 40 | (:use :common-lisp 41 | :rs-colors 42 | :rs-colors-internal) 43 | (:documentation "HTML basic colors. 44 | 45 | The list of basic color keywords is: aqua, black, blue, fuchsia, gray, 46 | green, lime, maroon, navy, olive, purple, red, silver, teal, white, 47 | and yellow. The color names are case-insensitive. 48 | 49 | See .")) 50 | 51 | (in-package :rs-colors-html) 52 | 53 | (defmacro RGB (value name) 54 | `(define-color-name ,name 55 | (make-srgb-color-from-number ,value :byte-size 8) 56 | ,(format nil "HTML basic color ‘#~6,'0,X’." value))) 57 | 58 | (RGB #X00FFFF aqua) 59 | (RGB #X000000 black) 60 | (RGB #X0000FF blue) 61 | (RGB #XFF00FF fuchsia) 62 | (RGB #X808080 gray) 63 | (RGB #X008000 green) 64 | (RGB #X00FF00 lime) 65 | (RGB #X800000 maroon) 66 | (RGB #X000080 navy) 67 | (RGB #X808000 olive) 68 | (RGB #X800080 purple) 69 | (RGB #XFF0000 red) 70 | (RGB #XC0C0C0 silver) 71 | (RGB #X008080 teal) 72 | (RGB #XFFFFFF white) 73 | (RGB #XFFFF00 yellow) 74 | 75 | ;;; rs-colors-html.lisp ends here 76 | -------------------------------------------------------------------------------- /tests.lisp: -------------------------------------------------------------------------------- 1 | ;;; tests.lisp --- test procedure. 2 | 3 | ;; Copyright (C) 2014 Ralph Schleicher 4 | 5 | ;; Redistribution and use in source and binary forms, with or without 6 | ;; modification, are permitted provided that the following conditions 7 | ;; are met: 8 | ;; 9 | ;; * Redistributions of source code must retain the above copyright 10 | ;; notice, this list of conditions and the following disclaimer. 11 | ;; 12 | ;; * Redistributions in binary form must reproduce the above copyright 13 | ;; notice, this list of conditions and the following disclaimer in 14 | ;; the documentation and/or other materials provided with the 15 | ;; distribution. 16 | ;; 17 | ;; * Neither the name of the copyright holder nor the names of its 18 | ;; contributors may be used to endorse or promote products derived 19 | ;; from this software without specific prior written permission. 20 | ;; 21 | ;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | ;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | ;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 24 | ;; FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 25 | ;; COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 26 | ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 27 | ;; BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 28 | ;; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 29 | ;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 30 | ;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 31 | ;; ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 32 | ;; POSSIBILITY OF SUCH DAMAGE. 33 | 34 | ;;; Code: 35 | 36 | (in-package :common-lisp-user) 37 | 38 | (defpackage :rs-colors-tests 39 | (:use :common-lisp 40 | :iterate 41 | :lisp-unit 42 | :rs-colors)) 43 | 44 | (in-package :rs-colors-tests) 45 | 46 | (define-test srgb-regression-test 47 | (assert-false 48 | (iter (for value :from 0 :to (1- (expt 2 24))) 49 | (for color = (make-srgb-color-from-number value)) 50 | (multiple-value-bind (ro go bo) 51 | (color-coordinates color) 52 | (change-class color 'ciexyz-color) 53 | (change-class color 'srgb-color) 54 | (multiple-value-bind (r g b) 55 | (color-coordinates color) 56 | (let ((eps #.(/ (expt 2 31)))) 57 | (unless (and (< (abs (- r ro)) eps) 58 | (< (abs (- g go)) eps) 59 | (< (abs (- b bo)) eps)) 60 | (collect value)))))))) 61 | 62 | (define-test adobe-rgb-regression-test 63 | (assert-false 64 | (iter (for value :from 0 :to (1- (expt 2 24))) 65 | (for color = (make-adobe-rgb-color-from-number value)) 66 | (multiple-value-bind (ro go bo) 67 | (color-coordinates color) 68 | (change-class color 'ciexyz-color) 69 | (change-class color 'adobe-rgb-color) 70 | (multiple-value-bind (r g b) 71 | (color-coordinates color) 72 | (let ((eps #.(/ (expt 2 15)))) 73 | (unless (and (< (abs (- r ro)) eps) 74 | (< (abs (- g go)) eps) 75 | (< (abs (- b bo)) eps)) 76 | (collect value)))))))) 77 | 78 | (run-tests) 79 | 80 | ;;; tests.lisp ends here 81 | -------------------------------------------------------------------------------- /Makefile.am: -------------------------------------------------------------------------------- 1 | ## Makefile.am --- make file for RS-COLORS. 2 | 3 | # Copyright (C) 2014 Ralph Schleicher 4 | 5 | # Redistribution and use in source and binary forms, with or without 6 | # modification, are permitted provided that the following conditions 7 | # are met: 8 | # 9 | # * Redistributions of source code must retain the above copyright 10 | # notice, this list of conditions and the following disclaimer. 11 | # 12 | # * Redistributions in binary form must reproduce the above copyright 13 | # notice, this list of conditions and the following disclaimer in 14 | # the documentation and/or other materials provided with the 15 | # distribution. 16 | # 17 | # * The name of the author may not be used to endorse or promote 18 | # products derived from this software without specific prior 19 | # written permission. 20 | # 21 | # THIS SOFTWARE IS PROVIDED BY THE AUTHOR "AS IS" AND ANY EXPRESS 22 | # OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 23 | # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 24 | # ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, 25 | # INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES 26 | # (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 27 | # SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 28 | # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, 29 | # STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING 30 | # IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 31 | # POSSIBILITY OF SUCH DAMAGE. 32 | 33 | ## Code: 34 | 35 | SUBDIRS = dictionaries doc 36 | 37 | rs_colors_internal_sources = \ 38 | rs-colors-internal.asd \ 39 | rs-colors-internal.lisp \ 40 | utilities.lisp \ 41 | $(nil) 42 | 43 | rs_colors_sources = \ 44 | rs-colors.asd \ 45 | rs-colors.lisp \ 46 | types.lisp \ 47 | generic-rgb.lisp \ 48 | generic-cmy.lisp \ 49 | generic-cmyk.lisp \ 50 | ciexyz.lisp \ 51 | ciexyy.lisp \ 52 | cie-white-points.lisp \ 53 | cieluv.lisp \ 54 | cielab.lisp \ 55 | cielch.lisp \ 56 | ciergb.lisp \ 57 | srgb.lisp \ 58 | adobe-rgb.lisp \ 59 | wide-gamut-rgb.lisp \ 60 | io.lisp \ 61 | black-body.lisp \ 62 | color-matching-functions.lisp \ 63 | color-difference.lisp \ 64 | $(nil) 65 | 66 | nobase_dist_rs_colors_DATA = \ 67 | $(rs_colors_internal_sources) \ 68 | $(rs_colors_sources) \ 69 | $(nil) 70 | 71 | EXTRA_DIST = asd-components.sh generate-doc.lisp 72 | BUILT_SOURCES = rs-colors-internal.asd rs-colors.asd 73 | 74 | rs-colors-internal.asd: $(srcdir)/rs-colors-internal.asd.in $(srcdir)/Makefile.in 75 | cd $(srcdir) && \ 76 | ( sed -e 's/\@VERSION\@/$(PACKAGE_VERSION)/g' rs-colors-internal.asd.in | \ 77 | sh ./asd-components.sh $(rs_colors_internal_sources) ) > $@~ && \ 78 | mv -f $@~ $@ 79 | 80 | rs-colors.asd: $(srcdir)/rs-colors.asd.in $(srcdir)/Makefile.in 81 | cd $(srcdir) && \ 82 | ( sed -e 's/\@VERSION\@/$(PACKAGE_VERSION)/g' rs-colors.asd.in | \ 83 | sh ./asd-components.sh $(rs_colors_sources) ) > $@~ && \ 84 | mv -f $@~ $@ 85 | 86 | .PHONY: check-local 87 | check-local: 88 | quicklisp-check-build -sbcl -ccl $(PACKAGE) 89 | 90 | .PHONY: sync 91 | sync: all 92 | ~/src/github/github.sh $(PACKAGE) 93 | 94 | ## Makefile.am ends here 95 | -------------------------------------------------------------------------------- /README: -------------------------------------------------------------------------------- 1 | A color data type for Common Lisp. 2 | 3 | 4 | Implemented color spaces: 5 | 6 | * generic RGB 7 | * generic HSV/HSB 8 | * generic HSL 9 | * generic CMY 10 | * generic CMYK 11 | 12 | and 13 | 14 | * CIE RGB 15 | * CIE XYZ 16 | * CIE xyY 17 | * CIE L*u*v* 18 | * CIE L*a*b* 19 | * CIE L*C*h 20 | * sRGB 21 | * Adobe RGB 22 | 23 | 24 | Color space conversion is resolved by CLOS: 25 | 26 | (srgb-color-coordinates 27 | (make-ciexyy-color 1/3 1/3 1)) 28 | ==> 1 29 | 0.976911599934101d0 30 | 0.9587075033783911d0 31 | 32 | (change-class (make-generic-rgb-color 1/2 1/2 1) 'generic-hsv-color) 33 | ==> # 34 | 35 | (change-class (make-generic-hsv-color 240 1/2 1) 'generic-rgb-color) 36 | ==> # 37 | 38 | 39 | Colors can be read and written: 40 | 41 | (with-input-from-string (stream "#4E9A06 junk") 42 | (let ((color (read-color-html stream))) 43 | (values color 44 | (format nil color-formatter-html color) 45 | (format nil color-formatter-css3-rgb color) 46 | (format nil color-formatter-xcms-ciexyy color)))) 47 | ==> # 48 | "#4E9A06" 49 | "rgb(78, 154, 6)" 50 | "CIExyY:0.33748913/0.5669201/0.24743336" 51 | 52 | You can define your own formats: 53 | 54 | (define-color-printer fubar (color stream) 55 | (multiple-value-bind (a b c) 56 | (abc-color-coordinates color) 57 | (format stream "" a b c))) 58 | 59 | (print-color-fubar (make-srgb-color 199 21 133 :byte-size 8)) 60 | 61 | 62 | There are dictionaries with predefined colors: 63 | 64 | (ql:quickload "rs-colors-html") 65 | html-color:silver 66 | ==> # 67 | 68 | (ql:quickload "rs-colors-svg") 69 | svg-color:tan 70 | ==> # 71 | 72 | (ql:quickload "rs-colors-tango") 73 | (tango-color:orange :light) 74 | ==> # 75 | 76 | (ql:quickload "rs-colors-x11") 77 | x11-color:ghost-white 78 | ==> # 79 | 80 | 81 | Adding a new color space is straight forward: 82 | 83 | (defclass abc-color (color) (a b c)) 84 | 85 | (defmethod color-coordinates ((color abc-color)) 86 | (with-slots (a b c) color 87 | (values a b c))) 88 | 89 | (defun make-abc-color (a b c) ...) 90 | 91 | ;; Color conversion. 92 | (defun abc-from-ciexyz (x y z) ...) 93 | (defun ciexyz-from-abc (a b c) ...) 94 | 95 | (defgeneric abc-color-coordinates (color) 96 | (:method ((color abc-color)) 97 | (color-coordinates color)) 98 | ;; Otherwise, go via CIE XYZ. 99 | (:method ((color color)) 100 | (multiple-value-call #'abc-from-ciexyz 101 | (ciexyz-color-coordinates color)))) 102 | 103 | (defmethod ciexyz-color-coordinates ((color abc-color)) 104 | (multiple-value-call #'ciexyz-from-abc 105 | (abc-color-coordinates color))) 106 | 107 | 108 | Have fun! 109 | -------------------------------------------------------------------------------- /doc/rs-colors-images/rs-colors-conversion.tex: -------------------------------------------------------------------------------- 1 | %% rs-colors-conversion.tex -- visualize color conversion paths. 2 | 3 | % Copyright (C) 2016 Ralph Schleicher 4 | 5 | % Redistribution and use in source and binary forms, with or without 6 | % modification, are permitted provided that the following conditions 7 | % are met: 8 | % 9 | % * Redistributions of source code must retain the above copyright 10 | % notice, this list of conditions and the following disclaimer. 11 | % 12 | % * Redistributions in binary form must reproduce the above copyright 13 | % notice, this list of conditions and the following disclaimer in 14 | % the documentation and/or other materials provided with the 15 | % distribution. 16 | % 17 | % * The name of the author may not be used to endorse or promote 18 | % products derived from this software without specific prior 19 | % written permission. 20 | % 21 | % THIS SOFTWARE IS PROVIDED BY THE AUTHOR "AS IS" AND ANY EXPRESS 22 | % OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 23 | % WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 24 | % ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, 25 | % INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES 26 | % (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 27 | % SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 28 | % HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, 29 | % STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING 30 | % IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 31 | % POSSIBILITY OF SUCH DAMAGE. 32 | 33 | %% Code: 34 | 35 | \documentclass[a4paper,11pt,landscape]{article} 36 | \usepackage[utf8]{inputenc} 37 | \usepackage[T1]{fontenc} 38 | \usepackage{dejavu} 39 | \usepackage{tikz} 40 | \usetikzlibrary{shapes.geometric} 41 | \usetikzlibrary{arrows.meta} 42 | 43 | \begin{document} 44 | \pagenumbering{gobble} 45 | 46 | \tikzset{% 47 | col/.style={% 48 | ellipse, 49 | % All nodes should have the same size. 50 | minimum width=4cm, 51 | minimum height=1cm, 52 | very thick, 53 | draw=black!50, 54 | top color=white, 55 | bottom color=black!20, 56 | font=\sffamily}} 57 | 58 | \begin{tikzpicture}[scale=3.5] 59 | \draw 60 | node (CIEXYZ) [col] at ( 0: 0cm) {CIE XYZ} 61 | node (CIELuv) [col] at (150: 1cm) {CIE L*u*v*} 62 | node (CIELab) [col] at ( 30: 1cm) {CIE L*a*b*} 63 | node (CIELCh) [col] at ( 30: 2cm) {CIE L*C*h} 64 | node (CIERGB) [col] at (330: 1cm) {CIE RGB} 65 | node (anyRGB) [col] at (210: 1cm) {sRGB, \ldots} 66 | % Set CIE xyY to the right of CIE XYZ and below CIE L*C*h; 67 | % 1.7321 = 2 cos(30°). 68 | node (CIExyY) [col] at ( 0: 1.7321cm) {CIE xyY} 69 | % Generic RGB color space below CIE XYZ. 70 | node (genRGB) [col] at (270: 1cm) {generic RGB} 71 | node (genHSV) [col] at (210: 2cm) {generic HSV} 72 | node (genHSL) [col] at (330: 2cm) {generic HSL} 73 | % Generic CMY below generic RGB; 0.58114 is magic. 74 | node (genCMY) [col] at (0cm, -1.58114cm) {generic CMY} 75 | % Generic CMYL below generic CMY. 76 | node (genCMYK) [col] at (0cm, -2.16228cm) {generic CMYK}; 77 | 78 | \path[very thick, 79 | draw=black!50, 80 | arrows={Latex[round,fill=black!50,sep=1mm] 81 | - Latex[round,fill=black!50,sep=1mm]}] 82 | (CIEXYZ) edge (CIExyY) 83 | (CIEXYZ) edge (CIELuv) 84 | (CIEXYZ) edge (CIELab) 85 | (CIELab) edge (CIELCh) 86 | (CIERGB) edge (CIEXYZ) 87 | (CIERGB) edge (genRGB) 88 | (anyRGB) edge (CIEXYZ) 89 | (anyRGB) edge (genRGB) 90 | (genRGB) edge (genHSV) 91 | (genRGB) edge (genHSL) 92 | (genRGB) edge (genCMY) 93 | (genCMY) edge (genCMYK); 94 | \end{tikzpicture} 95 | \end{document} 96 | 97 | %% rs-colors-conversion.tex ends here 98 | -------------------------------------------------------------------------------- /black-body.lisp: -------------------------------------------------------------------------------- 1 | ;;; black-body.lisp --- Planck's law. 2 | 3 | ;; Copyright (C) 2020 Ralph Schleicher 4 | 5 | ;; Redistribution and use in source and binary forms, with or without 6 | ;; modification, are permitted provided that the following conditions 7 | ;; are met: 8 | ;; 9 | ;; * Redistributions of source code must retain the above copyright 10 | ;; notice, this list of conditions and the following disclaimer. 11 | ;; 12 | ;; * Redistributions in binary form must reproduce the above copyright 13 | ;; notice, this list of conditions and the following disclaimer in 14 | ;; the documentation and/or other materials provided with the 15 | ;; distribution. 16 | ;; 17 | ;; * Neither the name of the copyright holder nor the names of its 18 | ;; contributors may be used to endorse or promote products derived 19 | ;; from this software without specific prior written permission. 20 | ;; 21 | ;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | ;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | ;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 24 | ;; FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 25 | ;; COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 26 | ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 27 | ;; BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 28 | ;; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 29 | ;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 30 | ;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 31 | ;; ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 32 | ;; POSSIBILITY OF SUCH DAMAGE. 33 | 34 | ;;; Code: 35 | 36 | (in-package :rs-colors) 37 | 38 | (eval-when (:compile-toplevel :load-toplevel :execute) 39 | (let (;; Speed of light in vacuum. 40 | (c 299792458) 41 | ;; Planck constant. 42 | (h 6.62607015L-34) 43 | ;; Boltzmann constant. 44 | (k 1.380649L-23)) 45 | 46 | (defconst codata-2018-first-radiation-constant-for-spectral-radiance (* 2 h (expt c 2)) 47 | "First radiation constant for spectral radiance. 48 | 49 | 2018 CODATA recommended value.") 50 | 51 | (defconst codata-2018-first-radiation-constant (* 2 pi h (expt c 2)) 52 | "First radiation constant. 53 | 54 | 2018 CODATA recommended value.") 55 | 56 | (defconst codata-2018-second-radiation-constant (/ (* h c) k) 57 | "Second radiation constant. 58 | 59 | 2018 CODATA recommended value."))) 60 | 61 | (defun black-body-spectral-radiant-exitance (wavelength temperature) 62 | "Calculate the spectral radiant exitance of a black body. 63 | 64 | First argument WAVELENGTH is the wavelength of the light in meter. 65 | Second argument TEMPERATURE is the temperature of the black body 66 | in kelvin. 67 | 68 | Return value is the spectral radiant exitance of a black body 69 | around the given wavelength." 70 | (check-type wavelength (real (0))) 71 | (check-type temperature (real (0))) 72 | (symbol-macrolet ((c1 codata-2018-first-radiation-constant) 73 | (c2 codata-2018-second-radiation-constant)) 74 | (/ c1 (expt wavelength 5) (- (exp (/ c2 wavelength temperature)) 1)))) 75 | 76 | (defun black-body-spectral-radiance (wavelength temperature) 77 | "Calculate the spectral radiance of a black body. 78 | 79 | First argument WAVELENGTH is the wavelength of the light in meter. 80 | Second argument TEMPERATURE is the temperature of the black body 81 | in kelvin. 82 | 83 | Return value is the spectral radiance of a black body around the 84 | given wavelength." 85 | (check-type wavelength (real (0))) 86 | (check-type temperature (real (0))) 87 | (symbol-macrolet ((c1l codata-2018-first-radiation-constant-for-spectral-radiance) 88 | (c2 codata-2018-second-radiation-constant)) 89 | (/ c1l (expt wavelength 5) (- (exp (/ c2 wavelength temperature)) 1)))) 90 | 91 | ;;; black-body.lisp ends here 92 | -------------------------------------------------------------------------------- /color-difference.lisp: -------------------------------------------------------------------------------- 1 | ;;; color-difference.lisp --- color difference formulas. 2 | 3 | ;; Copyright (C) 2018 Ralph Schleicher 4 | 5 | ;; Redistribution and use in source and binary forms, with or without 6 | ;; modification, are permitted provided that the following conditions 7 | ;; are met: 8 | ;; 9 | ;; * Redistributions of source code must retain the above copyright 10 | ;; notice, this list of conditions and the following disclaimer. 11 | ;; 12 | ;; * Redistributions in binary form must reproduce the above copyright 13 | ;; notice, this list of conditions and the following disclaimer in 14 | ;; the documentation and/or other materials provided with the 15 | ;; distribution. 16 | ;; 17 | ;; * Neither the name of the copyright holder nor the names of its 18 | ;; contributors may be used to endorse or promote products derived 19 | ;; from this software without specific prior written permission. 20 | ;; 21 | ;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | ;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | ;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 24 | ;; FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 25 | ;; COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 26 | ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 27 | ;; BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 28 | ;; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 29 | ;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 30 | ;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 31 | ;; ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 32 | ;; POSSIBILITY OF SUCH DAMAGE. 33 | 34 | ;;; Code: 35 | 36 | (in-package :rs-colors) 37 | 38 | (defun cie76 (first-color second-color) 39 | "Calculate the CIE76 color difference between two colors. 40 | 41 | Value is the Euclidean distance between the two colors in the 42 | CIE L*a*b* color space. The CIE76 color difference is symmetric, 43 | i.e. CIE76(a,b) = CIE76(b,a)." 44 | (let (L1 a1 b1 L2 a2 b2) 45 | (multiple-value-setq (L1 a1 b1) 46 | (cielab-color-coordinates first-color)) 47 | (multiple-value-setq (L2 a2 b2) 48 | (cielab-color-coordinates second-color)) 49 | (hypot3 (- L2 L1) (- a2 a1) (- b2 b1)))) 50 | 51 | (defun cie94 (reference other &optional textile (lightness (if textile 2 1)) (chroma 1) (hue 1)) 52 | "Calculate the CIE94 color difference between two colors. 53 | 54 | First argument REFERENCE is the reference color. 55 | Second argument OTHER is the other color. 56 | If optional third argument TEXTILE is non-null, use parameters 57 | for calculating the color difference for textiles. Default is 58 | to calculate the color difference for graphic arts. 59 | Optional fourth to sixth argument LIGHTNESS, CHROMA, and HUE are 60 | the weighting factors for differences in lightness, chroma, and 61 | hue respectively. Higher value means less weight. Default is 62 | one for all weighting factors (if TEXTILE is true, the default 63 | for LIGHTNESS is two). 64 | 65 | The CIE94 color difference is asymmetric, i.e. CIE94(a,b) ≠ CIE94(b,a)." 66 | (check-type lightness alexandria:positive-real) 67 | (check-type chroma alexandria:positive-real) 68 | (check-type hue alexandria:positive-real) 69 | ;; Get L*a*b* color space coordinates. 70 | (let (L1 a1 b1 L2 a2 b2) 71 | (multiple-value-setq (L1 a1 b1) 72 | (cielab-color-coordinates reference)) 73 | (multiple-value-setq (L2 a2 b2) 74 | (cielab-color-coordinates other)) 75 | ;; Differences in the L*C*h color space. 76 | (let* ((C1 (hypot a1 b1)) 77 | (C2 (hypot a2 b2)) 78 | (dL (- L2 L1)) 79 | (dC (- C2 C1)) 80 | (dH (sqrt (abs (* 2 (- (* C1 C2) (* a1 a2) (* b1 b2))))))) 81 | ;; CIE94 color difference. 82 | (multiple-value-bind (K1 K2) 83 | (if (not textile) 84 | (values 0.045D0 0.015D0) 85 | (values 0.048D0 0.014D0)) 86 | (hypot3 (/ dL lightness) 87 | (/ dC chroma (1+ (* K1 C1))) 88 | (/ dH hue (1+ (* K2 C1)))))))) 89 | 90 | ;;; color-difference.lisp ends here 91 | -------------------------------------------------------------------------------- /ciexyz.lisp: -------------------------------------------------------------------------------- 1 | ;;; ciexyz.lisp --- CIE XYZ color space. 2 | 3 | ;; Copyright (C) 2014 Ralph Schleicher 4 | 5 | ;; Redistribution and use in source and binary forms, with or without 6 | ;; modification, are permitted provided that the following conditions 7 | ;; are met: 8 | ;; 9 | ;; * Redistributions of source code must retain the above copyright 10 | ;; notice, this list of conditions and the following disclaimer. 11 | ;; 12 | ;; * Redistributions in binary form must reproduce the above copyright 13 | ;; notice, this list of conditions and the following disclaimer in 14 | ;; the documentation and/or other materials provided with the 15 | ;; distribution. 16 | ;; 17 | ;; * Neither the name of the copyright holder nor the names of its 18 | ;; contributors may be used to endorse or promote products derived 19 | ;; from this software without specific prior written permission. 20 | ;; 21 | ;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | ;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | ;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 24 | ;; FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 25 | ;; COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 26 | ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 27 | ;; BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 28 | ;; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 29 | ;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 30 | ;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 31 | ;; ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 32 | ;; POSSIBILITY OF SUCH DAMAGE. 33 | 34 | ;;; Code: 35 | 36 | (in-package :rs-colors) 37 | 38 | (defclass ciexyz-color (color-object) 39 | ((x 40 | :initarg :x 41 | :initform 0 42 | :type (real 0) 43 | :documentation "First tristimulus value, default zero.") 44 | (y 45 | :initarg :y 46 | :initform 0 47 | :type (real 0) 48 | :documentation "Second tristimulus value, default zero.") 49 | (z 50 | :initarg :z 51 | :initform 0 52 | :type (real 0) 53 | :documentation "Third tristimulus value, default zero.")) 54 | (:documentation "Color class for the CIE XYZ color space.")) 55 | 56 | (defmethod color-coordinates ((color ciexyz-color)) 57 | (with-slots (x y z) color 58 | (values x y z))) 59 | 60 | (defun make-ciexyz-color (x y z) 61 | "Create a new color in the CIE XYZ color space. 62 | 63 | Arguments X, Y, and Z are the tristimulus values." 64 | (make-instance 'ciexyz-color :x x :y y :z z)) 65 | 66 | (defgeneric ciexyz-color-coordinates (color) 67 | (:documentation "Return the CIE XYZ color space coordinates of the color. 68 | 69 | Argument COLOR is a color object. 70 | 71 | Values are the X, Y, and Z tristimulus values.") 72 | (:method ((color ciexyz-color)) 73 | (color-coordinates color))) 74 | 75 | (defmethod update-instance-for-different-class :after ((old color-object) (new ciexyz-color) &key) 76 | (with-slots (x y z) new 77 | (multiple-value-setq (x y z) 78 | (ciexyz-color-coordinates old)))) 79 | 80 | (defmethod absolute-luminance ((color ciexyz-color)) 81 | (slot-value color 'y)) 82 | 83 | (defmethod normalize-color ((color ciexyz-color) &key (white 1) (black 0)) 84 | (let ((yw (absolute-luminance white)) 85 | (yk (absolute-luminance black))) 86 | (multiple-value-bind (x* y* ya) 87 | (ciexyy-color-coordinates color) 88 | (with-slots (x y z) color 89 | (multiple-value-setq (x y z) 90 | (ciexyz-from-ciexyy x* y* (/ (- ya yk) (- yw yk))))))) 91 | color) 92 | 93 | (defmethod absolute-color ((color ciexyz-color) &key (white 1) (black 0)) 94 | (let ((yw (absolute-luminance white)) 95 | (yk (absolute-luminance black))) 96 | (multiple-value-bind (x* y* yn) 97 | (ciexyy-color-coordinates color) 98 | (with-slots (x y z) color 99 | (multiple-value-setq (x y z) 100 | (ciexyz-from-ciexyy x* y* (+ yk (* yn (- yw yk)))))))) 101 | color) 102 | 103 | ;;; ciexyz.lisp ends here 104 | -------------------------------------------------------------------------------- /ciergb.lisp: -------------------------------------------------------------------------------- 1 | ;;; ciergb.lisp --- CIE RGB color space. 2 | 3 | ;; Copyright (C) 2014 Ralph Schleicher 4 | 5 | ;; Redistribution and use in source and binary forms, with or without 6 | ;; modification, are permitted provided that the following conditions 7 | ;; are met: 8 | ;; 9 | ;; * Redistributions of source code must retain the above copyright 10 | ;; notice, this list of conditions and the following disclaimer. 11 | ;; 12 | ;; * Redistributions in binary form must reproduce the above copyright 13 | ;; notice, this list of conditions and the following disclaimer in 14 | ;; the documentation and/or other materials provided with the 15 | ;; distribution. 16 | ;; 17 | ;; * Neither the name of the copyright holder nor the names of its 18 | ;; contributors may be used to endorse or promote products derived 19 | ;; from this software without specific prior written permission. 20 | ;; 21 | ;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | ;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | ;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 24 | ;; FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 25 | ;; COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 26 | ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 27 | ;; BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 28 | ;; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 29 | ;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 30 | ;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 31 | ;; ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 32 | ;; POSSIBILITY OF SUCH DAMAGE. 33 | 34 | ;;; Code: 35 | 36 | (in-package :rs-colors) 37 | 38 | (defclass ciergb-color (rgb-color-object) 39 | () 40 | (:documentation "Color class for the CIE RGB color space.")) 41 | 42 | (defun make-ciergb-color (red green blue) 43 | "Create a new color in the CIE RGB color space. 44 | 45 | First argument RED is the intensity of the red primary. 46 | Second argument GREEN is the intensity green primary. 47 | Third argument BLUE is the intensity of the blue primary. 48 | 49 | Arguments RED, GREEN, and BLUE have to be normalized intensity values 50 | in the closed interval [0, 1]." 51 | (make-instance 'ciergb-color :red red :green green :blue blue)) 52 | 53 | (eval-when (:compile-toplevel :load-toplevel :execute) 54 | (let ((c (make-matrix 49000/100000 31000/100000 20000/100000 55 | 17697/100000 81240/100000 1063/100000 56 | 0/100000 1000/100000 99000/100000))) 57 | (defconst ciergb-from-ciexyz-transformation-matrix (matrix-inverse (copy-matrix c)) 58 | "Transformation matrix to convert CIE XYZ color space coordinates 59 | into CIE RGB color space coordinates.") 60 | (defconst ciexyz-from-ciergb-transformation-matrix c 61 | "Transformation matrix to convert CIE RGB color space coordinates 62 | into CIE XYZ color space coordinates.") 63 | (values))) 64 | 65 | (defun ciergb-from-ciexyz (x y z) 66 | "Convert CIE XYZ color space coordinates 67 | into CIE RGB color space coordinates." 68 | (declare (type real x y z)) 69 | (multiple-value-bind (r g b) 70 | (linear-transformation ciergb-from-ciexyz-transformation-matrix x y z) 71 | (values (clamp r 0 1) 72 | (clamp g 0 1) 73 | (clamp b 0 1)))) 74 | 75 | (defun ciexyz-from-ciergb (r g b) 76 | "Convert CIE RGB color space coordinates 77 | into CIE XYZ color space coordinates." 78 | (declare (type real r g b)) 79 | (linear-transformation ciexyz-from-ciergb-transformation-matrix r g b)) 80 | 81 | (defgeneric ciergb-color-coordinates (color) 82 | (:documentation "Return the CIE RGB color space coordinates of the color. 83 | 84 | Argument COLOR is a color object. 85 | 86 | Values are the intensities of the red, green, and blue primary.") 87 | (:method ((color ciergb-color)) 88 | (color-coordinates color)) 89 | (:method ((color generic-color-object)) 90 | (generic-rgb-color-coordinates color)) 91 | ;; Otherwise, go via CIE XYZ. 92 | (:method ((color color-object)) 93 | (multiple-value-call #'ciergb-from-ciexyz 94 | (ciexyz-color-coordinates color)))) 95 | 96 | (defmethod generic-rgb-color-coordinates ((color ciergb-color)) 97 | (color-coordinates color)) 98 | 99 | (defmethod ciexyz-color-coordinates ((color ciergb-color)) 100 | (multiple-value-call #'ciexyz-from-ciergb 101 | (color-coordinates color))) 102 | 103 | (defmethod update-instance-for-different-class :after ((old color-object) (new ciergb-color) &key) 104 | (with-slots (r g b) new 105 | (multiple-value-setq (r g b) 106 | (ciergb-color-coordinates old)))) 107 | 108 | ;;; ciergb.lisp ends here 109 | -------------------------------------------------------------------------------- /misc/srgb-color-cube.lisp: -------------------------------------------------------------------------------- 1 | ;;; srgb-color-cube.lisp --- color coordinates of the sRGB color cube. 2 | 3 | ;; Copyright (C) 2020 Ralph Schleicher 4 | 5 | ;; Redistribution and use in source and binary forms, with or without 6 | ;; modification, are permitted provided that the following conditions 7 | ;; are met: 8 | ;; 9 | ;; * Redistributions of source code must retain the above copyright 10 | ;; notice, this list of conditions and the following disclaimer. 11 | ;; 12 | ;; * Redistributions in binary form must reproduce the above copyright 13 | ;; notice, this list of conditions and the following disclaimer in 14 | ;; the documentation and/or other materials provided with the 15 | ;; distribution. 16 | ;; 17 | ;; * Neither the name of the copyright holder nor the names of its 18 | ;; contributors may be used to endorse or promote products derived 19 | ;; from this software without specific prior written permission. 20 | ;; 21 | ;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | ;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | ;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 24 | ;; FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 25 | ;; COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 26 | ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 27 | ;; BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 28 | ;; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 29 | ;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 30 | ;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 31 | ;; ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 32 | ;; POSSIBILITY OF SUCH DAMAGE. 33 | 34 | ;;; Code: 35 | 36 | (in-package :common-lisp-user) 37 | 38 | (defvar *srgb-color-cube-header* 39 | (labels ((header (list) 40 | (let (row) 41 | (dolist (elem list) 42 | (dolist (tem (rest elem)) 43 | (push (concatenate 'string (first elem) "_" tem) row))) 44 | (nreverse row)))) 45 | (header '(("sRGB" "R" "G" "B") 46 | ("RGB" "R" "G" "B") 47 | ("HSV" "H" "S" "V") 48 | ("HSL" "H" "S" "L") 49 | ("CMY" "C" "M" "Y") 50 | ("CMYK" "C" "M" "Y" "K") 51 | ("CIERGB" "R" "G" "B") 52 | ("CIEXYZ" "X" "Y" "Z") 53 | ("CIExyY" "x" "y" "Y") 54 | ("CIELuv" "L" "u" "v") 55 | ("CIELab" "L" "a" "b") 56 | ("CIELCh" "L" "C" "h"))))) 57 | 58 | (defvar *srgb-color-cube-body* 59 | (labels ((coordinates (color) 60 | (mapcar (lambda (number) 61 | (coerce number 'single-float)) 62 | (multiple-value-list 63 | (rs-colors:color-coordinates color))))) 64 | (let (rows (list '(0 31 63 95 127 159 191 223 255))) 65 | (dolist (red list) 66 | (dolist (green list) 67 | (dolist (blue list) 68 | (let* ((srgb (rs-colors:make-srgb-color red green blue :byte-size 8)) 69 | (rgb (rs-colors:coerce-color srgb 'rs-colors:generic-rgb-color)) 70 | (hsv (rs-colors:coerce-color rgb 'rs-colors:generic-hsv-color)) 71 | (hsl (rs-colors:coerce-color rgb 'rs-colors:generic-hsl-color)) 72 | (cmy (rs-colors:coerce-color rgb 'rs-colors:generic-cmy-color)) 73 | (cmyk (rs-colors:coerce-color cmy 'rs-colors:generic-cmyk-color)) 74 | (ciexyz (rs-colors:coerce-color srgb 'rs-colors:ciexyz-color)) 75 | (ciergb (rs-colors:coerce-color ciexyz 'rs-colors:ciergb-color)) 76 | (black (and (= red 0) (= green 0) (= blue 0))) 77 | (ciexyy (if (not black) 78 | (rs-colors:coerce-color ciexyz 'rs-colors:ciexyy-color) 79 | (multiple-value-bind (x* y*) 80 | (rs-colors:ciexyy-color-coordinates 81 | (rs-colors:white-point srgb)) 82 | (rs-colors:make-ciexyy-color x* y* 0)))) 83 | (cieluv (if (not black) 84 | (rs-colors:coerce-color ciexyz 'rs-colors:cieluv-color) 85 | (rs-colors:make-cieluv-color 0 0 0))) 86 | (cielab (if (not black) 87 | (rs-colors:coerce-color ciexyz 'rs-colors:cielab-color) 88 | (rs-colors:make-cielab-color 0 0 0))) 89 | (cielch (rs-colors:coerce-color cielab 'rs-colors:cielch-color))) 90 | (push (nconc (list red green blue) 91 | (coordinates rgb) 92 | (coordinates hsv) 93 | (coordinates hsl) 94 | (coordinates cmy) 95 | (coordinates cmyk) 96 | (coordinates ciergb) 97 | (coordinates ciexyz) 98 | (coordinates ciexyy) 99 | (coordinates cieluv) 100 | (coordinates cielab) 101 | (coordinates cielch)) rows))))) 102 | (nreverse rows)))) 103 | 104 | (with-open-file (stream "srgb-color-cube.csv" 105 | :direction :output 106 | :if-exists :supersede 107 | :if-does-not-exist :create) 108 | (dolist (row (cons *srgb-color-cube-header* *srgb-color-cube-body*)) 109 | (format stream "~{~A~^,~}~%" row))) 110 | 111 | ;;; srgb-color-cube.lisp ends here 112 | -------------------------------------------------------------------------------- /ciexyy.lisp: -------------------------------------------------------------------------------- 1 | ;;; ciexyy.lisp --- CIE xyY color space. 2 | 3 | ;; Copyright (C) 2014 Ralph Schleicher 4 | 5 | ;; Redistribution and use in source and binary forms, with or without 6 | ;; modification, are permitted provided that the following conditions 7 | ;; are met: 8 | ;; 9 | ;; * Redistributions of source code must retain the above copyright 10 | ;; notice, this list of conditions and the following disclaimer. 11 | ;; 12 | ;; * Redistributions in binary form must reproduce the above copyright 13 | ;; notice, this list of conditions and the following disclaimer in 14 | ;; the documentation and/or other materials provided with the 15 | ;; distribution. 16 | ;; 17 | ;; * Neither the name of the copyright holder nor the names of its 18 | ;; contributors may be used to endorse or promote products derived 19 | ;; from this software without specific prior written permission. 20 | ;; 21 | ;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | ;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | ;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 24 | ;; FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 25 | ;; COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 26 | ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 27 | ;; BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 28 | ;; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 29 | ;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 30 | ;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 31 | ;; ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 32 | ;; POSSIBILITY OF SUCH DAMAGE. 33 | 34 | ;;; Code: 35 | 36 | (in-package :rs-colors) 37 | 38 | (defclass ciexyy-color (color-object) 39 | ((x* 40 | :initarg :x* 41 | :initform 0 42 | :type (real 0 1) 43 | :documentation "First chromaticity coordinate, default zero.") 44 | (y* 45 | :initarg :y* 46 | :initform 0 47 | :type (real 0 1) 48 | :documentation "Second chromaticity coordinate, default zero.") 49 | (y 50 | :initarg :y 51 | :initform 0 52 | :type (real 0) 53 | :documentation "Second tristimulus value, default zero.")) 54 | (:documentation "Color class for the CIE xyY color space.")) 55 | 56 | (defmethod color-coordinates ((color ciexyy-color)) 57 | (with-slots (x* y* y) color 58 | (values x* y* y))) 59 | 60 | (defun make-ciexyy-color (x* y* y) 61 | "Create a new color in the CIE xyY color space. 62 | 63 | Arguments X* and Y* are the chromaticity coordinates. 64 | Argument Y is the second tristimulus value (luminance)." 65 | (make-instance 'ciexyy-color :x* x* :y* y* :y y)) 66 | 67 | (defun ciexyy-from-ciexyz (x y z) 68 | "Convert CIE XYZ color space coordinates 69 | into CIE xyY color space coordinates." 70 | (declare (type real x y z)) 71 | (let ((s (+ x y z))) 72 | (declare (type real s)) 73 | (when (zerop s) 74 | (error 'division-by-zero :operation 'ciexyy-from-ciexyz :operands (list x y z))) 75 | (values (/ x s) (/ y s) y))) 76 | 77 | (defun ciexyz-from-ciexyy (x* y* y) 78 | "Convert CIE xyY color space coordinates 79 | into CIE XYZ color space coordinates." 80 | (declare (type real x* y* y)) 81 | (when (zerop y*) 82 | (error 'division-by-zero :operation 'ciexyz-from-ciexyy :operands (list x* y* y))) 83 | (let ((s (/ y y*))) 84 | (declare (type real s)) 85 | (values (* x* s) y (* (- 1 x* y*) s)))) 86 | 87 | (defgeneric ciexyy-color-coordinates (color) 88 | (:documentation "Return the CIE xyY color space coordinates of the color. 89 | 90 | Argument COLOR is a color object. 91 | 92 | Values are the X and Y chromaticity coordinates and the Y tristimulus 93 | value (luminance).") 94 | (:method ((color ciexyy-color)) 95 | (color-coordinates color)) 96 | ;; Otherwise, go via CIE XYZ. 97 | (:method ((color color-object)) 98 | (multiple-value-call #'ciexyy-from-ciexyz 99 | (ciexyz-color-coordinates color)))) 100 | 101 | (defmethod ciexyz-color-coordinates ((color ciexyy-color)) 102 | (multiple-value-call #'ciexyz-from-ciexyy 103 | (color-coordinates color))) 104 | 105 | (defmethod update-instance-for-different-class :after ((old color-object) (new ciexyy-color) &key) 106 | (with-slots (x* y* y) new 107 | (multiple-value-setq (x* y* y) 108 | (ciexyy-color-coordinates old)))) 109 | 110 | (defmethod absolute-luminance ((color ciexyy-color)) 111 | (slot-value color 'y)) 112 | 113 | (defmethod normalize-color ((color ciexyy-color) &key (white 1) (black 0)) 114 | (let ((yw (absolute-luminance white)) 115 | (yk (absolute-luminance black))) 116 | (with-slots (y) color 117 | (setf y (/ (- y yk) (- yw yk))))) 118 | color) 119 | 120 | (defmethod absolute-color ((color ciexyy-color) &key (white 1) (black 0)) 121 | (let ((yw (absolute-luminance white)) 122 | (yk (absolute-luminance black))) 123 | (with-slots (y) color 124 | (setf y (+ yk (* y (- yw yk)))))) 125 | color) 126 | 127 | ;;; ciexyy.lisp ends here 128 | -------------------------------------------------------------------------------- /generic-cmy.lisp: -------------------------------------------------------------------------------- 1 | ;;; generic-cmy.lisp --- generic CMY color space. 2 | 3 | ;; Copyright (C) 2014 Ralph Schleicher 4 | 5 | ;; Redistribution and use in source and binary forms, with or without 6 | ;; modification, are permitted provided that the following conditions 7 | ;; are met: 8 | ;; 9 | ;; * Redistributions of source code must retain the above copyright 10 | ;; notice, this list of conditions and the following disclaimer. 11 | ;; 12 | ;; * Redistributions in binary form must reproduce the above copyright 13 | ;; notice, this list of conditions and the following disclaimer in 14 | ;; the documentation and/or other materials provided with the 15 | ;; distribution. 16 | ;; 17 | ;; * Neither the name of the copyright holder nor the names of its 18 | ;; contributors may be used to endorse or promote products derived 19 | ;; from this software without specific prior written permission. 20 | ;; 21 | ;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | ;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | ;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 24 | ;; FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 25 | ;; COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 26 | ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 27 | ;; BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 28 | ;; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 29 | ;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 30 | ;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 31 | ;; ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 32 | ;; POSSIBILITY OF SUCH DAMAGE. 33 | 34 | ;;; Code: 35 | 36 | (in-package :rs-colors) 37 | 38 | (defclass generic-cmy-color (cmy-color-object generic-color-object) 39 | () 40 | (:documentation "Color class for the generic CMY color space. 41 | 42 | The generic CMY color space is a mathematical description of the 43 | CMY color model. It is not associated with a particular device.")) 44 | 45 | (defun make-generic-cmy-color (cyan magenta yellow &key byte-size) 46 | "Create a new color in the generic CMY color space. 47 | 48 | First argument CYAN is the intensity of the cyan ink. 49 | Second argument MAGENTA is the intensity of the magenta ink. 50 | Third argument YELLOW is the intensity of the yellow ink. 51 | 52 | Arguments CYAN, MAGENTA, and YELLOW have to be normalized color values 53 | in the closed interval [0, 1]. 54 | 55 | Keyword argument BYTE-SIZE is the number of bits used to represent a 56 | color value. If specified, arguments CYAN, MAGENTA, and YELLOW are 57 | scaled accordingly. 58 | 59 | Example: 60 | 61 | (make-generic-cmy-color 3/255 80/255 193/255) 62 | (make-generic-cmy-color 3 80 193 :byte-size 8)" 63 | (let (c m y) 64 | (if (not byte-size) 65 | (setf c (ensure-type cyan '(real 0 1)) 66 | m (ensure-type magenta '(real 0 1)) 67 | y (ensure-type yellow '(real 0 1))) 68 | (let ((s (1- (expt 2 (ensure-type byte-size '(integer 1)))))) 69 | (setf c (/ (ensure-type cyan `(integer 0 ,s)) s) 70 | m (/ (ensure-type magenta `(integer 0 ,s)) s) 71 | y (/ (ensure-type yellow `(integer 0 ,s)) s)))) 72 | (make-instance 'generic-cmy-color :cyan c :magenta m :yellow y))) 73 | 74 | (defun make-generic-cmy-color-from-number (value &key (byte-size 8)) 75 | "Create a new color in the generic CMY color space. 76 | 77 | Argument VALUE is a non-negative integral number. 78 | 79 | Keyword argument BYTE-SIZE is the number of bits used to represent a 80 | primary. Default is eight bit (one byte). The most significant bits 81 | denote the intensity of the cyan primary. 82 | 83 | Example: 84 | 85 | (make-generic-cmy-color-from-number #X0350C1)" 86 | (ensure-type value '(integer 0)) 87 | (ensure-type byte-size '(integer 1)) 88 | (multiple-value-bind (cyan magenta yellow) 89 | (decode-triple value byte-size) 90 | (make-generic-cmy-color cyan magenta yellow :byte-size byte-size))) 91 | 92 | (defun generic-cmy-from-generic-rgb (r g b) 93 | "Convert RGB color space coordinates 94 | into CMY color space coordinates." 95 | (declare (type real r g b)) 96 | (let ((c (- 1 r)) 97 | (m (- 1 g)) 98 | (y (- 1 b))) 99 | (values c m y))) 100 | 101 | (defun generic-rgb-from-generic-cmy (c m y) 102 | "Convert CMY color space coordinates 103 | into RGB color space coordinates." 104 | (declare (type real c m y)) 105 | (let ((r (- 1 c)) 106 | (g (- 1 m)) 107 | (b (- 1 y))) 108 | (values r g b))) 109 | 110 | (defgeneric generic-cmy-color-coordinates (color) 111 | (:documentation "Return the CMY color space coordinates of the color. 112 | 113 | Argument COLOR is a color object. 114 | 115 | Values are the intensities of the cyan, magenta, and yellow ink.") 116 | (:method ((color generic-cmy-color)) 117 | (color-coordinates color)) 118 | (:method ((color color-object)) 119 | (multiple-value-call #'generic-cmy-from-generic-rgb 120 | (generic-rgb-color-coordinates color)))) 121 | 122 | (defmethod generic-rgb-color-coordinates ((color generic-cmy-color)) 123 | (multiple-value-call #'generic-rgb-from-generic-cmy 124 | (color-coordinates color))) 125 | 126 | (defmethod update-instance-for-different-class :after ((old color-object) (new generic-cmy-color) &key) 127 | (with-slots (c m y) new 128 | (multiple-value-setq (c m y) 129 | (generic-cmy-color-coordinates old)))) 130 | 131 | ;;; generic-cmy.lisp ends here 132 | -------------------------------------------------------------------------------- /cielab.lisp: -------------------------------------------------------------------------------- 1 | ;;; cielab.lisp --- CIE L*a*b* color space. 2 | 3 | ;; Copyright (C) 2014 Ralph Schleicher 4 | 5 | ;; Redistribution and use in source and binary forms, with or without 6 | ;; modification, are permitted provided that the following conditions 7 | ;; are met: 8 | ;; 9 | ;; * Redistributions of source code must retain the above copyright 10 | ;; notice, this list of conditions and the following disclaimer. 11 | ;; 12 | ;; * Redistributions in binary form must reproduce the above copyright 13 | ;; notice, this list of conditions and the following disclaimer in 14 | ;; the documentation and/or other materials provided with the 15 | ;; distribution. 16 | ;; 17 | ;; * Neither the name of the copyright holder nor the names of its 18 | ;; contributors may be used to endorse or promote products derived 19 | ;; from this software without specific prior written permission. 20 | ;; 21 | ;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | ;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | ;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 24 | ;; FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 25 | ;; COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 26 | ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 27 | ;; BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 28 | ;; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 29 | ;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 30 | ;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 31 | ;; ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 32 | ;; POSSIBILITY OF SUCH DAMAGE. 33 | 34 | ;;; Code: 35 | 36 | (in-package :rs-colors) 37 | 38 | (defvar *cielab-default-white-point* cie-1931-white-point-d50 39 | "The default white point for colors in the CIE L*a*b* color space. 40 | Default value is the CIE 1931 D50 standard illuminant.") 41 | 42 | (defclass cielab-color (color-object) 43 | ((L* 44 | :initarg :L* 45 | :initform 0 46 | :type (real 0) 47 | :documentation "Lightness, default zero.") 48 | (a* 49 | :initarg :a* 50 | :initform 0 51 | :type real 52 | :documentation "Red/green scale, default zero.") 53 | (b* 54 | :initarg :b* 55 | :initform 0 56 | :type real 57 | :documentation "Yellow/blue scale, default zero.") 58 | (white-point 59 | :initarg :white-point 60 | :initform *cielab-default-white-point* 61 | :type color-object 62 | :documentation "White point, default ‘*cielab-default-white-point*’.")) 63 | (:documentation "Color class for the CIE L*a*b* color space.")) 64 | 65 | (defmethod color-coordinates ((color cielab-color)) 66 | (with-slots (L* a* b*) color 67 | (values L* a* b*))) 68 | 69 | (defmethod white-point ((color cielab-color)) 70 | (slot-value color 'white-point)) 71 | 72 | (defun make-cielab-color (L* a* b* &optional (white-point *cielab-default-white-point*)) 73 | "Create a new color in the CIE L*a*b* color space." 74 | (make-instance 'cielab-color :L* L* :a* a* :b* b* :white-point white-point)) 75 | 76 | (defun cielab-from-ciexyz (x y z w) 77 | "Convert CIE XYZ color space coordinates 78 | into CIE L*a*b* color space coordinates. 79 | 80 | This conversion requires a reference white point." 81 | (declare (type real x y z)) 82 | (labels ((encode (c) 83 | (if (> c 216/24389) 84 | (cube-root c) 85 | (+ (* 24389/3132 c) 16/116)))) 86 | (multiple-value-bind (xn yn zn) 87 | (ciexyz-color-coordinates (or w *cielab-default-white-point*)) 88 | (let* ((x (encode (/ x xn))) 89 | (y (encode (/ y yn))) 90 | (z (encode (/ z zn))) 91 | (L* (- (* 116 y) 16)) 92 | (a* (* 500 (- x y))) 93 | (b* (* 200 (- y z)))) 94 | (values L* a* b*))))) 95 | 96 | (defun ciexyz-from-cielab (L* a* b* w) 97 | "Convert CIE L*a*b* color space coordinates 98 | into CIE XYZ color space coordinates. 99 | 100 | This conversion requires a reference white point." 101 | (declare (type real L* a* b*)) 102 | (labels ((decode (c) 103 | (if (> c #.(cube-root 216/24389)) 104 | (cube c) 105 | (/ (- c 16/116) 24389/3132)))) 106 | (multiple-value-bind (xn yn zn) 107 | (ciexyz-color-coordinates (or w *cielab-default-white-point*)) 108 | (let* ((y (/ (+ L* 16) 116)) 109 | (x (+ y (/ a* 500))) 110 | (z (- y (/ b* 200)))) 111 | (values (* (decode x) xn) 112 | (* (decode y) yn) 113 | (* (decode z) zn)))))) 114 | 115 | (defgeneric cielab-color-coordinates (color) 116 | (:documentation "Return the CIE L*a*b* color space coordinates of the color. 117 | 118 | Argument COLOR is a color object.") 119 | (:method ((color cielab-color)) 120 | (color-coordinates color)) 121 | ;; Otherwise, go via CIE XYZ. 122 | (:method ((color color-object)) 123 | (multiple-value-bind (x y z) 124 | (ciexyz-color-coordinates color) 125 | (cielab-from-ciexyz x y z (white-point color))))) 126 | 127 | (defmethod ciexyz-color-coordinates ((color cielab-color)) 128 | (multiple-value-bind (L* a* b*) 129 | (cielab-color-coordinates color) 130 | (ciexyz-from-cielab L* a* b* (white-point color)))) 131 | 132 | (defmethod update-instance-for-different-class :after ((old color-object) (new cielab-color) &key) 133 | (with-slots (L* a* b* white-point) new 134 | (multiple-value-setq (L* a* b*) 135 | (cielab-color-coordinates old)) 136 | (setf white-point (or (white-point old) *cielab-default-white-point*)))) 137 | 138 | ;;; cielab.lisp ends here 139 | -------------------------------------------------------------------------------- /cielch.lisp: -------------------------------------------------------------------------------- 1 | ;;; cielch.lisp --- CIE L*C*h color space. 2 | 3 | ;; Copyright (C) 2016 Ralph Schleicher 4 | 5 | ;; Redistribution and use in source and binary forms, with or without 6 | ;; modification, are permitted provided that the following conditions 7 | ;; are met: 8 | ;; 9 | ;; * Redistributions of source code must retain the above copyright 10 | ;; notice, this list of conditions and the following disclaimer. 11 | ;; 12 | ;; * Redistributions in binary form must reproduce the above copyright 13 | ;; notice, this list of conditions and the following disclaimer in 14 | ;; the documentation and/or other materials provided with the 15 | ;; distribution. 16 | ;; 17 | ;; * Neither the name of the copyright holder nor the names of its 18 | ;; contributors may be used to endorse or promote products derived 19 | ;; from this software without specific prior written permission. 20 | ;; 21 | ;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | ;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | ;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 24 | ;; FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 25 | ;; COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 26 | ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 27 | ;; BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 28 | ;; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 29 | ;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 30 | ;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 31 | ;; ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 32 | ;; POSSIBILITY OF SUCH DAMAGE. 33 | 34 | ;;; Code: 35 | 36 | (in-package :rs-colors) 37 | 38 | (defvar *cielch-default-white-point* cie-1931-white-point-d50 39 | "The default white point for colors in the CIE L*C*h color space. 40 | Default value is the CIE 1931 D50 standard illuminant.") 41 | 42 | (defclass cielch-color (color-object) 43 | ((L* 44 | :initarg :L* 45 | :initform 0 46 | :type (real 0) 47 | :documentation "Lightness, default zero.") 48 | (C* 49 | :initarg :C* 50 | :initform 0 51 | :type (real 0) 52 | :documentation "Chroma, default zero.") 53 | (h 54 | :initarg :h 55 | :initform 0 56 | :type (real 0 (360)) 57 | :documentation "Hue, default zero.") 58 | (white-point 59 | :initarg :white-point 60 | :initform *cielch-default-white-point* 61 | :type color-object 62 | :documentation "White point, default ‘*cielch-default-white-point*’.")) 63 | (:documentation "Color class for the CIE L*C*h color space. 64 | Hue is measured in degree angle.")) 65 | 66 | (defmethod color-coordinates ((color cielch-color)) 67 | (with-slots (L* C* h) color 68 | (values L* C* h))) 69 | 70 | (defmethod white-point ((color cielch-color)) 71 | (slot-value color 'white-point)) 72 | 73 | (defun make-cielch-color (L* C* h &optional (white-point *cielch-default-white-point*)) 74 | "Create a new color in the CIE L*C*h color space." 75 | (make-instance 'cielch-color :L* L* :C* C* :h (mod h 360) :white-point white-point)) 76 | 77 | (defun cielch-from-cielab (L* a* b*) 78 | "Convert CIE L*a*b* color space coordinates 79 | into CIE L*C*h color space coordinates." 80 | (declare (type real L* a* b*)) 81 | ;; Attempt to be exact, see also ‘cielab-from-cielch’ below. 82 | (cond ((zerop b*) 83 | (values L* (abs a*) (if (minusp a*) 180 0))) 84 | ((zerop a*) 85 | (values L* (abs b*) (if (minusp b*) 270 90))) 86 | (t 87 | (let ((C*h (complex (float a* pi) (float b* pi)))) 88 | (values L* (abs C*h) (mod (degree-from-radian (phase C*h)) 360)))))) 89 | 90 | (defun cielab-from-cielch (L* C* h) 91 | "Convert CIE L*C*h color space coordinates 92 | into CIE L*a*b* color space coordinates." 93 | (declare (type real L* C* h)) 94 | ;; On IEEE 754 machines, and maybe others, values of sin(π) and 95 | ;; cos(π/2) are usually non-zero. 96 | (cond ((zerop C*) 97 | (values L* 0 0)) 98 | ((= h 0) 99 | (values L* C* 0)) 100 | ((= h 90) 101 | (values L* 0 C*)) 102 | ((= h 180) 103 | (values L* (- C*) 0)) 104 | ((= h 270) 105 | (values L* 0 (- C*))) 106 | (t 107 | (let ((C*h (* C* (cis (radian-from-degree (float h pi)))))) 108 | (values L* (realpart C*h) (imagpart C*h)))))) 109 | 110 | (defgeneric cielch-color-coordinates (color) 111 | (:documentation "Return the CIE L*C*h color space coordinates of the color. 112 | 113 | Argument COLOR is a color object.") 114 | (:method ((color cielch-color)) 115 | (color-coordinates color)) 116 | ;; Otherwise, go via CIE L*a*b*. 117 | (:method ((color color-object)) 118 | (multiple-value-bind (L* a* b*) 119 | (cielab-color-coordinates color) 120 | (cielch-from-cielab L* a* b*)))) 121 | 122 | (defmethod cielab-color-coordinates ((color cielch-color)) 123 | (multiple-value-bind (L* C* h) 124 | (cielch-color-coordinates color) 125 | (cielab-from-cielch L* C* h))) 126 | 127 | (defmethod ciexyz-color-coordinates ((color cielch-color)) 128 | (multiple-value-bind (L* a* b*) 129 | (cielab-color-coordinates color) 130 | (ciexyz-from-cielab L* a* b* (white-point color)))) 131 | 132 | (defmethod update-instance-for-different-class :after ((old color-object) (new cielch-color) &key) 133 | (with-slots (L* C* h white-point) new 134 | (multiple-value-setq (L* C* h) 135 | (cielch-color-coordinates old)) 136 | (setf white-point (or (white-point old) *cielch-default-white-point*)))) 137 | 138 | ;;; cielch.lisp ends here 139 | -------------------------------------------------------------------------------- /cieluv.lisp: -------------------------------------------------------------------------------- 1 | ;;; cieluv.lisp --- CIE L*u*v* color space. 2 | 3 | ;; Copyright (C) 2014 Ralph Schleicher 4 | 5 | ;; Redistribution and use in source and binary forms, with or without 6 | ;; modification, are permitted provided that the following conditions 7 | ;; are met: 8 | ;; 9 | ;; * Redistributions of source code must retain the above copyright 10 | ;; notice, this list of conditions and the following disclaimer. 11 | ;; 12 | ;; * Redistributions in binary form must reproduce the above copyright 13 | ;; notice, this list of conditions and the following disclaimer in 14 | ;; the documentation and/or other materials provided with the 15 | ;; distribution. 16 | ;; 17 | ;; * Neither the name of the copyright holder nor the names of its 18 | ;; contributors may be used to endorse or promote products derived 19 | ;; from this software without specific prior written permission. 20 | ;; 21 | ;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | ;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | ;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 24 | ;; FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 25 | ;; COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 26 | ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 27 | ;; BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 28 | ;; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 29 | ;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 30 | ;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 31 | ;; ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 32 | ;; POSSIBILITY OF SUCH DAMAGE. 33 | 34 | ;;; Code: 35 | 36 | (in-package :rs-colors) 37 | 38 | (defvar *cieluv-default-white-point* cie-1931-white-point-d50 39 | "The default white point for colors in the CIE L*u*v* color space. 40 | Default value is the CIE 1931 D50 standard illuminant.") 41 | 42 | (defclass cieluv-color (color-object) 43 | ((L* 44 | :initarg :L* 45 | :initform 0 46 | :type (real 0) 47 | :documentation "Lightness, default zero.") 48 | (u* 49 | :initarg :u* 50 | :initform 0 51 | :type real 52 | :documentation "First chromaticity coordinate, default zero.") 53 | (v* 54 | :initarg :v* 55 | :initform 0 56 | :type real 57 | :documentation "Second chromaticity coordinate, default zero.") 58 | (white-point 59 | :initarg :white-point 60 | :initform *cieluv-default-white-point* 61 | :type color-object 62 | :documentation "White point, default ‘*cieluv-default-white-point*’.")) 63 | (:documentation "Color class for the CIE L*u*v* color space.")) 64 | 65 | (defmethod color-coordinates ((color cieluv-color)) 66 | (with-slots (L* u* v*) color 67 | (values L* u* v*))) 68 | 69 | (defmethod white-point ((color cieluv-color)) 70 | (slot-value color 'white-point)) 71 | 72 | (defun make-cieluv-color (L* u* v* &optional (white-point *cieluv-default-white-point*)) 73 | "Create a new color in the CIE L*u*v* color space." 74 | (make-instance 'cieluv-color :L* L* :u* u* :v* v* :white-point white-point)) 75 | 76 | (defun cie-uv-from-xy (x y s) 77 | (declare (type real x y s)) 78 | (when (zerop s) 79 | (error 'division-by-zero 80 | :operation 'cie-uv-from-xy 81 | :operands (list x y s))) 82 | (values (/ (* 4 x) s) 83 | (/ (* 9 y) s))) 84 | 85 | (defun cieluv-from-ciexyz (x y z w) 86 | "Convert CIE XYZ color space coordinates 87 | into CIE L*u*v* color space coordinates. 88 | 89 | This conversion requires a reference white point." 90 | (declare (type real x y z)) 91 | (multiple-value-bind (x*n y*n yn) 92 | (ciexyy-color-coordinates (or w *cieluv-default-white-point*)) 93 | (multiple-value-bind (un vn) 94 | (cie-uv-from-xy x*n y*n (+ (- (* 2 x*n)) (* 12 y*n) 3)) 95 | (multiple-value-bind (u v) 96 | (cie-uv-from-xy x y (+ x (* 15 y) (* 3 z))) 97 | (let* ((L* (cie-L*-from-Y/Yn (/ y yn))) 98 | (u* (* 13 L* (- u un))) 99 | (v* (* 13 L* (- v vn)))) 100 | (values L* u* v*)))))) 101 | 102 | (defun ciexyz-from-cieluv (L* u* v* w) 103 | "Convert CIE L*u*v* color space coordinates 104 | into CIE XYZ color space coordinates. 105 | 106 | This conversion requires a reference white point." 107 | (declare (type real L* u* v*)) 108 | (multiple-value-bind (x*n y*n yn) 109 | (ciexyy-color-coordinates (or w *cieluv-default-white-point*)) 110 | (multiple-value-bind (un vn) 111 | (cie-uv-from-xy x*n y*n (+ (- (* 2 x*n)) (* 12 y*n) 3)) 112 | (let* ((u (+ (/ u* (* 13 L*) un))) 113 | (v (+ (/ v* (* 13 L*) vn))) 114 | (y (* yn (cie-Y/Yn-from-L* L*))) 115 | (x (* y (/ (* 9 u) (* 4 v)))) 116 | (z (* y (/ (- 12 (* 3 u) (* 20 v)) (* 4 v))))) 117 | (values x y z))))) 118 | 119 | (defgeneric cieluv-color-coordinates (color) 120 | (:documentation "Return the CIE L*u*v* color space coordinates of the color. 121 | 122 | Argument COLOR is a color object.") 123 | (:method ((color cieluv-color)) 124 | (color-coordinates color)) 125 | ;; Otherwise, go via CIE XYZ. 126 | (:method ((color color-object)) 127 | (multiple-value-bind (x y z) 128 | (ciexyz-color-coordinates color) 129 | (cieluv-from-ciexyz x y z (white-point color))))) 130 | 131 | (defmethod ciexyz-color-coordinates ((color cieluv-color)) 132 | (multiple-value-bind (L* u* v*) 133 | (cieluv-color-coordinates color) 134 | (ciexyz-from-cieluv L* u* v* (white-point color)))) 135 | 136 | (defmethod update-instance-for-different-class :after ((old color-object) (new cieluv-color) &key) 137 | (with-slots (L* u* v* white-point) new 138 | (multiple-value-setq (L* u* v*) 139 | (cieluv-color-coordinates old)) 140 | (setf white-point (or (white-point old) *cieluv-default-white-point*)))) 141 | 142 | ;;; cieluv.lisp ends here 143 | -------------------------------------------------------------------------------- /generic-cmyk.lisp: -------------------------------------------------------------------------------- 1 | ;;; generic-cmyk.lisp --- generic CMYK color space. 2 | 3 | ;; Copyright (C) 2014 Ralph Schleicher 4 | 5 | ;; Redistribution and use in source and binary forms, with or without 6 | ;; modification, are permitted provided that the following conditions 7 | ;; are met: 8 | ;; 9 | ;; * Redistributions of source code must retain the above copyright 10 | ;; notice, this list of conditions and the following disclaimer. 11 | ;; 12 | ;; * Redistributions in binary form must reproduce the above copyright 13 | ;; notice, this list of conditions and the following disclaimer in 14 | ;; the documentation and/or other materials provided with the 15 | ;; distribution. 16 | ;; 17 | ;; * Neither the name of the copyright holder nor the names of its 18 | ;; contributors may be used to endorse or promote products derived 19 | ;; from this software without specific prior written permission. 20 | ;; 21 | ;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | ;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | ;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 24 | ;; FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 25 | ;; COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 26 | ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 27 | ;; BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 28 | ;; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 29 | ;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 30 | ;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 31 | ;; ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 32 | ;; POSSIBILITY OF SUCH DAMAGE. 33 | 34 | ;;; Code: 35 | 36 | (in-package :rs-colors) 37 | 38 | (defclass generic-cmyk-color (cmyk-color-object generic-color-object) 39 | () 40 | (:documentation "Color class for the generic CMYK color space. 41 | 42 | The generic CMYK color space is a mathematical description of the 43 | CMYK color model. It is not associated with a particular device.")) 44 | 45 | (defun make-generic-cmyk-color (cyan magenta yellow black &key byte-size) 46 | "Create a new color in the generic CMYK color space. 47 | 48 | First argument CYAN is the intensity of the cyan ink. 49 | Second argument MAGENTA is the intensity of the magenta ink. 50 | Third argument YELLOW is the intensity of the yellow ink. 51 | Fourth argument BLACK is the intensity of the black ink. 52 | 53 | Arguments CYAN, MAGENTA, YELLOW, and BLACK have to be normalized 54 | intensity values in the closed interval [0, 1]. 55 | 56 | Keyword argument BYTE-SIZE is the number of bits used to represent a 57 | color value. If specified, arguments CYAN, MAGENTA, YELLOW, and BLACK 58 | are scaled accordingly. 59 | 60 | Example: 61 | 62 | (make-generic-cmyk-color 3/255 80/255 193/255 0) 63 | (make-generic-cmyk-color 3 80 193 0 :byte-size 8)" 64 | (let (c m y k) 65 | (if (not byte-size) 66 | (setf c (ensure-type cyan '(real 0 1)) 67 | m (ensure-type magenta '(real 0 1)) 68 | y (ensure-type yellow '(real 0 1)) 69 | k (ensure-type black '(real 0 1))) 70 | (let ((s (1- (expt 2 (ensure-type byte-size '(integer 1)))))) 71 | (setf c (/ (ensure-type cyan `(integer 0 ,s)) s) 72 | m (/ (ensure-type magenta `(integer 0 ,s)) s) 73 | y (/ (ensure-type yellow `(integer 0 ,s)) s) 74 | k (/ (ensure-type black `(integer 0 ,s)) s)))) 75 | (cond ((= k 0) 76 | (multiple-value-setq (c m y k) 77 | (generic-cmyk-from-generic-cmy c m y))) 78 | ((= k 1) 79 | (setf c 0 m 0 y 0))) 80 | (make-instance 'generic-cmyk-color :cyan c :magenta m :yellow y :black k))) 81 | 82 | (defun make-generic-cmyk-color-from-number (value &key (byte-size 8)) 83 | "Create a new color in the generic CMYK color space. 84 | 85 | Argument VALUE is a non-negative integral number. 86 | 87 | Keyword argument BYTE-SIZE is the number of bits used to represent a 88 | primary. Default is eight bit (one byte). The most significant bits 89 | denote the intensity of the cyan primary. 90 | 91 | Example: 92 | 93 | (make-generic-cmyk-color-from-number #X0350C100)" 94 | (ensure-type value '(integer 0)) 95 | (ensure-type byte-size '(integer 1)) 96 | (multiple-value-bind (cyan magenta yellow black) 97 | (decode-quadruple value byte-size) 98 | (make-generic-cmyk-color cyan magenta yellow black :byte-size byte-size))) 99 | 100 | (defun generic-cmyk-from-generic-cmy (c m y) 101 | "Convert CMY color space coordinates 102 | into CMYK color space coordinates." 103 | (declare (type real c m y)) 104 | (let* ((k (min c m y)) 105 | (1-k (- 1 k))) 106 | (if (zerop 1-k) 107 | (values 0 0 0 k) 108 | (values (/ (- c k) 1-k) 109 | (/ (- m k) 1-k) 110 | (/ (- y k) 1-k) k)))) 111 | 112 | (defun generic-cmy-from-generic-cmyk (c m y k) 113 | "Convert CMYK color space coordinates 114 | into CMY color space coordinates." 115 | (declare (type real c m y k)) 116 | (let ((1-k (- 1 k))) 117 | (values (min 1 (+ (* c 1-k) k)) 118 | (min 1 (+ (* m 1-k) k)) 119 | (min 1 (+ (* y 1-k) k))))) 120 | 121 | (defgeneric generic-cmyk-color-coordinates (color) 122 | (:documentation "Return the CMYK color space coordinates of the color. 123 | 124 | Argument COLOR is a color object. 125 | 126 | Values are the intensities of the cyan, magenta, yellow, and black ink.") 127 | (:method ((color generic-cmyk-color)) 128 | (color-coordinates color)) 129 | (:method ((color color-object)) 130 | (multiple-value-call #'generic-cmyk-from-generic-cmy 131 | (generic-cmy-color-coordinates color)))) 132 | 133 | (defmethod generic-cmy-color-coordinates ((color generic-cmyk-color)) 134 | (multiple-value-call #'generic-cmy-from-generic-cmyk 135 | (color-coordinates color))) 136 | 137 | (defmethod update-instance-for-different-class :after ((old color-object) (new generic-cmyk-color) &key) 138 | (with-slots (c m y k) new 139 | (multiple-value-setq (c m y k) 140 | (generic-cmyk-color-coordinates old)))) 141 | 142 | ;;; generic-cmyk.lisp ends here 143 | -------------------------------------------------------------------------------- /wide-gamut-rgb.lisp: -------------------------------------------------------------------------------- 1 | ;;; wide-gamut-rgb.lisp --- wide-gamut RGB color space. 2 | 3 | ;; Copyright (C) 2016 Ralph Schleicher 4 | 5 | ;; Redistribution and use in source and binary forms, with or without 6 | ;; modification, are permitted provided that the following conditions 7 | ;; are met: 8 | ;; 9 | ;; * Redistributions of source code must retain the above copyright 10 | ;; notice, this list of conditions and the following disclaimer. 11 | ;; 12 | ;; * Redistributions in binary form must reproduce the above copyright 13 | ;; notice, this list of conditions and the following disclaimer in 14 | ;; the documentation and/or other materials provided with the 15 | ;; distribution. 16 | ;; 17 | ;; * Neither the name of the copyright holder nor the names of its 18 | ;; contributors may be used to endorse or promote products derived 19 | ;; from this software without specific prior written permission. 20 | ;; 21 | ;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | ;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | ;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 24 | ;; FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 25 | ;; COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 26 | ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 27 | ;; BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 28 | ;; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 29 | ;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 30 | ;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 31 | ;; ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 32 | ;; POSSIBILITY OF SUCH DAMAGE. 33 | 34 | ;;; Code: 35 | 36 | (in-package :rs-colors) 37 | 38 | (defclass wide-gamut-rgb-color (rgb-color-object) 39 | () 40 | (:documentation "Color class for the wide-gamut RGB color space.")) 41 | 42 | (defun make-wide-gamut-rgb-color (red green blue &key byte-size) 43 | "Create a new color in the wide-gamut RGB color space. 44 | 45 | First argument RED is the intensity of the red primary. 46 | Second argument GREEN is the intensity of the green primary. 47 | Third argument BLUE is the intensity of the blue primary. 48 | 49 | Arguments RED, GREEN, and BLUE have to be normalized intensity values 50 | in the closed interval [0, 1]. 51 | 52 | Keyword argument BYTE-SIZE is the number of bits used to represent a 53 | primary. If specified, arguments RED, GREEN, and BLUE are scaled 54 | accordingly. 55 | 56 | Example: 57 | 58 | (make-wide-gamut-rgb-color 252/255 175/255 62/255) 59 | (make-wide-gamut-rgb-color 252 175 62 :byte-size 8)" 60 | (make-rgb-color 'wide-gamut-rgb-color red green blue byte-size)) 61 | 62 | (defun make-wide-gamut-rgb-color-from-number (value &key (byte-size 8)) 63 | "Create a new color in the wide-gamut RGB color space. 64 | 65 | Argument VALUE is a non-negative integral number. 66 | 67 | Keyword argument BYTE-SIZE is the number of bits used to represent a 68 | primary. Default is eight bit (one byte). The most significant bits 69 | denote the intensity of the red primary. 70 | 71 | Example: 72 | 73 | (make-wide-gamut-rgb-color-from-number #XFCAF3E)" 74 | (make-rgb-color-from-number 'wide-gamut-rgb-color value byte-size)) 75 | 76 | (defconst wide-gamut-rgb-white-point (make-ciexyy-color 3457/10000 3585/10000 1) 77 | "White point of the wide-gamut RGB color space.") 78 | 79 | (defmethod white-point ((color wide-gamut-rgb-color)) 80 | wide-gamut-rgb-white-point) 81 | 82 | (eval-when (:compile-toplevel :load-toplevel :execute) 83 | (multiple-value-bind (rgb-from-xyz xyz-from-rgb) 84 | (rgb-transformation-matrices #(7347/10000 2653/10000) 85 | #(1152/10000 8264/10000) 86 | #(1566/10000 177/10000) 87 | (multiple-value-bind (x* y*) 88 | (ciexyy-color-coordinates wide-gamut-rgb-white-point) 89 | (vector x* y*))) 90 | (defconst wide-gamut-rgb-from-ciexyz-transformation-matrix (float-array rgb-from-xyz 1D0) 91 | "Transformation matrix to convert normalized CIE XYZ color space coordinates 92 | into linear wide-gamut RGB color space coordinates.") 93 | (defconst ciexyz-from-wide-gamut-rgb-transformation-matrix (float-array xyz-from-rgb 1D0) 94 | "Transformation matrix to convert linear wide-gamut RGB color space coordinates 95 | into normalized CIE XYZ color space coordinates.") 96 | (values))) 97 | 98 | (defun wide-gamut-rgb-from-ciexyz (x y z) 99 | "Convert normalized CIE XYZ color space coordinates 100 | into wide-gamut RGB color space coordinates." 101 | (declare (type real x y z)) 102 | (multiple-value-bind (r g b) 103 | (linear-transformation wide-gamut-rgb-from-ciexyz-transformation-matrix x y z) 104 | (declare (type real r g b)) 105 | (values (adobe-rgb-gamma-encoding (clamp r 0 1)) 106 | (adobe-rgb-gamma-encoding (clamp g 0 1)) 107 | (adobe-rgb-gamma-encoding (clamp b 0 1))))) 108 | 109 | (defun ciexyz-from-wide-gamut-rgb (r g b) 110 | "Convert wide-gamut RGB color space coordinates 111 | into normalized CIE XYZ color space coordinates." 112 | (declare (type real r g b)) 113 | (linear-transformation ciexyz-from-wide-gamut-rgb-transformation-matrix 114 | (adobe-rgb-gamma-decoding r) 115 | (adobe-rgb-gamma-decoding g) 116 | (adobe-rgb-gamma-decoding b))) 117 | 118 | (defgeneric wide-gamut-rgb-color-coordinates (color) 119 | (:documentation "Return the wide-gamut RGB color space coordinates of the color. 120 | 121 | Argument COLOR is a color object. 122 | 123 | Values are the intensities of the red, green, and blue primary.") 124 | (:method ((color wide-gamut-rgb-color)) 125 | (color-coordinates color)) 126 | (:method ((color generic-color-object)) 127 | (generic-rgb-color-coordinates color)) 128 | ;; Otherwise, go via CIE XYZ. 129 | (:method ((color color-object)) 130 | (multiple-value-call #'wide-gamut-rgb-from-ciexyz 131 | (ciexyz-color-coordinates color)))) 132 | 133 | (defmethod generic-rgb-color-coordinates ((color wide-gamut-rgb-color)) 134 | (color-coordinates color)) 135 | 136 | (defmethod ciexyz-color-coordinates ((color wide-gamut-rgb-color)) 137 | (multiple-value-call #'ciexyz-from-wide-gamut-rgb (color-coordinates color))) 138 | 139 | (defmethod update-instance-for-different-class :after ((old color-object) (new wide-gamut-rgb-color) &key) 140 | (with-slots (r g b) new 141 | (multiple-value-setq (r g b) 142 | (wide-gamut-rgb-color-coordinates old)))) 143 | 144 | ;;; wide-gamut-rgb.lisp ends here 145 | -------------------------------------------------------------------------------- /misc/cie_1964_standard_observer.txt: -------------------------------------------------------------------------------- 1 | 380 0.00016 1.7E-5 0.000705 2 | 385 0.000662 7.2E-5 0.002928 3 | 390 0.002362 0.000253 0.010482 4 | 395 0.007242 0.000769 0.032344 5 | 400 0.01911 0.002004 0.086011 6 | 405 0.0434 0.004509 0.19712 7 | 410 0.084736 0.008756 0.389366 8 | 415 0.140638 0.014456 0.65676 9 | 420 0.204492 0.021391 0.972542 10 | 425 0.264737 0.029497 1.2825 11 | 430 0.314679 0.038676 1.55348 12 | 435 0.357719 0.049602 1.7985 13 | 440 0.383734 0.062077 1.96728 14 | 445 0.386726 0.074704 2.0273 15 | 450 0.370702 0.089456 1.9948 16 | 455 0.342957 0.106256 1.9007 17 | 460 0.302273 0.128201 1.74537 18 | 465 0.254085 0.152761 1.5549 19 | 466 0.2432475 0.1586186 1.512042 20 | 467 0.2319496 0.1648612 1.467117 21 | 468 0.2202236 0.1714178 1.419887 22 | 469 0.2081022 0.1782176 1.370114 23 | 470 0.195618 0.18519 1.31756 24 | 471 0.1828311 0.1922623 1.26219 25 | 472 0.1699124 0.1993548 1.204785 26 | 473 0.1570602 0.2063862 1.146329 27 | 474 0.1444729 0.2132751 1.087806 28 | 475 0.132349 0.21994 1.0302 29 | 476 0.120846 0.2263518 0.9743491 30 | 477 0.1099575 0.2326904 0.9205078 31 | 478 0.09963629 0.239188 0.8687844 32 | 479 0.08983521 0.2460768 0.8192873 33 | 480 0.080507 0.253589 0.772125 34 | 481 0.07161855 0.2618691 0.7273653 35 | 482 0.06319327 0.2707107 0.6849138 36 | 483 0.05526873 0.27982 0.6446357 37 | 484 0.04788245 0.2889027 0.6063961 38 | 485 0.041072 0.297665 0.57006 39 | 486 0.03486852 0.3059148 0.5355169 40 | 487 0.0292776 0.3138684 0.5027536 41 | 488 0.02429842 0.3218438 0.4717812 42 | 489 0.01993016 0.3301593 0.442611 43 | 490 0.016172 0.339133 0.415254 44 | 491 0.01301216 0.3490061 0.3896918 45 | 492 0.01039492 0.3597114 0.3657875 46 | 493 0.008253606 0.3711048 0.3433745 47 | 494 0.006521527 0.3830421 0.3222862 48 | 495 0.005132 0.395379 0.302356 49 | 496 0.004040958 0.4079935 0.2834515 50 | 497 0.003294809 0.420852 0.2655762 51 | 498 0.002962582 0.4339431 0.2487677 52 | 499 0.003113303 0.4472552 0.2330638 53 | 500 0.003816 0.460777 0.218502 54 | 501 0.005119052 0.4744987 0.2050809 55 | 502 0.006988242 0.4884183 0.1926422 56 | 503 0.009368707 0.5025352 0.1809889 57 | 504 0.01220558 0.5168493 0.1699236 58 | 505 0.015444 0.53136 0.159249 59 | 506 0.01904291 0.5460662 0.1488256 60 | 507 0.02301648 0.5609631 0.1387446 61 | 508 0.0273927 0.576045 0.1291547 62 | 509 0.03219954 0.5913062 0.1202049 63 | 510 0.037465 0.606741 0.112044 64 | 511 0.04321471 0.6223385 0.1047725 65 | 512 0.04946494 0.6380665 0.09829797 66 | 513 0.05622962 0.6538877 0.09247956 67 | 514 0.06352266 0.6697647 0.0871765 68 | 515 0.071358 0.68566 0.082248 69 | 516 0.0797383 0.7015176 0.07757258 70 | 517 0.08862118 0.7172061 0.07310594 71 | 518 0.09795302 0.7325755 0.06882312 72 | 519 0.1076802 0.7474758 0.06469914 73 | 520 0.117749 0.761757 0.060709 74 | 521 0.1281188 0.7753066 0.056837 75 | 522 0.1388003 0.7881629 0.05310449 76 | 523 0.1498174 0.8004016 0.04954208 77 | 524 0.1611937 0.8120987 0.04618038 78 | 525 0.172953 0.82333 0.04305 79 | 526 0.1851043 0.8341717 0.04016966 80 | 527 0.1975981 0.8447021 0.03751042 81 | 528 0.21037 0.8549997 0.03503145 82 | 529 0.2233557 0.8651431 0.03269192 83 | 530 0.236491 0.875211 0.030451 84 | 531 0.249728 0.8852551 0.02827815 85 | 532 0.2630845 0.8952196 0.02618405 86 | 533 0.2765947 0.905022 0.02418967 87 | 534 0.2902928 0.9145796 0.022316 88 | 535 0.304213 0.92381 0.020584 89 | 536 0.318377 0.9326291 0.0190058 90 | 537 0.3327561 0.9409474 0.01755808 91 | 538 0.3473091 0.9486739 0.01620865 92 | 539 0.3619948 0.9557177 0.01492535 93 | 540 0.376772 0.961988 0.013676 94 | 541 0.3916074 0.9674229 0.01243726 95 | 542 0.4064996 0.9720774 0.01122119 96 | 543 0.4214554 0.9760357 0.01004869 97 | 544 0.4364813 0.9793818 0.008940661 98 | 545 0.451584 0.9822 0.007918 99 | 546 0.4667809 0.9845779 0.006994978 100 | 547 0.4821324 0.9866174 0.006159347 101 | 548 0.4977096 0.9884241 0.005392226 102 | 549 0.5135838 0.9901034 0.004674737 103 | 550 0.529826 0.991761 0.003988 104 | 551 0.5464835 0.9934678 0.003319025 105 | 552 0.5635077 0.9951573 0.002678381 106 | 553 0.5808257 0.9967282 0.002082523 107 | 554 0.5983651 0.9980795 0.001547911 108 | 555 0.616053 0.99911 0.001091 109 | 556 0.6338253 0.9997301 0.0007238649 110 | 557 0.651651 0.9998957 0.0004410432 111 | 558 0.6695077 0.9995742 0.0002326891 112 | 559 0.6873729 0.9987332 8.895665E-5 113 | 560 0.705224 0.99734 0.0 114 | 565 0.793832 0.98238 0.0 115 | 570 0.878655 0.955552 0.0 116 | 575 0.951162 0.915175 0.0 117 | 580 1.01416 0.868934 0.0 118 | 585 1.0743 0.825623 0.0 119 | 590 1.11852 0.777405 0.0 120 | 595 1.1343 0.720353 0.0 121 | 600 1.12399 0.658341 0.0 122 | 605 1.0891 0.593878 0.0 123 | 610 1.03048 0.527963 0.0 124 | 615 0.95074 0.461834 0.0 125 | 620 0.856297 0.398057 0.0 126 | 625 0.75493 0.339554 0.0 127 | 630 0.647467 0.283493 0.0 128 | 635 0.53511 0.228254 0.0 129 | 640 0.431567 0.179828 0.0 130 | 645 0.34369 0.140211 0.0 131 | 650 0.268329 0.107633 0.0 132 | 655 0.2043 0.081187 0.0 133 | 660 0.152568 0.060281 0.0 134 | 665 0.11221 0.044096 0.0 135 | 670 0.081261 0.0318 0.0 136 | 675 0.05793 0.022602 0.0 137 | 680 0.040851 0.015905 0.0 138 | 685 0.028623 0.01113 0.0 139 | 690 0.019941 0.007749 0.0 140 | 695 0.013842 0.005375 0.0 141 | 700 0.009577 0.003718 0.0 142 | 705 0.006605 0.002565 0.0 143 | 710 0.004553 0.001768 0.0 144 | 715 0.003145 0.001222 0.0 145 | 720 0.002175 0.000846 0.0 146 | 725 0.001506 0.000586 0.0 147 | 730 0.001045 0.000407 0.0 148 | 735 0.000727 0.000284 0.0 149 | 740 0.000508 0.000199 0.0 150 | 745 0.000356 0.00014 0.0 151 | 750 0.000251 9.8E-5 0.0 152 | 755 0.000178 7.0E-5 0.0 153 | 760 0.000126 5.0E-5 0.0 154 | 765 9.0E-5 3.6E-5 0.0 155 | 770 6.5E-5 2.5E-5 0.0 156 | 775 4.6E-5 1.8E-5 0.0 157 | 780 3.3E-5 1.3E-5 0.0 158 | -------------------------------------------------------------------------------- /misc/color_matching_functions.m: -------------------------------------------------------------------------------- 1 | % color_matching_functions -- process color matching functions. 2 | % 3 | % color_matching_functions(id) 4 | % 5 | % Process color matching functions. 6 | % 7 | % Argument ID is either 1931, i.e. the CIE 1931 standard observer, 8 | % or 1964, i.e. the CIE 1964 standard observer. 9 | 10 | %% color_matching_functions.m --- the preceding comment is the documentation string. 11 | 12 | % Copyright (C) 2020 Ralph Schleicher 13 | 14 | % Redistribution and use in source and binary forms, with or without 15 | % modification, are permitted provided that the following conditions 16 | % are met: 17 | % 18 | % * Redistributions of source code must retain the above copyright 19 | % notice, this list of conditions and the following disclaimer. 20 | % 21 | % * Redistributions in binary form must reproduce the above copyright 22 | % notice, this list of conditions and the following disclaimer in 23 | % the documentation and/or other materials provided with the 24 | % distribution. 25 | % 26 | % * The name of the author may not be used to endorse or promote 27 | % products derived from this software without specific prior 28 | % written permission. 29 | % 30 | % THIS SOFTWARE IS PROVIDED BY THE AUTHOR "AS IS" AND ANY EXPRESS 31 | % OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 32 | % WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 33 | % ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, 34 | % INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES 35 | % (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 36 | % SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 37 | % HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, 38 | % STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING 39 | % IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 40 | % POSSIBILITY OF SUCH DAMAGE. 41 | 42 | %% Code: 43 | 44 | % Program entry point. 45 | function color_matching_functions(id) 46 | 47 | if nargin < 1 48 | color_matching_functions(1931); 49 | color_matching_functions(1964); 50 | return; 51 | end 52 | 53 | switch id 54 | case {1931, 1964} 55 | from = sprintf('204_%d_col_observer.csv', id); 56 | to = sprintf('cie_%d_standard_observer.txt', id); 57 | otherwise 58 | error('Unknown identifier.'); 59 | end 60 | 61 | % Input data with a step size of 5 nm. 62 | d5 = csvread(from); 63 | 64 | % Interpolate with a step size of 1 nm. 65 | d1l = interp(d5, 380:780, 'linear'); 66 | d1c = interp(d5, 380:780, 'pchip'); 67 | d1s = interp(d5, 380:780, 'spline'); 68 | 69 | % Output data with a step size of 1 nm in the range from LOW to HIGH. 70 | d1 = d1s; 71 | 72 | switch id 73 | case 1931 74 | low = 450; 75 | high = 575; 76 | case 1964 77 | low = 465; 78 | high = 560; 79 | end 80 | 81 | % Merge 5 nm and 1 nm data sets. 82 | d51 = sortrows([d5(d5(:, 1) < low+1 | d5(:, 1) > high-1, :); ... 83 | d1(d1(:, 1) > low & d1(:, 1) < high , :)], 1); 84 | 85 | % Save it. 86 | c = cell(size(d51)); 87 | c(:, 1) = num2cell(d51(:, 1)); 88 | c(:, 2) = format(d51(:, 2)); 89 | c(:, 3) = format(d51(:, 3)); 90 | c(:, 4) = format(d51(:, 4)); 91 | 92 | h = fopen(to, 'w'); 93 | if h == -1 94 | error('Can not open file ''%s'' for writing.', to); 95 | end 96 | for i = 1:size(c, 1) 97 | fprintf(h, '%3d %s %s %s\n', c{i, :}); 98 | end 99 | if fclose(h) == -1 100 | error('Can not close file ''%s''.', to); 101 | end 102 | 103 | % Visualization. 104 | switch 0 105 | case 1 106 | [x5, y5] = cie_xy(d5); 107 | [x1l, y1l] = cie_xy(d1l); 108 | [x1c, y1c] = cie_xy(d1c); 109 | [x1s, y1s] = cie_xy(d1s); 110 | [x51, y51] = cie_xy(d51); 111 | 112 | figure(1); 113 | plot(x5, y5, 'k.', ... 114 | x1l, y1l, 'r', ... 115 | x1c, y1c, 'g', ... 116 | x1s, y1s, 'b', ... 117 | x51, y51, 'm'); 118 | for k = 1:numel(x5) 119 | text(x5(k), y5(k), sprintf(' %d ', d5(k, 1))); 120 | end 121 | 122 | % Distance to linear interpolation. 123 | r1l = hypot(x1l - x1l, y1l - y1l); 124 | r1c = hypot(x1c - x1l, y1c - y1l); 125 | r1s = hypot(x1s - x1l, y1s - y1l); 126 | 127 | % Distance to CIE standard illuminant E. 128 | a1l = hypot(x1l - 1/3, y1l - 1/3); 129 | a1c = hypot(x1c - 1/3, y1c - 1/3); 130 | a1s = hypot(x1s - 1/3, y1s - 1/3); 131 | 132 | figure(2); 133 | subplot(3, 1, 1); 134 | plot(d1l(:, 1), r1l, 'r', ... 135 | d1c(:, 1), r1c, 'g', ... 136 | d1s(:, 1), r1s, 'b'); 137 | title('Distance to Linear Interpolation'); 138 | subplot(3, 1, 2); 139 | plot(d1l(:, 1), a1l, 'r', ... 140 | d1c(:, 1), a1c, 'g', ... 141 | d1s(:, 1), a1s, 'b'); 142 | title('Absolute Distance to CIE standard illuminant E'); 143 | subplot(3, 1, 3); 144 | plot(d1l(:, 1), (a1l ./ a1l - 1) .* 100, 'r', ... 145 | d1c(:, 1), (a1c ./ a1l - 1) .* 100, 'g', ... 146 | d1s(:, 1), (a1s ./ a1l - 1) .* 100, 'b'); 147 | title('Relative Distance to CIE standard illuminant E'); 148 | ylabel('%'); 149 | linkaxes(get(gcf, 'Children'), 'x'); 150 | end 151 | 152 | % Interpolate data set. 153 | function d1 = interp(d5, xi, method) 154 | 155 | x = d5(:, 1); 156 | y = d5(:, 2:4); 157 | 158 | xi = xi(:); 159 | yi = interp1(x, y, xi, method); 160 | 161 | d1 = [xi, yi]; 162 | 163 | % Format numbers. 164 | function str = format(num) 165 | 166 | % Need FLT_DIG+1 significant digits for reading NUM as 167 | % single-precision floating-point numbers. 168 | str = arrayfun(@(a) sprintf('%.7G', a), num, 'UniformOutput', false); 169 | 170 | % If the G conversion uses exponential notation, ensure 171 | % there is a decimal point. 172 | k = cellfun(@(c) any(c == 'E'), str); 173 | % Remove leading zeros in exponent. 174 | str(k) = regexprep(str(k), '(E[-+])0+', '$1'); 175 | % Insert decimal point. 176 | k = k & cellfun(@(c) all(c ~= '.'), str); 177 | str(k) = strrep(str(k), 'E', '.0E'); 178 | 179 | % Add a decimal point to integers, too. 180 | k = cellfun(@(c) all(c ~= '.'), str); 181 | str(k) = cellfun(@(c) [c, '.0'], str(k), 'UniformOutput', false); 182 | 183 | % Align numbers at the decimal point. 184 | k = cellfun(@(c) min([find(c == '.'), find(c == 'E'), numel(c) + 1]), str); 185 | pad = arrayfun(@(a) repmat(' ', 1, a), max(k) - k, 'UniformOutput', false); 186 | str = arrayfun(@(k) [pad{k}, str{k}], (1:numel(str)).', 'UniformOutput', false); 187 | 188 | % Equal length. 189 | k = cellfun(@numel, str); 190 | pad = arrayfun(@(a) repmat(' ', 1, a), max(k) - k, 'UniformOutput', false); 191 | str = arrayfun(@(k) [str{k}, pad{k}], (1:numel(str)).', 'UniformOutput', false); 192 | 193 | % Chromaticity coordinates. 194 | function [x, y] = cie_xy(dat) 195 | 196 | tem = sum(dat(:, 2:4), 2); 197 | 198 | x = dat(:, 2) ./ tem; 199 | y = dat(:, 3) ./ tem; 200 | 201 | %% color_matching_functions.m ends here 202 | -------------------------------------------------------------------------------- /adobe-rgb.lisp: -------------------------------------------------------------------------------- 1 | ;;; adobe-rgb.lisp --- Adobe RGB color space. 2 | 3 | ;; Copyright (C) 2014 Ralph Schleicher 4 | 5 | ;; Redistribution and use in source and binary forms, with or without 6 | ;; modification, are permitted provided that the following conditions 7 | ;; are met: 8 | ;; 9 | ;; * Redistributions of source code must retain the above copyright 10 | ;; notice, this list of conditions and the following disclaimer. 11 | ;; 12 | ;; * Redistributions in binary form must reproduce the above copyright 13 | ;; notice, this list of conditions and the following disclaimer in 14 | ;; the documentation and/or other materials provided with the 15 | ;; distribution. 16 | ;; 17 | ;; * Neither the name of the copyright holder nor the names of its 18 | ;; contributors may be used to endorse or promote products derived 19 | ;; from this software without specific prior written permission. 20 | ;; 21 | ;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | ;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | ;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 24 | ;; FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 25 | ;; COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 26 | ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 27 | ;; BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 28 | ;; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 29 | ;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 30 | ;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 31 | ;; ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 32 | ;; POSSIBILITY OF SUCH DAMAGE. 33 | 34 | ;;; Code: 35 | 36 | (in-package :rs-colors) 37 | 38 | (defclass adobe-rgb-color (rgb-color-object) 39 | () 40 | (:documentation "Color class for the Adobe RGB color space.")) 41 | 42 | (defun make-adobe-rgb-color (red green blue &key byte-size) 43 | "Create a new color in the Adobe RGB color space. 44 | 45 | First argument RED is the intensity of the red primary. 46 | Second argument GREEN is the intensity of the green primary. 47 | Third argument BLUE is the intensity of the blue primary. 48 | 49 | Arguments RED, GREEN, and BLUE have to be normalized intensity values 50 | in the closed interval [0, 1]. 51 | 52 | Keyword argument BYTE-SIZE is the number of bits used to represent a 53 | primary. If specified, arguments RED, GREEN, and BLUE are scaled 54 | accordingly. 55 | 56 | Example: 57 | 58 | (make-adobe-rgb-color 252/255 175/255 62/255) 59 | (make-adobe-rgb-color 252 175 62 :byte-size 8)" 60 | (make-rgb-color 'adobe-rgb-color red green blue byte-size)) 61 | 62 | (defun make-adobe-rgb-color-from-number (value &key (byte-size 8)) 63 | "Create a new color in the Adobe RGB color space. 64 | 65 | Argument VALUE is a non-negative integral number. 66 | 67 | Keyword argument BYTE-SIZE is the number of bits used to represent a 68 | primary. Default is eight bit (one byte). The most significant bits 69 | denote the intensity of the red primary. 70 | 71 | Example: 72 | 73 | (make-adobe-rgb-color-from-number #XFCAF3E)" 74 | (make-rgb-color-from-number 'adobe-rgb-color value byte-size)) 75 | 76 | (defconst adobe-rgb-white-point (make-ciexyy-color 3127/10000 3290/10000 1) 77 | "White point of the Adobe RGB color space.") 78 | 79 | (defmethod white-point ((color adobe-rgb-color)) 80 | adobe-rgb-white-point) 81 | 82 | (eval-when (:compile-toplevel :load-toplevel :execute) 83 | (multiple-value-bind (rgb-from-xyz xyz-from-rgb) 84 | (rgb-transformation-matrices #(64/100 33/100) 85 | #(21/100 71/100) 86 | #(15/100 6/100) 87 | (multiple-value-bind (x* y*) 88 | (ciexyy-color-coordinates adobe-rgb-white-point) 89 | (vector x* y*))) 90 | (defconst adobe-rgb-from-ciexyz-transformation-matrix (float-array rgb-from-xyz 1D0) 91 | "Transformation matrix to convert normalized CIE XYZ color space coordinates 92 | into linear Adobe RGB color space coordinates.") 93 | (defconst ciexyz-from-adobe-rgb-transformation-matrix (float-array xyz-from-rgb 1D0) 94 | "Transformation matrix to convert linear Adobe RGB color space coordinates 95 | into normalized CIE XYZ color space coordinates.") 96 | (values))) 97 | 98 | ;; §4.3.1.2 The Inverse Color Component Transfer Function 99 | ;; 100 | ;; The value 2.19921875 is obtained from 2 51/256 or 101 | ;; hexadecimal 02.33. 102 | (defun adobe-rgb-gamma-encoding (c) 103 | "Convert linear Adobe RGB color space coordinates 104 | into Adobe RGB color space coordinates." 105 | (declare (type real c)) 106 | (cond ((= c 0) 107 | 0) 108 | ((= c 1) 109 | 1) 110 | (t 111 | (expt c #.(float 563/256 1D0))))) 112 | 113 | (defun adobe-rgb-gamma-decoding (c) 114 | "Convert Adobe RGB color space coordinates 115 | into linear Adobe RGB color space coordinates." 116 | (declare (type real c)) 117 | (cond ((= c 0) 118 | 0) 119 | ((= c 1) 120 | 1) 121 | (t 122 | (expt c #.(float 256/563 1D0))))) 123 | 124 | (defun adobe-rgb-from-ciexyz (x y z) 125 | "Convert normalized CIE XYZ color space coordinates 126 | into Adobe RGB color space coordinates." 127 | (declare (type real x y z)) 128 | (multiple-value-bind (r g b) 129 | (linear-transformation adobe-rgb-from-ciexyz-transformation-matrix x y z) 130 | (declare (type real r g b)) 131 | (values (adobe-rgb-gamma-encoding (clamp r 0 1)) 132 | (adobe-rgb-gamma-encoding (clamp g 0 1)) 133 | (adobe-rgb-gamma-encoding (clamp b 0 1))))) 134 | 135 | (defun ciexyz-from-adobe-rgb (r g b) 136 | "Convert Adobe RGB color space coordinates 137 | into normalized CIE XYZ color space coordinates." 138 | (declare (type real r g b)) 139 | (linear-transformation ciexyz-from-adobe-rgb-transformation-matrix 140 | (adobe-rgb-gamma-decoding r) 141 | (adobe-rgb-gamma-decoding g) 142 | (adobe-rgb-gamma-decoding b))) 143 | 144 | (defgeneric adobe-rgb-color-coordinates (color) 145 | (:documentation "Return the Adobe RGB color space coordinates of the color. 146 | 147 | Argument COLOR is a color object. 148 | 149 | Values are the intensities of the red, green, and blue primary.") 150 | (:method ((color adobe-rgb-color)) 151 | (color-coordinates color)) 152 | (:method ((color generic-color-object)) 153 | (generic-rgb-color-coordinates color)) 154 | ;; Otherwise, go via CIE XYZ. 155 | (:method ((color color-object)) 156 | (multiple-value-call #'adobe-rgb-from-ciexyz 157 | (ciexyz-color-coordinates color)))) 158 | 159 | (defmethod generic-rgb-color-coordinates ((color adobe-rgb-color)) 160 | (color-coordinates color)) 161 | 162 | (defmethod ciexyz-color-coordinates ((color adobe-rgb-color)) 163 | (multiple-value-call #'ciexyz-from-adobe-rgb (color-coordinates color))) 164 | 165 | (defmethod update-instance-for-different-class :after ((old color-object) (new adobe-rgb-color) &key) 166 | (with-slots (r g b) new 167 | (multiple-value-setq (r g b) 168 | (adobe-rgb-color-coordinates old)))) 169 | 170 | ;;; adobe-rgb.lisp ends here 171 | -------------------------------------------------------------------------------- /dictionaries/rs-colors-svg.lisp: -------------------------------------------------------------------------------- 1 | ;;; rs-colors-svg.lisp --- SVG color names. 2 | 3 | ;; Copyright (C) 2014 Ralph Schleicher 4 | 5 | ;; Redistribution and use in source and binary forms, with or without 6 | ;; modification, are permitted provided that the following conditions 7 | ;; are met: 8 | ;; 9 | ;; * Redistributions of source code must retain the above copyright 10 | ;; notice, this list of conditions and the following disclaimer. 11 | ;; 12 | ;; * Redistributions in binary form must reproduce the above copyright 13 | ;; notice, this list of conditions and the following disclaimer in 14 | ;; the documentation and/or other materials provided with the 15 | ;; distribution. 16 | ;; 17 | ;; * Neither the name of the copyright holder nor the names of its 18 | ;; contributors may be used to endorse or promote products derived 19 | ;; from this software without specific prior written permission. 20 | ;; 21 | ;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | ;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | ;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 24 | ;; FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 25 | ;; COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 26 | ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 27 | ;; BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 28 | ;; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 29 | ;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 30 | ;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 31 | ;; ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 32 | ;; POSSIBILITY OF SUCH DAMAGE. 33 | 34 | ;;; Code: 35 | 36 | (in-package :common-lisp-user) 37 | 38 | (defpackage :rs-colors-svg 39 | (:nicknames :svg-color) 40 | (:use :common-lisp 41 | :rs-colors 42 | :rs-colors-internal) 43 | (:shadow #:tan) 44 | (:documentation "SVG color names. 45 | 46 | See 47 | and .")) 48 | 49 | (in-package :rs-colors-svg) 50 | 51 | (defmacro RGB (r g b name &rest aliases) 52 | `(define-color-names (,name ,@aliases) 53 | (make-srgb-color ,r ,g ,b :byte-size 8) 54 | ,(format nil "SVG color rgb(~A, ~A, ~A)." r g b))) 55 | 56 | (RGB 240 248 255 aliceblue) 57 | (RGB 250 235 215 antiquewhite) 58 | (RGB 127 255 212 aquamarine) 59 | (RGB 240 255 255 azure) 60 | (RGB 245 245 220 beige) 61 | (RGB 255 228 196 bisque) 62 | (RGB 0 0 0 black) 63 | (RGB 255 235 205 blanchedalmond) 64 | (RGB 0 0 255 blue) 65 | (RGB 138 43 226 blueviolet) 66 | (RGB 165 42 42 brown) 67 | (RGB 222 184 135 burlywood) 68 | (RGB 95 158 160 cadetblue) 69 | (RGB 127 255 0 chartreuse) 70 | (RGB 210 105 30 chocolate) 71 | (RGB 255 127 80 coral) 72 | (RGB 100 149 237 cornflowerblue) 73 | (RGB 255 248 220 cornsilk) 74 | (RGB 220 20 60 crimson) 75 | (RGB 0 255 255 cyan 76 | aqua) 77 | (RGB 0 0 139 darkblue) 78 | (RGB 0 139 139 darkcyan) 79 | (RGB 184 134 11 darkgoldenrod) 80 | (RGB 169 169 169 darkgray 81 | darkgrey) 82 | (RGB 0 100 0 darkgreen) 83 | (RGB 189 183 107 darkkhaki) 84 | (RGB 139 0 139 darkmagenta) 85 | (RGB 85 107 47 darkolivegreen) 86 | (RGB 255 140 0 darkorange) 87 | (RGB 153 50 204 darkorchid) 88 | (RGB 139 0 0 darkred) 89 | (RGB 233 150 122 darksalmon) 90 | (RGB 143 188 143 darkseagreen) 91 | (RGB 72 61 139 darkslateblue) 92 | (RGB 47 79 79 darkslategray 93 | darkslategrey) 94 | (RGB 0 206 209 darkturquoise) 95 | (RGB 148 0 211 darkviolet) 96 | (RGB 255 20 147 deeppink) 97 | (RGB 0 191 255 deepskyblue) 98 | (RGB 105 105 105 dimgray 99 | dimgrey) 100 | (RGB 30 144 255 dodgerblue) 101 | (RGB 178 34 34 firebrick) 102 | (RGB 255 250 240 floralwhite) 103 | (RGB 34 139 34 forestgreen) 104 | (RGB 220 220 220 gainsboro) 105 | (RGB 248 248 255 ghostwhite) 106 | (RGB 255 215 0 gold) 107 | (RGB 218 165 32 goldenrod) 108 | (RGB 128 128 128 gray 109 | grey) 110 | (RGB 0 128 0 green) 111 | (RGB 173 255 47 greenyellow) 112 | (RGB 240 255 240 honeydew) 113 | (RGB 255 105 180 hotpink) 114 | (RGB 205 92 92 indianred) 115 | (RGB 75 0 130 indigo) 116 | (RGB 255 255 240 ivory) 117 | (RGB 240 230 140 khaki) 118 | (RGB 230 230 250 lavender) 119 | (RGB 255 240 245 lavenderblush) 120 | (RGB 124 252 0 lawngreen) 121 | (RGB 255 250 205 lemonchiffon) 122 | (RGB 173 216 230 lightblue) 123 | (RGB 240 128 128 lightcoral) 124 | (RGB 224 255 255 lightcyan) 125 | (RGB 250 250 210 lightgoldenrodyellow) 126 | (RGB 211 211 211 lightgray 127 | lightgrey) 128 | (RGB 144 238 144 lightgreen) 129 | (RGB 255 182 193 lightpink) 130 | (RGB 255 160 122 lightsalmon) 131 | (RGB 32 178 170 lightseagreen) 132 | (RGB 135 206 250 lightskyblue) 133 | (RGB 119 136 153 lightslategray 134 | lightslategrey) 135 | (RGB 176 196 222 lightsteelblue) 136 | (RGB 255 255 224 lightyellow) 137 | (RGB 0 255 0 lime) 138 | (RGB 50 205 50 limegreen) 139 | (RGB 250 240 230 linen) 140 | (RGB 255 0 255 magenta 141 | fuchsia) 142 | (RGB 128 0 0 maroon) 143 | (RGB 102 205 170 mediumaquamarine) 144 | (RGB 0 0 205 mediumblue) 145 | (RGB 186 85 211 mediumorchid) 146 | (RGB 147 112 219 mediumpurple) 147 | (RGB 60 179 113 mediumseagreen) 148 | (RGB 123 104 238 mediumslateblue) 149 | (RGB 0 250 154 mediumspringgreen) 150 | (RGB 72 209 204 mediumturquoise) 151 | (RGB 199 21 133 mediumvioletred) 152 | (RGB 25 25 112 midnightblue) 153 | (RGB 245 255 250 mintcream) 154 | (RGB 255 228 225 mistyrose) 155 | (RGB 255 228 181 moccasin) 156 | (RGB 255 222 173 navajowhite) 157 | (RGB 0 0 128 navy) 158 | (RGB 253 245 230 oldlace) 159 | (RGB 128 128 0 olive) 160 | (RGB 107 142 35 olivedrab) 161 | (RGB 255 165 0 orange) 162 | (RGB 255 69 0 orangered) 163 | (RGB 218 112 214 orchid) 164 | (RGB 238 232 170 palegoldenrod) 165 | (RGB 152 251 152 palegreen) 166 | (RGB 175 238 238 paleturquoise) 167 | (RGB 219 112 147 palevioletred) 168 | (RGB 255 239 213 papayawhip) 169 | (RGB 255 218 185 peachpuff) 170 | (RGB 205 133 63 peru) 171 | (RGB 255 192 203 pink) 172 | (RGB 221 160 221 plum) 173 | (RGB 176 224 230 powderblue) 174 | (RGB 128 0 128 purple) 175 | (RGB 255 0 0 red) 176 | (RGB 188 143 143 rosybrown) 177 | (RGB 65 105 225 royalblue) 178 | (RGB 139 69 19 saddlebrown) 179 | (RGB 250 128 114 salmon) 180 | (RGB 244 164 96 sandybrown) 181 | (RGB 46 139 87 seagreen) 182 | (RGB 255 245 238 seashell) 183 | (RGB 160 82 45 sienna) 184 | (RGB 192 192 192 silver) 185 | (RGB 135 206 235 skyblue) 186 | (RGB 106 90 205 slateblue) 187 | (RGB 112 128 144 slategray 188 | slategrey) 189 | (RGB 255 250 250 snow) 190 | (RGB 0 255 127 springgreen) 191 | (RGB 70 130 180 steelblue) 192 | (RGB 210 180 140 tan) 193 | (RGB 0 128 128 teal) 194 | (RGB 216 191 216 thistle) 195 | (RGB 255 99 71 tomato) 196 | (RGB 64 224 208 turquoise) 197 | (RGB 238 130 238 violet) 198 | (RGB 245 222 179 wheat) 199 | (RGB 255 255 255 white) 200 | (RGB 245 245 245 whitesmoke) 201 | (RGB 255 255 0 yellow) 202 | (RGB 154 205 50 yellowgreen) 203 | 204 | ;;; rs-colors-svg.lisp ends here 205 | -------------------------------------------------------------------------------- /dictionaries/rs-colors-tango.lisp: -------------------------------------------------------------------------------- 1 | ;;; rs-colors-tango.lisp --- Tango desktop project colors. 2 | 3 | ;; Copyright (C) 2014 Ralph Schleicher 4 | 5 | ;; Redistribution and use in source and binary forms, with or without 6 | ;; modification, are permitted provided that the following conditions 7 | ;; are met: 8 | ;; 9 | ;; * Redistributions of source code must retain the above copyright 10 | ;; notice, this list of conditions and the following disclaimer. 11 | ;; 12 | ;; * Redistributions in binary form must reproduce the above copyright 13 | ;; notice, this list of conditions and the following disclaimer in 14 | ;; the documentation and/or other materials provided with the 15 | ;; distribution. 16 | ;; 17 | ;; * Neither the name of the copyright holder nor the names of its 18 | ;; contributors may be used to endorse or promote products derived 19 | ;; from this software without specific prior written permission. 20 | ;; 21 | ;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | ;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | ;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 24 | ;; FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 25 | ;; COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 26 | ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 27 | ;; BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 28 | ;; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 29 | ;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 30 | ;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 31 | ;; ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 32 | ;; POSSIBILITY OF SUCH DAMAGE. 33 | 34 | ;;; Code: 35 | 36 | (in-package :common-lisp-user) 37 | 38 | (defpackage :rs-colors-tango 39 | (:nicknames :tango-color) 40 | (:use :common-lisp 41 | :rs-colors 42 | :rs-colors-internal) 43 | (:documentation "Tango desktop project colors.")) 44 | 45 | (in-package :rs-colors-tango) 46 | 47 | (defmacro RGB (value name &rest aliases) 48 | `(define-color-names (,name ,@aliases) 49 | (make-srgb-color-from-number ,value) 50 | ,(format nil "Tango desktop project color #~6,'0,X." value))) 51 | 52 | (RGB #X000000 black) 53 | (RGB #XFFFFFF white) 54 | 55 | (RGB #XFCE94F yellow1 butter1) 56 | (RGB #XEDD400 yellow2 butter2) 57 | (RGB #XC4A000 yellow3 butter3) 58 | 59 | (RGB #XFCAF3E orange1) 60 | (RGB #XF57900 orange2) 61 | (RGB #XCE5C00 orange3) 62 | 63 | (RGB #XE9B96E brown1 chocolate1) 64 | (RGB #XC17D11 brown2 chocolate2) 65 | (RGB #X8F5902 brown3 chocolate3) 66 | 67 | (RGB #X8AE234 green1 chameleon1) 68 | (RGB #X73D216 green2 chameleon2) 69 | (RGB #X4E9A06 green3 chameleon3) 70 | 71 | (RGB #X729FCF blue1 skyblue1) 72 | (RGB #X3465A4 blue2 skyblue2) 73 | (RGB #X204A87 blue3 skyblue3) 74 | 75 | (RGB #XAD7FA8 purple1 plum1) 76 | (RGB #X75507B purple2 plum2) 77 | (RGB #X5C3566 purple3 plum3) 78 | 79 | (RGB #XEF2929 red1 scarletred1) 80 | (RGB #XCC0000 red2 scarletred2) 81 | (RGB #XA40000 red3 scarletred3) 82 | 83 | (RGB #XEEEEEC gray1 grey1 aluminium1) 84 | (RGB #XD3D7CF gray2 grey2 aluminium2) 85 | (RGB #XBABDB6 gray3 grey3 aluminium3) 86 | (RGB #X888A85 gray4 grey4 aluminium4) 87 | (RGB #X555753 gray5 grey5 aluminium5) 88 | (RGB #X2E3436 gray6 grey6 aluminium6) 89 | 90 | (export 'yellow) 91 | (defun yellow (&optional (brightness :normal)) 92 | "Return shades of yellow. 93 | 94 | Optional argument BRIGHTNESS is either :light, :normal, or :dark. 95 | Default is to return the normal color. 96 | 97 | Value is an RGB color object." 98 | (ecase brightness 99 | (:light 100 | yellow1) 101 | (:normal 102 | yellow2) 103 | (:dark 104 | yellow3))) 105 | 106 | (export 'orange) 107 | (defun orange (&optional (brightness :normal)) 108 | "Return shades of orange. 109 | 110 | Optional argument BRIGHTNESS is either :light, :normal, or :dark. 111 | Default is to return the normal color. 112 | 113 | Value is an RGB color object." 114 | (ecase brightness 115 | (:light 116 | orange1) 117 | (:normal 118 | orange2) 119 | (:dark 120 | orange3))) 121 | 122 | (export 'brown) 123 | (defun brown (&optional (brightness :normal)) 124 | "Return shades of brown. 125 | 126 | Optional argument BRIGHTNESS is either :light, :normal, or :dark. 127 | Default is to return the normal color. 128 | 129 | Value is an RGB color object." 130 | (ecase brightness 131 | (:light 132 | brown1) 133 | (:normal 134 | brown2) 135 | (:dark 136 | brown3))) 137 | 138 | (export 'green) 139 | (defun green (&optional (brightness :normal)) 140 | "Return shades of green. 141 | 142 | Optional argument BRIGHTNESS is either :light, :normal, or :dark. 143 | Default is to return the normal color. 144 | 145 | Value is an RGB color object." 146 | (ecase brightness 147 | (:light 148 | green1) 149 | (:normal 150 | green2) 151 | (:dark 152 | green3))) 153 | 154 | (export 'blue) 155 | (defun blue (&optional (brightness :normal)) 156 | "Return shades of blue. 157 | 158 | Optional argument BRIGHTNESS is either :light, :normal, or :dark. 159 | Default is to return the normal color. 160 | 161 | Value is an RGB color object." 162 | (ecase brightness 163 | (:light 164 | blue1) 165 | (:normal 166 | blue2) 167 | (:dark 168 | blue3))) 169 | 170 | (export 'purple) 171 | (defun purple (&optional (brightness :normal)) 172 | "Return shades of purple. 173 | 174 | Optional argument BRIGHTNESS is either :light, :normal, or :dark. 175 | Default is to return the normal color. 176 | 177 | Value is an RGB color object." 178 | (ecase brightness 179 | (:light 180 | purple1) 181 | (:normal 182 | purple2) 183 | (:dark 184 | purple3))) 185 | 186 | (export 'red) 187 | (defun red (&optional (brightness :normal)) 188 | "Return shades of red. 189 | 190 | Optional argument BRIGHTNESS is either :light, :normal, or :dark. 191 | Default is to return the normal color. 192 | 193 | Value is an RGB color object." 194 | (ecase brightness 195 | (:light 196 | red1) 197 | (:normal 198 | red2) 199 | (:dark 200 | red3))) 201 | 202 | (export 'light-gray) 203 | (defun light-gray (&optional (brightness :normal)) 204 | "Return shades of light gray. 205 | 206 | Optional argument BRIGHTNESS is either :light, :normal, or :dark. 207 | Default is to return the normal color. 208 | 209 | Value is an RGB color object." 210 | (ecase brightness 211 | (:light 212 | gray1) 213 | (:normal 214 | gray2) 215 | (:dark 216 | gray3))) 217 | 218 | (export 'dark-gray) 219 | (defun dark-gray (&optional (brightness :normal)) 220 | "Return shades of dark gray. 221 | 222 | Optional argument BRIGHTNESS is either :light, :normal, or :dark. 223 | Default is to return the normal color. 224 | 225 | Value is an RGB color object." 226 | (ecase brightness 227 | (:light 228 | gray4) 229 | (:normal 230 | gray5) 231 | (:dark 232 | gray6))) 233 | 234 | ;;; rs-colors-tango.lisp ends here 235 | -------------------------------------------------------------------------------- /srgb.lisp: -------------------------------------------------------------------------------- 1 | ;;; srgb.lisp --- sRGB color space. 2 | 3 | ;; Copyright (C) 2014 Ralph Schleicher 4 | 5 | ;; Redistribution and use in source and binary forms, with or without 6 | ;; modification, are permitted provided that the following conditions 7 | ;; are met: 8 | ;; 9 | ;; * Redistributions of source code must retain the above copyright 10 | ;; notice, this list of conditions and the following disclaimer. 11 | ;; 12 | ;; * Redistributions in binary form must reproduce the above copyright 13 | ;; notice, this list of conditions and the following disclaimer in 14 | ;; the documentation and/or other materials provided with the 15 | ;; distribution. 16 | ;; 17 | ;; * Neither the name of the copyright holder nor the names of its 18 | ;; contributors may be used to endorse or promote products derived 19 | ;; from this software without specific prior written permission. 20 | ;; 21 | ;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | ;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | ;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 24 | ;; FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 25 | ;; COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 26 | ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 27 | ;; BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 28 | ;; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 29 | ;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 30 | ;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 31 | ;; ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 32 | ;; POSSIBILITY OF SUCH DAMAGE. 33 | 34 | ;;; Commentary: 35 | 36 | ;; See 37 | ;; and . 38 | 39 | ;;; Code: 40 | 41 | (in-package :rs-colors) 42 | 43 | (defclass srgb-color (rgb-color-object) 44 | () 45 | (:documentation "Color class for the sRGB color space.")) 46 | 47 | (defun make-srgb-color (red green blue &key byte-size) 48 | "Create a new color in the sRGB color space. 49 | 50 | First argument RED is the intensity of the red primary. 51 | Second argument GREEN is the intensity of the green primary. 52 | Third argument BLUE is the intensity of the blue primary. 53 | 54 | Arguments RED, GREEN, and BLUE have to be normalized intensity values 55 | in the closed interval [0, 1]. 56 | 57 | Keyword argument BYTE-SIZE is the number of bits used to represent a 58 | primary. If specified, arguments RED, GREEN, and BLUE are scaled 59 | accordingly. 60 | 61 | Example: 62 | 63 | (make-srgb-color 252/255 175/255 62/255) 64 | (make-srgb-color 252 175 62 :byte-size 8)" 65 | (make-rgb-color 'srgb-color red green blue byte-size)) 66 | 67 | (defun make-srgb-color-from-number (value &key (byte-size 8)) 68 | "Create a new color in the sRGB color space. 69 | 70 | Argument VALUE is a non-negative integral number. 71 | 72 | Keyword argument BYTE-SIZE is the number of bits used to represent a 73 | primary. Default is eight bit (one byte). The most significant bits 74 | denote the intensity of the red primary. 75 | 76 | Example: 77 | 78 | (make-srgb-color-from-number #XFCAF3E)" 79 | (make-rgb-color-from-number 'srgb-color value byte-size)) 80 | 81 | ;; ITU-R BT.709 truncates the CIE 1931 color space chromaticity 82 | ;; coordinates of the D65 standard illuminant to four decimal 83 | ;; places. 84 | (defconst srgb-white-point (make-ciexyy-color 3127/10000 3290/10000 1) 85 | "White point of the sRGB color space.") 86 | 87 | (defmethod white-point ((color srgb-color)) 88 | srgb-white-point) 89 | 90 | (eval-when (:compile-toplevel :load-toplevel :execute) 91 | (multiple-value-bind (rgb-from-xyz xyz-from-rgb) 92 | (rgb-transformation-matrices #(64/100 33/100) 93 | #(30/100 60/100) 94 | #(15/100 6/100) 95 | (multiple-value-bind (x* y*) 96 | (ciexyy-color-coordinates srgb-white-point) 97 | (vector x* y*))) 98 | (defconst srgb-from-ciexyz-transformation-matrix (float-array rgb-from-xyz 1D0) 99 | "Transformation matrix to convert normalized CIE XYZ color space coordinates 100 | into linear sRGB color space coordinates.") 101 | (defconst ciexyz-from-srgb-transformation-matrix (float-array xyz-from-rgb 1D0) 102 | "Transformation matrix to convert linear sRGB color space coordinates 103 | into normalized CIE XYZ color space coordinates.") 104 | (values))) 105 | 106 | (defun srgb-gamma-encoding (c) 107 | "Convert linear sRGB color space coordinates 108 | into sRGB color space coordinates." 109 | (declare (type real c)) 110 | (cond ((= c 0) 111 | 0) 112 | ((= c 1) 113 | 1) 114 | ((> c 0.0031308D0) 115 | (- (* (expt (float c 1D0) 10/24) 1.055D0) 0.055D0)) 116 | (t 117 | (* c 12.92D0)))) 118 | 119 | (defun srgb-gamma-decoding (c) 120 | "Convert sRGB color space coordinates 121 | into linear sRGB color space coordinates." 122 | (declare (type real c)) 123 | (cond ((= c 0) 124 | 0) 125 | ((= c 1) 126 | 1) 127 | ((> c 0.04045D0) 128 | (expt (/ (+ c 0.055D0) 1.055D0) 2.4D0)) 129 | (t 130 | (/ c 12.92D0)))) 131 | 132 | (defun srgb-from-ciexyz (x y z) 133 | "Convert normalized CIE XYZ color space coordinates 134 | into sRGB color space coordinates." 135 | (declare (type real x y z)) 136 | (multiple-value-bind (r g b) 137 | (linear-transformation srgb-from-ciexyz-transformation-matrix x y z) 138 | (declare (type real r g b)) 139 | (values (srgb-gamma-encoding (clamp r 0 1)) 140 | (srgb-gamma-encoding (clamp g 0 1)) 141 | (srgb-gamma-encoding (clamp b 0 1))))) 142 | 143 | (defun ciexyz-from-srgb (r g b) 144 | "Convert sRGB color space coordinates 145 | into normalized CIE XYZ color space coordinates." 146 | (declare (type real r g b)) 147 | (linear-transformation ciexyz-from-srgb-transformation-matrix 148 | (srgb-gamma-decoding r) 149 | (srgb-gamma-decoding g) 150 | (srgb-gamma-decoding b))) 151 | 152 | (defgeneric srgb-color-coordinates (color) 153 | (:documentation "Return the sRGB color space coordinates of the color. 154 | 155 | Argument COLOR is a color object. 156 | 157 | Values are the intensities of the red, green, and blue primary.") 158 | (:method ((color srgb-color)) 159 | (color-coordinates color)) 160 | (:method ((color generic-color-object)) 161 | (generic-rgb-color-coordinates color)) 162 | ;; Otherwise, go via CIE XYZ. 163 | (:method ((color color-object)) 164 | (multiple-value-call #'srgb-from-ciexyz 165 | (ciexyz-color-coordinates color)))) 166 | 167 | (defmethod generic-rgb-color-coordinates ((color srgb-color)) 168 | (color-coordinates color)) 169 | 170 | (defmethod ciexyz-color-coordinates ((color srgb-color)) 171 | (multiple-value-call #'ciexyz-from-srgb 172 | (color-coordinates color))) 173 | 174 | (defmethod update-instance-for-different-class :after ((old color-object) (new srgb-color) &key) 175 | (with-slots (r g b) new 176 | (multiple-value-setq (r g b) 177 | (srgb-color-coordinates old)))) 178 | 179 | ;;; srgb.lisp ends here 180 | -------------------------------------------------------------------------------- /missing: -------------------------------------------------------------------------------- 1 | #! /bin/sh 2 | # Common wrapper for a few potentially missing GNU programs. 3 | 4 | scriptversion=2018-03-07.03; # UTC 5 | 6 | # Copyright (C) 1996-2018 Free Software Foundation, Inc. 7 | # Originally written by Fran,cois Pinard , 1996. 8 | 9 | # This program is free software; you can redistribute it and/or modify 10 | # it under the terms of the GNU General Public License as published by 11 | # the Free Software Foundation; either version 2, or (at your option) 12 | # any later version. 13 | 14 | # This program is distributed in the hope that it will be useful, 15 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 16 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 17 | # GNU General Public License for more details. 18 | 19 | # You should have received a copy of the GNU General Public License 20 | # along with this program. If not, see . 21 | 22 | # As a special exception to the GNU General Public License, if you 23 | # distribute this file as part of a program that contains a 24 | # configuration script generated by Autoconf, you may include it under 25 | # the same distribution terms that you use for the rest of that program. 26 | 27 | if test $# -eq 0; then 28 | echo 1>&2 "Try '$0 --help' for more information" 29 | exit 1 30 | fi 31 | 32 | case $1 in 33 | 34 | --is-lightweight) 35 | # Used by our autoconf macros to check whether the available missing 36 | # script is modern enough. 37 | exit 0 38 | ;; 39 | 40 | --run) 41 | # Back-compat with the calling convention used by older automake. 42 | shift 43 | ;; 44 | 45 | -h|--h|--he|--hel|--help) 46 | echo "\ 47 | $0 [OPTION]... PROGRAM [ARGUMENT]... 48 | 49 | Run 'PROGRAM [ARGUMENT]...', returning a proper advice when this fails due 50 | to PROGRAM being missing or too old. 51 | 52 | Options: 53 | -h, --help display this help and exit 54 | -v, --version output version information and exit 55 | 56 | Supported PROGRAM values: 57 | aclocal autoconf autoheader autom4te automake makeinfo 58 | bison yacc flex lex help2man 59 | 60 | Version suffixes to PROGRAM as well as the prefixes 'gnu-', 'gnu', and 61 | 'g' are ignored when checking the name. 62 | 63 | Send bug reports to ." 64 | exit $? 65 | ;; 66 | 67 | -v|--v|--ve|--ver|--vers|--versi|--versio|--version) 68 | echo "missing $scriptversion (GNU Automake)" 69 | exit $? 70 | ;; 71 | 72 | -*) 73 | echo 1>&2 "$0: unknown '$1' option" 74 | echo 1>&2 "Try '$0 --help' for more information" 75 | exit 1 76 | ;; 77 | 78 | esac 79 | 80 | # Run the given program, remember its exit status. 81 | "$@"; st=$? 82 | 83 | # If it succeeded, we are done. 84 | test $st -eq 0 && exit 0 85 | 86 | # Also exit now if we it failed (or wasn't found), and '--version' was 87 | # passed; such an option is passed most likely to detect whether the 88 | # program is present and works. 89 | case $2 in --version|--help) exit $st;; esac 90 | 91 | # Exit code 63 means version mismatch. This often happens when the user 92 | # tries to use an ancient version of a tool on a file that requires a 93 | # minimum version. 94 | if test $st -eq 63; then 95 | msg="probably too old" 96 | elif test $st -eq 127; then 97 | # Program was missing. 98 | msg="missing on your system" 99 | else 100 | # Program was found and executed, but failed. Give up. 101 | exit $st 102 | fi 103 | 104 | perl_URL=https://www.perl.org/ 105 | flex_URL=https://github.com/westes/flex 106 | gnu_software_URL=https://www.gnu.org/software 107 | 108 | program_details () 109 | { 110 | case $1 in 111 | aclocal|automake) 112 | echo "The '$1' program is part of the GNU Automake package:" 113 | echo "<$gnu_software_URL/automake>" 114 | echo "It also requires GNU Autoconf, GNU m4 and Perl in order to run:" 115 | echo "<$gnu_software_URL/autoconf>" 116 | echo "<$gnu_software_URL/m4/>" 117 | echo "<$perl_URL>" 118 | ;; 119 | autoconf|autom4te|autoheader) 120 | echo "The '$1' program is part of the GNU Autoconf package:" 121 | echo "<$gnu_software_URL/autoconf/>" 122 | echo "It also requires GNU m4 and Perl in order to run:" 123 | echo "<$gnu_software_URL/m4/>" 124 | echo "<$perl_URL>" 125 | ;; 126 | esac 127 | } 128 | 129 | give_advice () 130 | { 131 | # Normalize program name to check for. 132 | normalized_program=`echo "$1" | sed ' 133 | s/^gnu-//; t 134 | s/^gnu//; t 135 | s/^g//; t'` 136 | 137 | printf '%s\n' "'$1' is $msg." 138 | 139 | configure_deps="'configure.ac' or m4 files included by 'configure.ac'" 140 | case $normalized_program in 141 | autoconf*) 142 | echo "You should only need it if you modified 'configure.ac'," 143 | echo "or m4 files included by it." 144 | program_details 'autoconf' 145 | ;; 146 | autoheader*) 147 | echo "You should only need it if you modified 'acconfig.h' or" 148 | echo "$configure_deps." 149 | program_details 'autoheader' 150 | ;; 151 | automake*) 152 | echo "You should only need it if you modified 'Makefile.am' or" 153 | echo "$configure_deps." 154 | program_details 'automake' 155 | ;; 156 | aclocal*) 157 | echo "You should only need it if you modified 'acinclude.m4' or" 158 | echo "$configure_deps." 159 | program_details 'aclocal' 160 | ;; 161 | autom4te*) 162 | echo "You might have modified some maintainer files that require" 163 | echo "the 'autom4te' program to be rebuilt." 164 | program_details 'autom4te' 165 | ;; 166 | bison*|yacc*) 167 | echo "You should only need it if you modified a '.y' file." 168 | echo "You may want to install the GNU Bison package:" 169 | echo "<$gnu_software_URL/bison/>" 170 | ;; 171 | lex*|flex*) 172 | echo "You should only need it if you modified a '.l' file." 173 | echo "You may want to install the Fast Lexical Analyzer package:" 174 | echo "<$flex_URL>" 175 | ;; 176 | help2man*) 177 | echo "You should only need it if you modified a dependency" \ 178 | "of a man page." 179 | echo "You may want to install the GNU Help2man package:" 180 | echo "<$gnu_software_URL/help2man/>" 181 | ;; 182 | makeinfo*) 183 | echo "You should only need it if you modified a '.texi' file, or" 184 | echo "any other file indirectly affecting the aspect of the manual." 185 | echo "You might want to install the Texinfo package:" 186 | echo "<$gnu_software_URL/texinfo/>" 187 | echo "The spurious makeinfo call might also be the consequence of" 188 | echo "using a buggy 'make' (AIX, DU, IRIX), in which case you might" 189 | echo "want to install GNU make:" 190 | echo "<$gnu_software_URL/make/>" 191 | ;; 192 | *) 193 | echo "You might have modified some files without having the proper" 194 | echo "tools for further handling them. Check the 'README' file, it" 195 | echo "often tells you about the needed prerequisites for installing" 196 | echo "this package. You may also peek at any GNU archive site, in" 197 | echo "case some other package contains this missing '$1' program." 198 | ;; 199 | esac 200 | } 201 | 202 | give_advice "$1" | sed -e '1s/^/WARNING: /' \ 203 | -e '2,$s/^/ /' >&2 204 | 205 | # Propagate the correct exit status (expected to be 127 for a program 206 | # not found, 63 for a program that failed due to version mismatch). 207 | exit $st 208 | 209 | # Local variables: 210 | # eval: (add-hook 'before-save-hook 'time-stamp) 211 | # time-stamp-start: "scriptversion=" 212 | # time-stamp-format: "%:y-%02m-%02d.%02H" 213 | # time-stamp-time-zone: "UTC0" 214 | # time-stamp-end: "; # UTC" 215 | # End: 216 | -------------------------------------------------------------------------------- /misc/cie_1931_standard_observer.txt: -------------------------------------------------------------------------------- 1 | 380 0.001368 3.9E-5 0.00645 2 | 385 0.002236 6.4E-5 0.01055 3 | 390 0.004243 0.00012 0.02005 4 | 395 0.00765 0.000217 0.03621 5 | 400 0.01431 0.000396 0.06785 6 | 405 0.02319 0.00064 0.1102 7 | 410 0.04351 0.00121 0.2074 8 | 415 0.07763 0.00218 0.3713 9 | 420 0.13438 0.004 0.6456 10 | 425 0.21477 0.0073 1.03905 11 | 430 0.2839 0.0116 1.3856 12 | 435 0.3285 0.01684 1.62296 13 | 440 0.34828 0.023 1.74706 14 | 445 0.34806 0.0298 1.7826 15 | 450 0.3362 0.038 1.77211 16 | 451 0.3332235 0.03984569 1.768377 17 | 452 0.3300701 0.04176509 1.764171 18 | 453 0.3266549 0.04376163 1.759031 19 | 454 0.3228932 0.04583879 1.752495 20 | 455 0.3187 0.048 1.7441 21 | 456 0.3140107 0.05024722 1.733474 22 | 457 0.3088406 0.05257638 1.720598 23 | 458 0.3032252 0.05498194 1.705546 24 | 459 0.2971998 0.05745833 1.68839 25 | 460 0.2908 0.06 1.6692 26 | 461 0.2840345 0.06260464 1.647912 27 | 462 0.2768059 0.06528299 1.62391 28 | 463 0.26899 0.06804901 1.596443 29 | 464 0.2604627 0.07091669 1.564757 30 | 465 0.2511 0.0739 1.5281 31 | 466 0.2408413 0.07701245 1.48607 32 | 467 0.2298805 0.08026559 1.439663 33 | 468 0.2184751 0.08367051 1.390224 34 | 469 0.2068824 0.08723829 1.339102 35 | 470 0.19536 0.09098 1.28764 36 | 471 0.1841196 0.09490605 1.236942 37 | 472 0.1731902 0.0990241 1.187136 38 | 473 0.1625549 0.1033411 1.138104 39 | 474 0.1521971 0.1078641 1.089731 40 | 475 0.1421 0.1126 1.0419 41 | 476 0.1322525 0.1175502 0.9945442 42 | 477 0.1226658 0.1226939 0.9477929 43 | 478 0.1133568 0.1280044 0.9018245 44 | 479 0.1043426 0.1334553 0.8568173 45 | 480 0.09564 0.13902 0.81295 46 | 481 0.08727035 0.1446855 0.7703949 47 | 482 0.07927288 0.1504923 0.7293002 48 | 483 0.07169123 0.1564943 0.689808 49 | 484 0.06456905 0.1627456 0.6520606 50 | 485 0.05795 0.1693 0.6162 51 | 486 0.05186237 0.1762077 0.5823285 52 | 487 0.04627304 0.183503 0.5503884 53 | 488 0.04113352 0.1912165 0.520282 54 | 489 0.03639533 0.1993786 0.4919118 55 | 490 0.03201 0.20802 0.46518 56 | 491 0.0279372 0.217164 0.439994 57 | 492 0.02416929 0.2268059 0.4162809 58 | 493 0.02070678 0.2369338 0.3939728 59 | 494 0.01755018 0.2475357 0.3730018 60 | 495 0.0147 0.2586 0.3533 61 | 496 0.01215545 0.2701351 0.3348039 62 | 497 0.009910513 0.2822317 0.3174674 63 | 498 0.007957846 0.2950007 0.301249 64 | 499 0.006290119 0.3085531 0.2861071 65 | 500 0.0049 0.323 0.272 66 | 501 0.003784501 0.3384105 0.2588604 67 | 502 0.002958014 0.3546861 0.2465173 68 | 503 0.002439277 0.3716864 0.234774 69 | 504 0.002247026 0.3892712 0.2234338 70 | 505 0.0024 0.4073 0.2123 71 | 506 0.002919343 0.425663 0.2012187 72 | 507 0.003835831 0.444372 0.1902075 73 | 508 0.005182647 0.4634696 0.179327 74 | 509 0.006992976 0.4829981 0.1686377 75 | 510 0.0093 0.503 0.1582 76 | 511 0.01213413 0.5234905 0.1480729 77 | 512 0.01551466 0.5443762 0.1383086 78 | 513 0.01945813 0.5655367 0.1289579 79 | 514 0.02398107 0.5868515 0.1200715 80 | 515 0.0291 0.6082 0.1117 81 | 516 0.03482391 0.629452 0.1038854 82 | 517 0.0411316 0.6504376 0.09663478 83 | 518 0.04799433 0.6709772 0.08994645 84 | 519 0.05538338 0.6908912 0.08381874 85 | 520 0.06327 0.71 0.07825 86 | 521 0.07162897 0.7281721 0.07322669 87 | 522 0.08044911 0.7454688 0.06868786 88 | 523 0.08972277 0.7619994 0.06456068 89 | 524 0.09944229 0.7778733 0.06077233 90 | 525 0.1096 0.7932 0.05725 91 | 526 0.1201787 0.8080612 0.0539295 92 | 527 0.131123 0.8224282 0.05078123 93 | 528 0.1423679 0.8362446 0.0477842 94 | 529 0.1538486 0.849454 0.04491745 95 | 530 0.1655 0.862 0.04216 96 | 531 0.1772709 0.8738426 0.03949537 97 | 532 0.1891644 0.8850072 0.03692506 98 | 533 0.2011976 0.8955355 0.03445507 99 | 534 0.2133871 0.9054692 0.03209138 100 | 535 0.22575 0.91485 0.02984 101 | 536 0.2383002 0.9237123 0.02770549 102 | 537 0.2510405 0.9320609 0.02568676 103 | 538 0.2639706 0.9398934 0.02378127 104 | 539 0.2770905 0.9472073 0.02198653 105 | 540 0.2904 0.954 0.0203 106 | 541 0.3038983 0.9602711 0.01871915 107 | 542 0.3175817 0.9660276 0.01724136 108 | 543 0.331446 0.9712785 0.01586399 109 | 544 0.3454869 0.976033 0.01458442 110 | 545 0.3597 0.9803 0.0134 111 | 546 0.374083 0.9840911 0.0123076 112 | 547 0.3886418 0.9874277 0.01130206 113 | 548 0.403384 0.9903337 0.01037772 114 | 549 0.4183175 0.9928332 0.009528924 115 | 550 0.43345 0.99495 0.00875 116 | 551 0.4487867 0.9967031 0.008035648 117 | 552 0.4643227 0.998091 0.007381992 118 | 553 0.4800502 0.9991074 0.006785511 119 | 554 0.4959619 0.9997459 0.006242687 120 | 555 0.51205 1.0 0.00575 121 | 556 0.5283041 0.9998611 0.005303807 122 | 557 0.5447015 0.9993116 0.00489997 123 | 558 0.561217 0.9983315 0.00453423 124 | 559 0.577825 0.9969009 0.004202327 125 | 560 0.5945 0.995 0.0039 126 | 561 0.6112199 0.9926157 0.003623526 127 | 562 0.6279755 0.9897624 0.003371328 128 | 563 0.6447613 0.9864612 0.003142367 129 | 564 0.6615714 0.9827333 0.002935604 130 | 565 0.6784 0.9786 0.00275 131 | 566 0.6952373 0.9740777 0.002584491 132 | 567 0.7120567 0.9691637 0.002437918 133 | 568 0.7288274 0.963851 0.0023091 134 | 569 0.7455188 0.9581322 0.002196855 135 | 570 0.7621 0.952 0.0021 136 | 571 0.7785421 0.9454513 0.002017311 137 | 572 0.7948233 0.9384994 0.001947399 138 | 573 0.8109234 0.9311619 0.001888831 139 | 574 0.8268223 0.9234563 0.001840175 140 | 575 0.8425 0.9154 0.0018 141 | 580 0.9163 0.87 0.00165 142 | 585 0.9786 0.8163 0.0014 143 | 590 1.0263 0.757 0.0011 144 | 595 1.0567 0.6949 0.001 145 | 600 1.0622 0.631 0.0008 146 | 605 1.0456 0.5668 0.0006 147 | 610 1.0026 0.503 0.00034 148 | 615 0.9384 0.4412 0.00024 149 | 620 0.85445 0.381 0.00019 150 | 625 0.7514 0.321 0.0001 151 | 630 0.6424 0.265 5.0E-5 152 | 635 0.5419 0.217 3.0E-5 153 | 640 0.4479 0.175 2.0E-5 154 | 645 0.3608 0.1382 1.0E-5 155 | 650 0.2835 0.107 0.0 156 | 655 0.2187 0.0816 0.0 157 | 660 0.1649 0.061 0.0 158 | 665 0.1212 0.04458 0.0 159 | 670 0.0874 0.032 0.0 160 | 675 0.0636 0.0232 0.0 161 | 680 0.04677 0.017 0.0 162 | 685 0.0329 0.01192 0.0 163 | 690 0.0227 0.00821 0.0 164 | 695 0.01584 0.005723 0.0 165 | 700 0.011359 0.004102 0.0 166 | 705 0.008111 0.002929 0.0 167 | 710 0.00579 0.002091 0.0 168 | 715 0.004109 0.001484 0.0 169 | 720 0.002899 0.001047 0.0 170 | 725 0.002049 0.00074 0.0 171 | 730 0.00144 0.00052 0.0 172 | 735 0.001 0.000361 0.0 173 | 740 0.00069 0.000249 0.0 174 | 745 0.000476 0.000172 0.0 175 | 750 0.000332 0.00012 0.0 176 | 755 0.000235 8.5E-5 0.0 177 | 760 0.000166 6.0E-5 0.0 178 | 765 0.000117 4.2E-5 0.0 179 | 770 8.3E-5 3.0E-5 0.0 180 | 775 5.9E-5 2.1E-5 0.0 181 | 780 4.2E-5 1.5E-5 0.0 182 | -------------------------------------------------------------------------------- /rs-colors.lisp: -------------------------------------------------------------------------------- 1 | ;;; rs-colors.lisp --- a color data type for Common Lisp. 2 | 3 | ;; Copyright (C) 2014 Ralph Schleicher 4 | 5 | ;; Redistribution and use in source and binary forms, with or without 6 | ;; modification, are permitted provided that the following conditions 7 | ;; are met: 8 | ;; 9 | ;; * Redistributions of source code must retain the above copyright 10 | ;; notice, this list of conditions and the following disclaimer. 11 | ;; 12 | ;; * Redistributions in binary form must reproduce the above copyright 13 | ;; notice, this list of conditions and the following disclaimer in 14 | ;; the documentation and/or other materials provided with the 15 | ;; distribution. 16 | ;; 17 | ;; * Neither the name of the copyright holder nor the names of its 18 | ;; contributors may be used to endorse or promote products derived 19 | ;; from this software without specific prior written permission. 20 | ;; 21 | ;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | ;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | ;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 24 | ;; FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 25 | ;; COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 26 | ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 27 | ;; BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 28 | ;; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 29 | ;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 30 | ;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 31 | ;; ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 32 | ;; POSSIBILITY OF SUCH DAMAGE. 33 | 34 | ;;; Code: 35 | 36 | (in-package :common-lisp-user) 37 | 38 | (defpackage :rs-colors 39 | (:use :common-lisp 40 | :iterate 41 | :rs-colors-internal) 42 | (:import-from :alexandria 43 | #:clamp) 44 | (:import-from :read-number 45 | #:read-integer 46 | #:read-float) 47 | (:export ;; types 48 | #:color-object 49 | #:colorp 50 | #:color-coordinates 51 | #:white-point 52 | #:copy-color 53 | #:coerce-color 54 | #:rgb-color-object 55 | #:hsv-color-object 56 | #:hsl-color-object 57 | #:cmy-color-object 58 | #:cmyk-color-object 59 | #:generic-color-object 60 | #:normalize-color 61 | #:absolute-color 62 | ;; generic-rgb 63 | #:generic-rgb-color 64 | #:make-generic-rgb-color 65 | #:make-generic-rgb-color-from-number 66 | #:generic-hsv-color 67 | #:make-generic-hsv-color 68 | #:generic-hsl-color 69 | #:make-generic-hsl-color 70 | #:generic-rgb-color-coordinates 71 | #:generic-hsv-color-coordinates 72 | #:generic-hsl-color-coordinates 73 | ;; generic-cmy 74 | #:generic-cmy-color 75 | #:make-generic-cmy-color 76 | #:make-generic-cmy-color-from-number 77 | #:generic-cmy-color-coordinates 78 | ;; generic-cmyk 79 | #:generic-cmyk-color 80 | #:make-generic-cmyk-color 81 | #:make-generic-cmyk-color-from-number 82 | #:generic-cmyk-color-coordinates 83 | ;; ciergb 84 | #:ciergb-color 85 | #:make-ciergb-color 86 | #:ciergb-color-coordinates 87 | ;; ciexyz 88 | #:ciexyz-color 89 | #:make-ciexyz-color 90 | #:ciexyz-color-coordinates 91 | ;; ciexyy 92 | #:ciexyy-color 93 | #:make-ciexyy-color 94 | #:ciexyy-color-coordinates 95 | ;; cieluv 96 | #:*cieluv-default-white-point* 97 | #:cieluv-color 98 | #:make-cieluv-color 99 | #:cieluv-color-coordinates 100 | ;; cielab 101 | #:*cielab-default-white-point* 102 | #:cielab-color 103 | #:make-cielab-color 104 | #:cielab-color-coordinates 105 | ;; cielch 106 | #:*cielch-default-white-point* 107 | #:cielch-color 108 | #:make-cielch-color 109 | #:cielch-color-coordinates 110 | ;; srgb 111 | #:srgb-color 112 | #:make-srgb-color 113 | #:make-srgb-color-from-number 114 | #:srgb-white-point 115 | #:srgb-color-coordinates 116 | ;; adobe-rgb 117 | #:adobe-rgb-color 118 | #:make-adobe-rgb-color 119 | #:make-adobe-rgb-color-from-number 120 | #:adobe-rgb-white-point 121 | #:adobe-rgb-color-coordinates 122 | ;; wide-gamut-rgb 123 | #:wide-gamut-rgb-color 124 | #:make-wide-gamut-rgb-color 125 | #:make-wide-gamut-rgb-color-from-number 126 | #:wide-gamut-rgb-white-point 127 | #:wide-gamut-rgb-color-coordinates 128 | ;; cie-white-points 129 | #:cie-1931-white-point-a 130 | #:cie-1931-white-point-b 131 | #:cie-1931-white-point-c 132 | #:cie-1931-white-point-d50 133 | #:cie-1931-white-point-d55 134 | #:cie-1931-white-point-d65 135 | #:cie-1931-white-point-d75 136 | #:cie-1931-white-point-e 137 | #:cie-1931-white-point-f1 138 | #:cie-1931-white-point-f2 139 | #:cie-1931-white-point-f3 140 | #:cie-1931-white-point-f4 141 | #:cie-1931-white-point-f5 142 | #:cie-1931-white-point-f6 143 | #:cie-1931-white-point-f7 144 | #:cie-1931-white-point-f8 145 | #:cie-1931-white-point-f9 146 | #:cie-1931-white-point-f10 147 | #:cie-1931-white-point-f11 148 | #:cie-1931-white-point-f12 149 | #:cie-1964-white-point-a 150 | #:cie-1964-white-point-b 151 | #:cie-1964-white-point-c 152 | #:cie-1964-white-point-d50 153 | #:cie-1964-white-point-d55 154 | #:cie-1964-white-point-d65 155 | #:cie-1964-white-point-d75 156 | #:cie-1964-white-point-e 157 | #:cie-1964-white-point-f1 158 | #:cie-1964-white-point-f2 159 | #:cie-1964-white-point-f3 160 | #:cie-1964-white-point-f4 161 | #:cie-1964-white-point-f5 162 | #:cie-1964-white-point-f6 163 | #:cie-1964-white-point-f7 164 | #:cie-1964-white-point-f8 165 | #:cie-1964-white-point-f9 166 | #:cie-1964-white-point-f10 167 | #:cie-1964-white-point-f11 168 | #:cie-1964-white-point-f12 169 | ;; io 170 | #:define-color-printer 171 | #:define-color-reader 172 | #:print-color-xcms-ciergb 173 | #:color-formatter-xcms-ciergb 174 | #:read-color-xcms-ciergb 175 | #:print-color-xcms-ciexyz 176 | #:color-formatter-xcms-ciexyz 177 | #:read-color-xcms-ciexyz 178 | #:print-color-xcms-ciexyy 179 | #:color-formatter-xcms-ciexyy 180 | #:read-color-xcms-ciexyy 181 | #:print-color-xcms-cieluv 182 | #:color-formatter-xcms-cieluv 183 | #:read-color-xcms-cieluv 184 | #:print-color-xcms-cielab 185 | #:color-formatter-xcms-cielab 186 | #:read-color-xcms-cielab 187 | #:print-color-xcms-cielch 188 | #:color-formatter-xcms-cielch 189 | #:read-color-xcms-cielch 190 | #:print-color-xcms-rgbi 191 | #:color-formatter-xcms-rgbi 192 | #:read-color-xcms-rgbi 193 | #:print-color-xcms-rgb 194 | #:color-formatter-xcms-rgb 195 | #:read-color-xcms-rgb 196 | #:read-color-xcms 197 | #:print-color-html 198 | #:color-formatter-html 199 | #:read-color-html 200 | #:print-color-css3-rgb 201 | #:color-formatter-css3-rgb 202 | #:read-color-css3-rgb 203 | #:print-color-css3-hsl 204 | #:color-formatter-css3-hsl 205 | #:read-color-css3-hsl 206 | #:read-color-css3 207 | ;; color-matching-functions 208 | #:cie-1931-standard-observer 209 | #:cie-1964-standard-observer 210 | #:*color-matching-functions* 211 | #:color-matching-functions 212 | #:cie-1931-second-radiation-constant 213 | #:*second-radiation-constant* 214 | #:cie-xy-chromaticity-of-light 215 | #:cie-xy-chromaticity-of-black-body 216 | ;; black-body 217 | #:codata-2018-first-radiation-constant-for-spectral-radiance 218 | #:codata-2018-first-radiation-constant 219 | #:codata-2018-second-radiation-constant 220 | #:black-body-spectral-radiant-exitance 221 | #:black-body-spectral-radiance 222 | ;; color-difference 223 | #:cie76 224 | #:cie94) 225 | (:documentation "A color data type for Common Lisp.")) 226 | 227 | ;;; rs-colors.lisp ends here 228 | -------------------------------------------------------------------------------- /cie-white-points.lisp: -------------------------------------------------------------------------------- 1 | ;;; cie-white-points.lisp --- white points of CIE standard illuminants. 2 | 3 | ;; Copyright (C) 2014 Ralph Schleicher 4 | 5 | ;; Redistribution and use in source and binary forms, with or without 6 | ;; modification, are permitted provided that the following conditions 7 | ;; are met: 8 | ;; 9 | ;; * Redistributions of source code must retain the above copyright 10 | ;; notice, this list of conditions and the following disclaimer. 11 | ;; 12 | ;; * Redistributions in binary form must reproduce the above copyright 13 | ;; notice, this list of conditions and the following disclaimer in 14 | ;; the documentation and/or other materials provided with the 15 | ;; distribution. 16 | ;; 17 | ;; * Neither the name of the copyright holder nor the names of its 18 | ;; contributors may be used to endorse or promote products derived 19 | ;; from this software without specific prior written permission. 20 | ;; 21 | ;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | ;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | ;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 24 | ;; FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 25 | ;; COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 26 | ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 27 | ;; BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 28 | ;; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 29 | ;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 30 | ;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 31 | ;; ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 32 | ;; POSSIBILITY OF SUCH DAMAGE. 33 | 34 | ;;; Code: 35 | 36 | (in-package :rs-colors) 37 | 38 | ;; See . 39 | (macrolet ((define-white-point (name (x y) &optional doc) 40 | `(define-color-name ,name (make-ciexyy-color ,x ,y 1) 41 | ,@(when doc (list doc))))) 42 | (define-white-point cie-1931-white-point-a (0.44757 0.40745) "White point of CIE standard illuminant A given for the CIE 1931 standard observer.") 43 | (define-white-point cie-1931-white-point-b (0.34842 0.35161) "White point of CIE standard illuminant B given for the CIE 1931 standard observer.") 44 | (define-white-point cie-1931-white-point-c (0.31006 0.31616) "White point of CIE standard illuminant C given for the CIE 1931 standard observer.") 45 | (define-white-point cie-1931-white-point-d50 (0.34567 0.35850) "White point of CIE standard illuminant D50 given for the CIE 1931 standard observer.") 46 | (define-white-point cie-1931-white-point-d55 (0.33242 0.34743) "White point of CIE standard illuminant D55 given for the CIE 1931 standard observer.") 47 | (define-white-point cie-1931-white-point-d65 (0.31271 0.32902) "White point of CIE standard illuminant D65 given for the CIE 1931 standard observer.") 48 | (define-white-point cie-1931-white-point-d75 (0.29902 0.31485) "White point of CIE standard illuminant D75 given for the CIE 1931 standard observer.") 49 | (define-white-point cie-1931-white-point-e (1/3 1/3 ) "White point of CIE standard illuminant E given for the CIE 1931 standard observer.") 50 | (define-white-point cie-1931-white-point-f1 (0.31310 0.33727) "White point of CIE standard illuminant F1 given for the CIE 1931 standard observer.") 51 | (define-white-point cie-1931-white-point-f2 (0.37208 0.37529) "White point of CIE standard illuminant F2 given for the CIE 1931 standard observer.") 52 | (define-white-point cie-1931-white-point-f3 (0.40910 0.39430) "White point of CIE standard illuminant F3 given for the CIE 1931 standard observer.") 53 | (define-white-point cie-1931-white-point-f4 (0.44018 0.40329) "White point of CIE standard illuminant F4 given for the CIE 1931 standard observer.") 54 | (define-white-point cie-1931-white-point-f5 (0.31379 0.34531) "White point of CIE standard illuminant F5 given for the CIE 1931 standard observer.") 55 | (define-white-point cie-1931-white-point-f6 (0.37790 0.38835) "White point of CIE standard illuminant F6 given for the CIE 1931 standard observer.") 56 | (define-white-point cie-1931-white-point-f7 (0.31292 0.32933) "White point of CIE standard illuminant F7 given for the CIE 1931 standard observer.") 57 | (define-white-point cie-1931-white-point-f8 (0.34588 0.35875) "White point of CIE standard illuminant F8 given for the CIE 1931 standard observer.") 58 | (define-white-point cie-1931-white-point-f9 (0.37417 0.37281) "White point of CIE standard illuminant F9 given for the CIE 1931 standard observer.") 59 | (define-white-point cie-1931-white-point-f10 (0.34609 0.35986) "White point of CIE standard illuminant F10 given for the CIE 1931 standard observer.") 60 | (define-white-point cie-1931-white-point-f11 (0.38052 0.37713) "White point of CIE standard illuminant F11 given for the CIE 1931 standard observer.") 61 | (define-white-point cie-1931-white-point-f12 (0.43695 0.40441) "White point of CIE standard illuminant F12 given for the CIE 1931 standard observer.") 62 | (define-white-point cie-1964-white-point-a (0.45117 0.40594) "White point of CIE standard illuminant A given for the CIE 1964 standard observer.") 63 | (define-white-point cie-1964-white-point-b (0.34980 0.35270) "White point of CIE standard illuminant B given for the CIE 1964 standard observer.") 64 | (define-white-point cie-1964-white-point-c (0.31039 0.31905) "White point of CIE standard illuminant C given for the CIE 1964 standard observer.") 65 | (define-white-point cie-1964-white-point-d50 (0.34773 0.35952) "White point of CIE standard illuminant D50 given for the CIE 1964 standard observer.") 66 | (define-white-point cie-1964-white-point-d55 (0.33411 0.34877) "White point of CIE standard illuminant D55 given for the CIE 1964 standard observer.") 67 | (define-white-point cie-1964-white-point-d65 (0.31382 0.33100) "White point of CIE standard illuminant D65 given for the CIE 1964 standard observer.") 68 | (define-white-point cie-1964-white-point-d75 (0.29968 0.31740) "White point of CIE standard illuminant D75 given for the CIE 1964 standard observer.") 69 | (define-white-point cie-1964-white-point-e (1/3 1/3 ) "White point of CIE standard illuminant E given for the CIE 1964 standard observer.") 70 | (define-white-point cie-1964-white-point-f1 (0.31811 0.33559) "White point of CIE standard illuminant F1 given for the CIE 1964 standard observer.") 71 | (define-white-point cie-1964-white-point-f2 (0.37925 0.36733) "White point of CIE standard illuminant F2 given for the CIE 1964 standard observer.") 72 | (define-white-point cie-1964-white-point-f3 (0.41761 0.38324) "White point of CIE standard illuminant F3 given for the CIE 1964 standard observer.") 73 | (define-white-point cie-1964-white-point-f4 (0.44920 0.39074) "White point of CIE standard illuminant F4 given for the CIE 1964 standard observer.") 74 | (define-white-point cie-1964-white-point-f5 (0.31975 0.34246) "White point of CIE standard illuminant F5 given for the CIE 1964 standard observer.") 75 | (define-white-point cie-1964-white-point-f6 (0.38660 0.37847) "White point of CIE standard illuminant F6 given for the CIE 1964 standard observer.") 76 | (define-white-point cie-1964-white-point-f7 (0.31569 0.32960) "White point of CIE standard illuminant F7 given for the CIE 1964 standard observer.") 77 | (define-white-point cie-1964-white-point-f8 (0.34902 0.35939) "White point of CIE standard illuminant F8 given for the CIE 1964 standard observer.") 78 | (define-white-point cie-1964-white-point-f9 (0.37829 0.37045) "White point of CIE standard illuminant F9 given for the CIE 1964 standard observer.") 79 | (define-white-point cie-1964-white-point-f10 (0.35090 0.35444) "White point of CIE standard illuminant F10 given for the CIE 1964 standard observer.") 80 | (define-white-point cie-1964-white-point-f11 (0.38541 0.37123) "White point of CIE standard illuminant F11 given for the CIE 1964 standard observer.") 81 | (define-white-point cie-1964-white-point-f12 (0.44256 0.39717) "White point of CIE standard illuminant F12 given for the CIE 1964 standard observer.") 82 | (values)) 83 | 84 | ;;; cie-white-points.lisp ends here 85 | -------------------------------------------------------------------------------- /types.lisp: -------------------------------------------------------------------------------- 1 | ;;; types.lisp --- basic data types. 2 | 3 | ;; Copyright (C) 2014 Ralph Schleicher 4 | 5 | ;; Redistribution and use in source and binary forms, with or without 6 | ;; modification, are permitted provided that the following conditions 7 | ;; are met: 8 | ;; 9 | ;; * Redistributions of source code must retain the above copyright 10 | ;; notice, this list of conditions and the following disclaimer. 11 | ;; 12 | ;; * Redistributions in binary form must reproduce the above copyright 13 | ;; notice, this list of conditions and the following disclaimer in 14 | ;; the documentation and/or other materials provided with the 15 | ;; distribution. 16 | ;; 17 | ;; * Neither the name of the copyright holder nor the names of its 18 | ;; contributors may be used to endorse or promote products derived 19 | ;; from this software without specific prior written permission. 20 | ;; 21 | ;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | ;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | ;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 24 | ;; FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 25 | ;; COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 26 | ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 27 | ;; BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 28 | ;; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 29 | ;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 30 | ;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 31 | ;; ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 32 | ;; POSSIBILITY OF SUCH DAMAGE. 33 | 34 | ;;; Code: 35 | 36 | (in-package :rs-colors) 37 | 38 | (defclass color-object () 39 | () 40 | (:documentation "Base class for a color.")) 41 | 42 | (defmethod initialize-instance :after ((color color-object) &key) 43 | (iter (with class = (class-of color)) 44 | (for slot :in (closer-mop:class-slots class)) 45 | (for slot-name = (closer-mop:slot-definition-name slot)) 46 | (when (slot-boundp color slot-name) 47 | (for slot-value = (slot-value color slot-name)) 48 | ;; Check that the contents of the slot is of the specified 49 | ;; data type. 50 | (for slot-type = (closer-mop:slot-definition-type slot)) 51 | (unless (typep slot-value slot-type) 52 | (error 'type-error :datum slot-value :expected-type slot-type))))) 53 | 54 | (defun colorp (object) 55 | "Return true if OBJECT is a color object." 56 | (typep object 'color-object)) 57 | 58 | (defgeneric color-coordinates (color) 59 | (:documentation "Return the color space coordinates of the color. 60 | 61 | Argument COLOR is a color object.") 62 | (:method ((color color-object)) 63 | (declare (ignore color)) 64 | (values))) 65 | 66 | (defgeneric white-point (color) 67 | (:documentation "Return the white point of the color. 68 | 69 | Argument COLOR is a color object. 70 | 71 | Value is the color object of the color's white point, or nil if the 72 | white point is not defined or if multiple white points exist.") 73 | (:method ((color color-object)) 74 | (declare (ignore color)))) 75 | 76 | (defgeneric copy-color (color) 77 | (:documentation "Return a shallow copy of the color. 78 | 79 | Argument COLOR is a color object.") 80 | (:method ((color color-object)) 81 | (iter (with class = (class-of color)) 82 | (with copy = (allocate-instance class)) 83 | (for slot :in (closer-mop:class-slots class)) 84 | (for slot-name = (closer-mop:slot-definition-name slot)) 85 | (when (slot-boundp color slot-name) 86 | (setf (slot-value copy slot-name) (slot-value color slot-name))) 87 | (finally 88 | (return copy))))) 89 | 90 | (defun coerce-color (color color-type) 91 | "Coerce the color object into the specified color type. 92 | 93 | First argument COLOR is a color object. 94 | Second argument COLOR-TYPE is a color data type. 95 | 96 | If argument COLOR is already a color of the requested color data 97 | type, return COLOR as is (no conversion). Otherwise, return a new 98 | color with the color coordinates of COLOR converted into the color 99 | space denoted by COLOR-TYPE." 100 | (if (eq (type-of color) color-type) 101 | color 102 | (change-class (copy-color color) color-type))) 103 | 104 | (defmethod print-object ((color color-object) stream) 105 | (print-unreadable-object (color stream :type t :identity t) 106 | (princ (multiple-value-list (color-coordinates color)) stream))) 107 | 108 | ;; Steve Losh wrote: 109 | ;; 110 | ;; Some implementations (e.g. CCL) are particularly aggressive about 111 | ;; inlining constants, and will fail during compilation without a way 112 | ;; to dump them into FASLs: 113 | ;; 114 | ;; [ClozureCL] COMMON-LISP-USER> (ql:quickload 'rs-colors) 115 | ;; ... 116 | ;; > Error: No MAKE-LOAD-FORM method is defined for # 117 | (defmethod make-load-form ((color color-object) &optional environment) 118 | (make-load-form-saving-slots color :environment environment)) 119 | 120 | (defclass rgb-color-object (color-object) 121 | ((r 122 | :initarg :red 123 | :initform 0 124 | :type (real 0 1) 125 | :documentation "Intensity of the red primary, default zero.") 126 | (g 127 | :initarg :green 128 | :initform 0 129 | :type (real 0 1) 130 | :documentation "Intensity of the green primary, default zero.") 131 | (b 132 | :initarg :blue 133 | :initform 0 134 | :type (real 0 1) 135 | :documentation "Intensity of the blue primary, default zero.")) 136 | (:documentation "Color class for a RGB color space.")) 137 | 138 | (defmethod color-coordinates ((color rgb-color-object)) 139 | (with-slots (r g b) color 140 | (values r g b))) 141 | 142 | (defclass hsv-color-object (color-object) 143 | ((h 144 | :initarg :hue 145 | :initform 0 146 | :type (real 0 (360)) 147 | :documentation "Hue, default zero.") 148 | (s 149 | :initarg :saturation 150 | :initform 0 151 | :type (real 0 1) 152 | :documentation "Saturation, default zero.") 153 | (v 154 | :initarg :value 155 | :initform 0 156 | :type (real 0 1) 157 | :documentation "Value (brightness), default zero.")) 158 | (:documentation "Color class for a HSV/HSB color space.")) 159 | 160 | (defmethod color-coordinates ((color hsv-color-object)) 161 | (with-slots (h s v) color 162 | (values h s v))) 163 | 164 | (defclass hsl-color-object (color-object) 165 | ((h 166 | :initarg :hue 167 | :initform 0 168 | :type (real 0 (360)) 169 | :documentation "Hue, default zero.") 170 | (s 171 | :initarg :saturation 172 | :initform 0 173 | :type (real 0 1) 174 | :documentation "Saturation, default zero.") 175 | (l 176 | :initarg :lightness 177 | :initform 0 178 | :type (real 0 1) 179 | :documentation "Lightness, default zero.")) 180 | (:documentation "Color class for a HSL color space.")) 181 | 182 | (defmethod color-coordinates ((color hsl-color-object)) 183 | (with-slots (h s l) color 184 | (values h s l))) 185 | 186 | (defclass cmy-color-object (color-object) 187 | ((c 188 | :initarg :cyan 189 | :initform 0 190 | :type (real 0 1) 191 | :documentation "Intensity of the cyan ink, default zero.") 192 | (m 193 | :initarg :magenta 194 | :initform 0 195 | :type (real 0 1) 196 | :documentation "Intensity of the magenta ink, default zero.") 197 | (y 198 | :initarg :yellow 199 | :initform 0 200 | :type (real 0 1) 201 | :documentation "Intensity of the yellow ink, default zero.")) 202 | (:documentation "Color class for a CMY color space.")) 203 | 204 | (defmethod color-coordinates ((color cmy-color-object)) 205 | (with-slots (c m y) color 206 | (values c m y))) 207 | 208 | ;; Do not inherit from ‘cmy-color-object’ because the numerical values 209 | ;; of cyan, magenta, and yellow have a different meaning. 210 | (defclass cmyk-color-object (color-object) 211 | ((c 212 | :initarg :cyan 213 | :initform 0 214 | :type (real 0 1) 215 | :documentation "Intensity of the cyan ink, default zero.") 216 | (m 217 | :initarg :magenta 218 | :initform 0 219 | :type (real 0 1) 220 | :documentation "Intensity of the magenta ink, default zero.") 221 | (y 222 | :initarg :yellow 223 | :initform 0 224 | :type (real 0 1) 225 | :documentation "Intensity of the yellow ink, default zero.") 226 | (k 227 | :initarg :black 228 | :initform 0 229 | :type (real 0 1) 230 | :documentation "Intensity of the black ink, default zero.")) 231 | (:documentation "Color class for a CMYK color space.")) 232 | 233 | (defmethod color-coordinates ((color cmyk-color-object)) 234 | (with-slots (c m y k) color 235 | (values c m y k))) 236 | 237 | (defclass generic-color-object (color-object) 238 | () 239 | (:documentation "Color class for the mathematical model of a color space.")) 240 | 241 | (defgeneric absolute-luminance (object) 242 | (:documentation "Return absolute luminance.") 243 | (:method ((object real)) 244 | (ensure-type object '(real 0)))) 245 | 246 | (defgeneric normalize-color (color &key) 247 | (:documentation "Convert from absolute color coordinates to normalized color coordinates.")) 248 | 249 | (defgeneric absolute-color (color &key) 250 | (:documentation "Convert from normalized color coordinates to absolute color coordinates.")) 251 | 252 | ;;; types.lisp ends here 253 | --------------------------------------------------------------------------------