diff --git a/colors.lisp b/colors.lisp index 912c7ae..96aeef3 100644 --- a/colors.lisp +++ b/colors.lisp @@ -152,10 +152,8 @@ combination is in the positive or negative direction on the color wheel." ;;; macros used by the autogenerated files (defmacro define-rgb-color (name red green blue) - "Macro for defining and automatically exporting color constants. Used by -the automatically generated color file." + "Macro for defining color constants. Used by the automatically generated color file." (let ((constant-name (symbolicate #\+ name #\+))) `(progn - (defparameter ,constant-name (rgb ,red ,green ,blue) - ,(format nil "X11 color ~A." name)) - (export ',constant-name)))) + (define-constant ,constant-name (rgb ,red ,green ,blue) + :test #'equalp :documentation ,(format nil "X11 color ~A." name))))) diff --git a/package-template.lisp b/package-template.lisp new file mode 100644 index 0000000..7306fde --- /dev/null +++ b/package-template.lisp @@ -0,0 +1,17 @@ +;;; -*- Mode:Lisp; Syntax:ANSI-Common-Lisp; -*- + +(in-package #:common-lisp-user) + +(defpackage #:cl-colors + (:use #:alexandria + #:common-lisp + #:let-plus) + (:export + #:rgb #:rgb-red #:rgb-green #:rgb-blue #:gray #:&rgb + #:hsv #:hsv-hue #:hsv-saturation #:hsv-value #:&hsv + #:rgb-to-hsv #:hsv-to-rgb #:hex-to-rgb #:as-hsv #:as-rgb + #:rgb-combination #:hsv-combination + #:parse-hex-rgb #:print-hex-rgb + + ;; predefined color names +~A)) diff --git a/package.lisp b/package.lisp index b559140..a8f5b5e 100644 --- a/package.lisp +++ b/package.lisp @@ -2,18 +2,673 @@ (in-package #:common-lisp-user) -(eval-when (:compile-toplevel :load-toplevel :execute) - ;; this is needed because the color names in the autogenerated file are - ;; exported manually and some implementations (eg SBCL) complain about the - ;; inconsistency with DEFPACKAGE. - (when (find-package '#:cl-colors) - (do-symbols (symbol '#:cl-colors) - (unexport symbol '#:cl-colors)))) - (defpackage #:cl-colors - (:use #:alexandria #:common-lisp #:let-plus) - (:export #:rgb #:rgb-red #:rgb-green #:rgb-blue #:gray #:&rgb - #:hsv #:hsv-hue #:hsv-saturation #:hsv-value #:&hsv - #:rgb-to-hsv #:hsv-to-rgb #:hex-to-rgb #:as-hsv #:as-rgb - #:rgb-combination #:hsv-combination - #:parse-hex-rgb #:print-hex-rgb)) + (:use #:alexandria + #:common-lisp + #:let-plus) + (:export + #:rgb #:rgb-red #:rgb-green #:rgb-blue #:gray #:&rgb + #:hsv #:hsv-hue #:hsv-saturation #:hsv-value #:&hsv + #:rgb-to-hsv #:hsv-to-rgb #:hex-to-rgb #:as-hsv #:as-rgb + #:rgb-combination #:hsv-combination + #:parse-hex-rgb #:print-hex-rgb + + ;; predefined color names + #:snow + #:ghostwhite + #:whitesmoke + #:gainsboro + #:floralwhite + #:oldlace + #:linen + #:antiquewhite + #:papayawhip + #:blanchedalmond + #:bisque + #:peachpuff + #:navajowhite + #:moccasin + #:cornsilk + #:ivory + #:lemonchiffon + #:seashell + #:honeydew + #:mintcream + #:azure + #:aliceblue + #:lavender + #:lavenderblush + #:mistyrose + #:white + #:black + #:darkslategray + #:darkslategrey + #:dimgray + #:dimgrey + #:slategray + #:slategrey + #:lightslategray + #:lightslategrey + #:gray + #:grey + #:lightgrey + #:lightgray + #:midnightblue + #:navy + #:navyblue + #:cornflowerblue + #:darkslateblue + #:slateblue + #:mediumslateblue + #:lightslateblue + #:mediumblue + #:royalblue + #:blue + #:dodgerblue + #:deepskyblue + #:skyblue + #:lightskyblue + #:steelblue + #:lightsteelblue + #:lightblue + #:powderblue + #:paleturquoise + #:darkturquoise + #:mediumturquoise + #:turquoise + #:cyan + #:lightcyan + #:cadetblue + #:mediumaquamarine + #:aquamarine + #:darkgreen + #:darkolivegreen + #:darkseagreen + #:seagreen + #:mediumseagreen + #:lightseagreen + #:palegreen + #:springgreen + #:lawngreen + #:green + #:chartreuse + #:mediumspringgreen + #:greenyellow + #:limegreen + #:yellowgreen + #:forestgreen + #:olivedrab + #:darkkhaki + #:khaki + #:palegoldenrod + #:lightgoldenrodyellow + #:lightyellow + #:yellow + #:gold + #:lightgoldenrod + #:goldenrod + #:darkgoldenrod + #:rosybrown + #:indianred + #:saddlebrown + #:sienna + #:peru + #:burlywood + #:beige + #:wheat + #:sandybrown + #:tan + #:chocolate + #:firebrick + #:brown + #:darksalmon + #:salmon + #:lightsalmon + #:orange + #:darkorange + #:coral + #:lightcoral + #:tomato + #:orangered + #:red + #:hotpink + #:deeppink + #:pink + #:lightpink + #:palevioletred + #:maroon + #:mediumvioletred + #:violetred + #:magenta + #:violet + #:plum + #:orchid + #:mediumorchid + #:darkorchid + #:darkviolet + #:blueviolet + #:purple + #:mediumpurple + #:thistle + #:snow1 + #:snow2 + #:snow3 + #:snow4 + #:seashell1 + #:seashell2 + #:seashell3 + #:seashell4 + #:antiquewhite1 + #:antiquewhite2 + #:antiquewhite3 + #:antiquewhite4 + #:bisque1 + #:bisque2 + #:bisque3 + #:bisque4 + #:peachpuff1 + #:peachpuff2 + #:peachpuff3 + #:peachpuff4 + #:navajowhite1 + #:navajowhite2 + #:navajowhite3 + #:navajowhite4 + #:lemonchiffon1 + #:lemonchiffon2 + #:lemonchiffon3 + #:lemonchiffon4 + #:cornsilk1 + #:cornsilk2 + #:cornsilk3 + #:cornsilk4 + #:ivory1 + #:ivory2 + #:ivory3 + #:ivory4 + #:honeydew1 + #:honeydew2 + #:honeydew3 + #:honeydew4 + #:lavenderblush1 + #:lavenderblush2 + #:lavenderblush3 + #:lavenderblush4 + #:mistyrose1 + #:mistyrose2 + #:mistyrose3 + #:mistyrose4 + #:azure1 + #:azure2 + #:azure3 + #:azure4 + #:slateblue1 + #:slateblue2 + #:slateblue3 + #:slateblue4 + #:royalblue1 + #:royalblue2 + #:royalblue3 + #:royalblue4 + #:blue1 + #:blue2 + #:blue3 + #:blue4 + #:dodgerblue1 + #:dodgerblue2 + #:dodgerblue3 + #:dodgerblue4 + #:steelblue1 + #:steelblue2 + #:steelblue3 + #:steelblue4 + #:deepskyblue1 + #:deepskyblue2 + #:deepskyblue3 + #:deepskyblue4 + #:skyblue1 + #:skyblue2 + #:skyblue3 + #:skyblue4 + #:lightskyblue1 + #:lightskyblue2 + #:lightskyblue3 + #:lightskyblue4 + #:slategray1 + #:slategray2 + #:slategray3 + #:slategray4 + #:lightsteelblue1 + #:lightsteelblue2 + #:lightsteelblue3 + #:lightsteelblue4 + #:lightblue1 + #:lightblue2 + #:lightblue3 + #:lightblue4 + #:lightcyan1 + #:lightcyan2 + #:lightcyan3 + #:lightcyan4 + #:paleturquoise1 + #:paleturquoise2 + #:paleturquoise3 + #:paleturquoise4 + #:cadetblue1 + #:cadetblue2 + #:cadetblue3 + #:cadetblue4 + #:turquoise1 + #:turquoise2 + #:turquoise3 + #:turquoise4 + #:cyan1 + #:cyan2 + #:cyan3 + #:cyan4 + #:darkslategray1 + #:darkslategray2 + #:darkslategray3 + #:darkslategray4 + #:aquamarine1 + #:aquamarine2 + #:aquamarine3 + #:aquamarine4 + #:darkseagreen1 + #:darkseagreen2 + #:darkseagreen3 + #:darkseagreen4 + #:seagreen1 + #:seagreen2 + #:seagreen3 + #:seagreen4 + #:palegreen1 + #:palegreen2 + #:palegreen3 + #:palegreen4 + #:springgreen1 + #:springgreen2 + #:springgreen3 + #:springgreen4 + #:green1 + #:green2 + #:green3 + #:green4 + #:chartreuse1 + #:chartreuse2 + #:chartreuse3 + #:chartreuse4 + #:olivedrab1 + #:olivedrab2 + #:olivedrab3 + #:olivedrab4 + #:darkolivegreen1 + #:darkolivegreen2 + #:darkolivegreen3 + #:darkolivegreen4 + #:khaki1 + #:khaki2 + #:khaki3 + #:khaki4 + #:lightgoldenrod1 + #:lightgoldenrod2 + #:lightgoldenrod3 + #:lightgoldenrod4 + #:lightyellow1 + #:lightyellow2 + #:lightyellow3 + #:lightyellow4 + #:yellow1 + #:yellow2 + #:yellow3 + #:yellow4 + #:gold1 + #:gold2 + #:gold3 + #:gold4 + #:goldenrod1 + #:goldenrod2 + #:goldenrod3 + #:goldenrod4 + #:darkgoldenrod1 + #:darkgoldenrod2 + #:darkgoldenrod3 + #:darkgoldenrod4 + #:rosybrown1 + #:rosybrown2 + #:rosybrown3 + #:rosybrown4 + #:indianred1 + #:indianred2 + #:indianred3 + #:indianred4 + #:sienna1 + #:sienna2 + #:sienna3 + #:sienna4 + #:burlywood1 + #:burlywood2 + #:burlywood3 + #:burlywood4 + #:wheat1 + #:wheat2 + #:wheat3 + #:wheat4 + #:tan1 + #:tan2 + #:tan3 + #:tan4 + #:chocolate1 + #:chocolate2 + #:chocolate3 + #:chocolate4 + #:firebrick1 + #:firebrick2 + #:firebrick3 + #:firebrick4 + #:brown1 + #:brown2 + #:brown3 + #:brown4 + #:salmon1 + #:salmon2 + #:salmon3 + #:salmon4 + #:lightsalmon1 + #:lightsalmon2 + #:lightsalmon3 + #:lightsalmon4 + #:orange1 + #:orange2 + #:orange3 + #:orange4 + #:darkorange1 + #:darkorange2 + #:darkorange3 + #:darkorange4 + #:coral1 + #:coral2 + #:coral3 + #:coral4 + #:tomato1 + #:tomato2 + #:tomato3 + #:tomato4 + #:orangered1 + #:orangered2 + #:orangered3 + #:orangered4 + #:red1 + #:red2 + #:red3 + #:red4 + #:debianred + #:deeppink1 + #:deeppink2 + #:deeppink3 + #:deeppink4 + #:hotpink1 + #:hotpink2 + #:hotpink3 + #:hotpink4 + #:pink1 + #:pink2 + #:pink3 + #:pink4 + #:lightpink1 + #:lightpink2 + #:lightpink3 + #:lightpink4 + #:palevioletred1 + #:palevioletred2 + #:palevioletred3 + #:palevioletred4 + #:maroon1 + #:maroon2 + #:maroon3 + #:maroon4 + #:violetred1 + #:violetred2 + #:violetred3 + #:violetred4 + #:magenta1 + #:magenta2 + #:magenta3 + #:magenta4 + #:orchid1 + #:orchid2 + #:orchid3 + #:orchid4 + #:plum1 + #:plum2 + #:plum3 + #:plum4 + #:mediumorchid1 + #:mediumorchid2 + #:mediumorchid3 + #:mediumorchid4 + #:darkorchid1 + #:darkorchid2 + #:darkorchid3 + #:darkorchid4 + #:purple1 + #:purple2 + #:purple3 + #:purple4 + #:mediumpurple1 + #:mediumpurple2 + #:mediumpurple3 + #:mediumpurple4 + #:thistle1 + #:thistle2 + #:thistle3 + #:thistle4 + #:gray0 + #:grey0 + #:gray1 + #:grey1 + #:gray2 + #:grey2 + #:gray3 + #:grey3 + #:gray4 + #:grey4 + #:gray5 + #:grey5 + #:gray6 + #:grey6 + #:gray7 + #:grey7 + #:gray8 + #:grey8 + #:gray9 + #:grey9 + #:gray10 + #:grey10 + #:gray11 + #:grey11 + #:gray12 + #:grey12 + #:gray13 + #:grey13 + #:gray14 + #:grey14 + #:gray15 + #:grey15 + #:gray16 + #:grey16 + #:gray17 + #:grey17 + #:gray18 + #:grey18 + #:gray19 + #:grey19 + #:gray20 + #:grey20 + #:gray21 + #:grey21 + #:gray22 + #:grey22 + #:gray23 + #:grey23 + #:gray24 + #:grey24 + #:gray25 + #:grey25 + #:gray26 + #:grey26 + #:gray27 + #:grey27 + #:gray28 + #:grey28 + #:gray29 + #:grey29 + #:gray30 + #:grey30 + #:gray31 + #:grey31 + #:gray32 + #:grey32 + #:gray33 + #:grey33 + #:gray34 + #:grey34 + #:gray35 + #:grey35 + #:gray36 + #:grey36 + #:gray37 + #:grey37 + #:gray38 + #:grey38 + #:gray39 + #:grey39 + #:gray40 + #:grey40 + #:gray41 + #:grey41 + #:gray42 + #:grey42 + #:gray43 + #:grey43 + #:gray44 + #:grey44 + #:gray45 + #:grey45 + #:gray46 + #:grey46 + #:gray47 + #:grey47 + #:gray48 + #:grey48 + #:gray49 + #:grey49 + #:gray50 + #:grey50 + #:gray51 + #:grey51 + #:gray52 + #:grey52 + #:gray53 + #:grey53 + #:gray54 + #:grey54 + #:gray55 + #:grey55 + #:gray56 + #:grey56 + #:gray57 + #:grey57 + #:gray58 + #:grey58 + #:gray59 + #:grey59 + #:gray60 + #:grey60 + #:gray61 + #:grey61 + #:gray62 + #:grey62 + #:gray63 + #:grey63 + #:gray64 + #:grey64 + #:gray65 + #:grey65 + #:gray66 + #:grey66 + #:gray67 + #:grey67 + #:gray68 + #:grey68 + #:gray69 + #:grey69 + #:gray70 + #:grey70 + #:gray71 + #:grey71 + #:gray72 + #:grey72 + #:gray73 + #:grey73 + #:gray74 + #:grey74 + #:gray75 + #:grey75 + #:gray76 + #:grey76 + #:gray77 + #:grey77 + #:gray78 + #:grey78 + #:gray79 + #:grey79 + #:gray80 + #:grey80 + #:gray81 + #:grey81 + #:gray82 + #:grey82 + #:gray83 + #:grey83 + #:gray84 + #:grey84 + #:gray85 + #:grey85 + #:gray86 + #:grey86 + #:gray87 + #:grey87 + #:gray88 + #:grey88 + #:gray89 + #:grey89 + #:gray90 + #:grey90 + #:gray91 + #:grey91 + #:gray92 + #:grey92 + #:gray93 + #:grey93 + #:gray94 + #:grey94 + #:gray95 + #:grey95 + #:gray96 + #:grey96 + #:gray97 + #:grey97 + #:gray98 + #:grey98 + #:gray99 + #:grey99 + #:gray100 + #:grey100 + #:darkgrey + #:darkgray + #:darkblue + #:darkcyan + #:darkmagenta + #:darkred + #:lightgreen)) diff --git a/parse-x11-colors.lisp b/parse-x11-colors.lisp index 4966998..ccc0564 100644 --- a/parse-x11-colors.lisp +++ b/parse-x11-colors.lisp @@ -3,37 +3,66 @@ ;;; no packages defined as this should just be run as a script. (require :cl-ppcre) +(require :alexandria) -(let ((color-scanner ; will only take names w/o spaces - (cl-ppcre:create-scanner - "^\\s*(\\d+)\\s+(\\d+)\\s+(\\d+)\\s+([\\s\\w]+\?)\\s*$" - :extended-mode t)) - (comment-scanner (cl-ppcre:create-scanner "^\\s*!"))) - (with-open-file (s "/usr/share/X11/rgb.txt" - :direction :input - :if-does-not-exist :error) - (with-open-file (colornames "colornames.lisp" - :direction :output - :if-exists :overwrite - :if-does-not-exist :create) - (format colornames ";;;; This file was generated automatically ~ +(defun write-package-file (colornames + &key (package-template-path "package-template.lisp") + (package-file-path "package.lisp")) + "Write a package definition file, exporting COLORNAMES, using the given template." + (let* ((package-template (alexandria:read-file-into-string package-template-path)) + (colornames-export + (reduce (lambda (a b) (format nil "~A~%~A" a b)) + colornames + :key (lambda (colorname) + (format nil " #:~A" colorname))))) + (with-open-file (package-file package-file-path + :direction :output + :if-exists :supersede + :if-does-not-exist :create) + (format package-file package-template colornames-export)) + (values))) + +(defun parse-and-write-color-definitions (&key + (source-path "/usr/share/X11/rgb.txt") + (destination-path "colornames.lisp")) + "Parse color definitions and write them into a file. Return the list of colors (for exporting)." + (let ((color-scanner ; will only take names w/o spaces + (cl-ppcre:create-scanner + "^\\s*(\\d+)\\s+(\\d+)\\s+(\\d+)\\s+([\\s\\w]+\?)\\s*$" + :extended-mode t)) + (comment-scanner (cl-ppcre:create-scanner "^\\s*!")) + colornames) + (with-open-file (source source-path + :direction :input + :if-does-not-exist :error) + (with-open-file (colordefs destination-path + :direction :output + :if-exists :supersede + :if-does-not-exist :create) + (format colordefs ";;;; This file was generated automatically ~ by parse-x11.lisp~%~ ;;;; Please do not edit directly, just run make if necessary (but should not be).~2%~ (in-package #:cl-colors)~2%") - (labels ((parse-channel (string) - (let ((i (read-from-string string))) - (assert (and (typep i 'integer) (<= i 255))) - (/ i 255)))) - (do ((line (read-line s nil nil) (read-line s nil nil))) - ((not line)) - (unless (cl-ppcre:scan-to-strings comment-scanner line) - (multiple-value-bind (match registers) - (cl-ppcre:scan-to-strings color-scanner line) - (if (and match (not (find #\space (aref registers 3)))) - (format colornames - "(define-rgb-color ~A ~A ~A ~A)~%" - (string-downcase (aref registers 3)) - (parse-channel (aref registers 0)) - (parse-channel (aref registers 1)) - (parse-channel (aref registers 2))) - (format t "ignoring line ~A~%" line))))))))) + (labels ((parse-channel (string) + (let ((i (read-from-string string))) + (assert (and (typep i 'integer) (<= i 255))) + (/ i 255)))) + (do ((line (read-line source nil nil) (read-line source nil nil))) + ((not line)) + (unless (cl-ppcre:scan-to-strings comment-scanner line) + (multiple-value-bind (match registers) + (cl-ppcre:scan-to-strings color-scanner line) + (if (and match (not (find #\space (aref registers 3)))) + (let ((colorname (string-downcase (aref registers 3)))) + (format colordefs + "(define-rgb-color ~A ~A ~A ~A)~%" + colorname + (parse-channel (aref registers 0)) + (parse-channel (aref registers 1)) + (parse-channel (aref registers 2))) + (push colorname colornames)) + (format t "ignoring line ~A~%" line))))))) + (nreverse colornames)))) + +(let ((colornames (parse-and-write-color-definitions))) + (write-package-file colornames))