/[cl-colors]/parse-x11.lisp
ViewVC logotype

Contents of /parse-x11.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1 - (show annotations)
Mon Aug 13 11:52:20 2007 UTC (6 years, 8 months ago) by tpapp
File size: 1755 byte(s)
initial import
1 ;; parse X11's rgb.txt
2
3 (require :cl-ppcre)
4
5 (let ((color-scanner ; will only take names w/o spaces
6 (cl-ppcre:create-scanner
7 "^\\s*(\\d+)\\s+(\\d+)\\s+(\\d+)\\s+([\\s\\w]+\?)\\s*$"
8 :extended-mode t))
9 (comment-scanner
10 (cl-ppcre:create-scanner
11 "^\\s*!")))
12 (with-open-file (s "/usr/share/X11/rgb.txt"
13 :direction :input
14 :if-does-not-exist :error)
15 (with-open-file (colornames "colornames.lisp"
16 :direction :output
17 :if-exists :overwrite
18 :if-does-not-exist :create)
19 (format colornames ";;;; This file was generated automatically ~
20 by parse-x11.lisp~%~
21 ;;;; Please do not edit directly.~%~
22 (in-package :cl-colors)~%~
23 (defmacro define-rgb-color (name red green blue)
24 `(progn
25 (defconstant ,name (if (boundp ',name)
26 (symbol-value ',name)
27 (make-instance 'rgb
28 :red ,red
29 :green ,green
30 :blue ,blue)))
31 (export ',name)))~%")
32 (labels ((string-to-float (string)
33 (let ((i (read-from-string string)))
34 (assert (and (typep i 'integer) (<= i 255)))
35 (/ i 255d0))))
36 (do ((line (read-line s nil nil) (read-line s nil nil)))
37 ((not line))
38 (unless (cl-ppcre:scan-to-strings comment-scanner line)
39 (multiple-value-bind (match registers)
40 (cl-ppcre:scan-to-strings color-scanner line)
41 (if (and match (not (find #\space (aref registers 3))))
42 (format colornames
43 "(define-rgb-color +~A+ ~A ~A ~A)~%"
44 (string-downcase (aref registers 3))
45 (string-to-float (aref registers 0))
46 (string-to-float (aref registers 1))
47 (string-to-float (aref registers 2)))
48 (format t "ignoring line ~A~%" line)))))))))

  ViewVC Help
Powered by ViewVC 1.1.5