+;;;; This file is part of LilyPond, the GNU music typesetter.
;;;;
-;;;; x11-color.scm -- allows access to x11 color codes
+;;;; Copyright (C) 2005--2015 Bernard Hurley <bernard@fong-hurley.org.uk>
;;;;
-;;;; source file of the GNU LilyPond music typesetter
-;;;;
-;;;; (c) 2005--2006 Bernard Hurley <bernard@fong-hurley.org.uk>
+;;;; LilyPond is free software: you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License as published by
+;;;; the Free Software Foundation, either version 3 of the License, or
+;;;; (at your option) any later version.
;;;;
+;;;; LilyPond is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;;; GNU General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with LilyPond. If not, see <http://www.gnu.org/licenses/>.
-(define x11-color-list
+(define x11-color-list
'((snow 1 0.98039215686274506 0.98039215686274506)
(GhostWhite 0.97254901960784312 0.97254901960784312 1)
(WhiteSmoke 0.96078431372549022 0.96078431372549022 0.96078431372549022)
(define (make-x11-color-handler)
(let
((x11-color-table (make-hash-table 31)))
-
+
(lambda (arg)
- (let*
- ((arg-sym (if (string? arg)
- (if (string-index arg #\ )
- (let
- ((arg-list (string-split (string-capitalize arg) #\ )))
+ (let*
+ ((arg-sym (if (string? arg)
+ (if (string-index arg #\ )
+ (let
+ ((arg-list (string-split (string-capitalize arg) #\ )))
+
+ (string->symbol
+ (let append-all ((x arg-list))
+ (if (null? x)
+ ""
+ (string-append (car x) (append-all (cdr x)))))))
+
+ (string->symbol arg))
+ arg))
+
+ (temp (hashq-ref x11-color-table arg-sym)))
+
+ (if temp
+ temp
+ (let*
+ ((temp-1 (assq-ref x11-color-list arg-sym))
+ (temp (if temp-1 temp-1 '(0 0 0))))
- (string->symbol
- (let append-all ((x arg-list))
- (if (null? x)
- ""
- (string-append (car x) (append-all (cdr x)))))))
-
- (string->symbol arg))
- arg))
-
- (temp (hashq-ref x11-color-table arg-sym)))
-
- (if temp
- temp
- (let*
- ((temp-1 (assq-ref x11-color-list arg-sym))
- (temp (if temp-1 temp-1 '(0 0 0))))
-
- (hashq-create-handle! x11-color-table arg-sym temp)
- temp))))))
+ (hashq-create-handle! x11-color-table arg-sym temp)
+ temp))))))
(define-public x11-color (make-x11-color-handler))