diff options
Diffstat (limited to 'mkclrnam.scm')
| -rwxr-xr-x[-rw-r--r--] | mkclrnam.scm | 66 |
1 files changed, 59 insertions, 7 deletions
diff --git a/mkclrnam.scm b/mkclrnam.scm index 341f6eb..14b49ae 100644..100755 --- a/mkclrnam.scm +++ b/mkclrnam.scm @@ -1,5 +1,5 @@ ;;; "mkclrnam.scm" create color name databases -;Copyright 2001, 2002, 2003, 2007 Aubrey Jaffer +;Copyright 2001, 2002, 2003, 2007, 2008 Aubrey Jaffer ; ;Permission to copy this software, to modify it, to redistribute it, ;to distribute modified versions, and to use it for any purpose is @@ -17,6 +17,7 @@ ;promotional, or sales literature without prior written consent in ;each case. +(require 'multiarg-apply) (require 'string-search) (require 'line-i/o) (require 'scanf) @@ -153,6 +154,13 @@ (color-name:canonicalize name))) (else #f))) (lambda (line) + (case (sscanf line "bang %d %d %d %d %[a-zA-Z0-9, ]%s" + r g b ri name junk) + ((5) (set! method-id 'm5b) + (list (check-match line (color:sRGB r g b)) + (color-name:canonicalize name))) + (else #f))) + (lambda (line) (case (sscanf line " %[- a-zA-Z.] %d %d %d %s" name r g b junk) ((4) (set! method-id 'm4b) @@ -174,12 +182,26 @@ (color-name:canonicalize name))) (else #f))) (lambda (line) - (case (sscanf line " %[a-zA-Z0-9_] #%x%6x%s" name rgbx junk) + (case (sscanf line " %[a-zA-Z()] %e %e %e %s" + name ri gi bi junk) + ((4) (set! method-id 'm4e) + (list (check-match line (color:L*a*b* ri gi bi)) + (color-name:canonicalize + (string-downcase! (StudlyCapsExpand name " "))))) + (else #f))) + (lambda (line) + (case (sscanf line " %[a-zA-Z0-9_] #%6x%s" name rgbx junk) ((2) (set! method-id 'm2a) (list (check-match line (xrgb->color rgbx)) (color-name:canonicalize name))) (else #f))) (lambda (line) + (case (sscanf line "[\"%6x\", \"%[^\"]\"], %s" rgbx name junk) + ((2) (set! method-id 'js) + (list (check-match line (xrgb->color rgbx)) + (color-name:canonicalize name))) + (else #f))) + (lambda (line) (case (sscanf line "%[- a-zA-Z']=#%6x<br>" name rgbx) ((2) (set! method-id 'm2b) (let ((idx (substring? "rgb" name))) @@ -188,12 +210,42 @@ (color-name:canonicalize (substring name 0 idx)))))) (else #f))) (lambda (line) + (case (sscanf line "%[ a-zA-Z/'] #%6x" name rgbx) + ((2) (set! method-id 'm2d) + (list (check-match line (xrgb->color rgbx)) + (color-name:canonicalize name))) + (else #f))) + (lambda (line) (case (sscanf line "\" %[^\"]\" %s" name junk) ((2) (set! method-id 'm2c) (let ((clr (string->color junk))) (and clr (list (check-match line clr) (color-name:canonicalize name))))) - (else #f))))) + (else #f))) + (lambda (line) + (case (sscanf line "%[a-z0-9 ]\t%[A-Z]:%[./0-9] %s" + name r rgbx junk) + ((3) (set! method-id 'm3x) + (list (check-match line (string->color + (string-append r ":" rgbx))) + (color-name:canonicalize name))) + (else #f))) + (lambda (line) + ;; FED-STD-595C - read only the first + (case (sscanf line "%5[0-9] %[A-Z]:%f/%f/%f" + name ri r g b) + ((5) (set! method-id 'm5x) + (cond ((string-ci=? "CIEXYZ" ri) + (list (check-match line (color:CIEXYZ (/ r 100) + (/ g 100) + (/ b 100))) + (color-name:canonicalize name))) + ((string-ci=? "CIELAB" ri) + (list (check-match line (color:L*A*B* r g b)) + (color-name:canonicalize name))) + (else #f))) + (else #f))) + )) ans)) (define (numbered-gray? str) (define idx #f) @@ -231,7 +283,7 @@ ;;This section has detailed the procedures for creating and loading ;;color dictionaries. So where are the dictionaries to load? ;; -;;@uref{http://swiss.csail.mit.edu/~jaffer/Color/Dictionaries.html} +;;@uref{http://people.csail.mit.edu/jaffer/Color/Dictionaries.html} ;; ;;@noindent ;;Describes and evaluates several color-name dictionaries on the web. @@ -260,13 +312,13 @@ (file->color-dictionary filename name cndb) (url->color-dictionary url name cndb))) lst)) - '(("http://swiss.csail.mit.edu/~jaffer/Color/saturate.txt" + '(("http://people.csail.mit.edu/jaffer/Color/saturate.txt" "saturate.txt" saturate) - ("http://swiss.csail.mit.edu/~jaffer/Color/resenecolours.txt" + ("http://people.csail.mit.edu/jaffer/Color/resenecolours.txt" "resenecolours.txt" resene) - ("http://swiss.csail.mit.edu/~jaffer/Color/nbs-iscc.txt" + ("http://people.csail.mit.edu/jaffer/Color/nbs-iscc.txt" "nbs-iscc.txt" nbs-iscc))) (close-database cndb)) |