I rewrote x11-color.scm so that now the color-list is generated
semi-automatically. It's more organized, easier to read, and less
than a quarter of its original size. But does my approach slow
things down at all? Measurably? I figure the current version is
probably faster because no calculations need to be made during the
definition of the color-list. But I don't have a good sense of the
impact of this. I'm not posting a patch here because I'm pretty
sure it would be way too big for the list-server.
Anyway, please comment if you can.
- Mark
;;;;
;;;; x11-color.scm -- allows access to x11 color codes
;;;;
;;;; source file of the GNU LilyPond music typesetter
;;;;
;;;; (c) 2005--2009 Bernard Hurley <bern...@fong-hurley.org.uk>
;;;;
(define (number->symbol x)
(string->symbol (number->string x)))
(define invariant-colors
;; 63 colors that do not accept suffixes
'((AliceBlue 240 248 255)
(beige 245 245 220)
(black 0 0 0)
(BlanchedAlmond 255 235 205)
(BlueViolet 138 43 226)
(CornflowerBlue 100 149 237)
(DarkBlue 0 0 139)
(DarkCyan 0 139 139)
(DarkGray 169 169 169)
(DarkGreen 0 100 0)
(DarkGrey 169 169 169)
(DarkKhaki 189 183 107)
(DarkMagenta 139 0 139)
(DarkRed 139 0 0)
(DarkSalmon 233 150 122)
(DarkSlateBlue 72 61 139)
(DarkSlateGrey 47 79 79)
(DarkTurquoise 0 206 209)
(DarkViolet 148 0 211)
(DimGray 105 105 105)
(DimGrey 105 105 105)
(FloralWhite 255 250 240)
(ForestGreen 34 139 34)
(gainsboro 220 220 220)
(GhostWhite 248 248 255)
(GreenYellow 173 255 47)
(lavender 230 230 250)
(LawnGreen 124 252 0)
(LightCoral 240 128 128)
(LightGoldenrodYellow 250 250 210)
(LightGray 211 211 211)
(LightGreen 144 238 144)
(LightGrey 211 211 211)
(LightSeaGreen 32 178 170)
(LightSlateBlue 132 112 255)
(LightSlateGray 119 136 153)
(LightSlateGrey 119 136 153)
(LimeGreen 50 205 50)
(linen 250 240 230)
(MediumAquamarine 102 205 170)
(MediumBlue 0 0 205)
(MediumSeaGreen 60 179 113)
(MediumSlateBlue 123 104 238)
(MediumSpringGreen 0 250 154)
(MediumTurquoise 72 209 204)
(MediumVioletRed 199 21 133)
(MidnightBlue 25 25 112)
(MintCream 245 255 250)
(moccasin 255 228 181)
(navy 0 0 128)
(NavyBlue 0 0 128)
(OldLace 253 245 230)
(PaleGoldenrod 238 232 170)
(PapayaWhip 255 239 213)
(peru 205 133 63)
(PowderBlue 176 224 230)
(SaddleBrown 139 69 19)
(SandyBrown 244 164 96)
(SlateGrey 112 128 144)
(violet 238 130 238)
(white 255 255 255)
(WhiteSmoke 245 245 245)
(YellowGreen 154 205 50)))
(define variant-colors
;; 78 colors that accept suffixes [1-4] (390 total)
'((AntiqueWhite 250 235 215)
(aquamarine 127 255 212)
(azure 240 255 255)
(bisque 255 228 196)
(blue 0 0 255)
(brown 165 42 42)
(burlywood 222 184 135)
(CadetBlue 95 158 160)
(chartreuse 127 255 0)
(chocolate 210 105 30)
(coral 255 127 80)
(cornsilk 255 248 220)
(cyan 0 255 255)
(DarkGoldenrod 184 134 11)
(DarkOliveGreen 85 107 47)
(DarkOrange 255 140 0)
(DarkOrchid 153 50 204)
(DarkSeaGreen 143 188 143)
(DarkSlateGray 47 79 79)
(DeepPink 255 20 147)
(DeepSkyBlue 0 191 255)
(DodgerBlue 30 144 255)
(firebrick 178 34 34)
(gold 255 215 0)
(goldenrod 218 165 32)
(green 0 255 0)
(honeydew 240 255 240)
(HotPink 255 105 180)
(IndianRed 205 92 92)
(ivory 255 255 240)
(khaki 240 230 140)
(LavenderBlush 255 240 245)
(LemonChiffon 255 250 205)
(LightBlue 173 216 230)
(LightCyan 224 255 255)
(LightGoldenrod 238 221 130)
(LightPink 255 182 193)
(LightSalmon 255 160 122)
(LightSkyBlue 135 206 250)
(LightSteelBlue 176 196 222)
(LightYellow 255 255 224)
(magenta 255 0 255)
(maroon 176 48 96)
(MediumOrchid 186 85 211)
(MediumPurple 147 112 219)
(MistyRose 255 228 225)
(NavajoWhite 255 222 173)
(OliveDrab 107 142 35)
(orange 255 165 0)
(OrangeRed 255 69 0)
(orchid 218 112 214)
(PaleGreen 152 251 152)
(PaleTurquoise 175 238 238)
(PaleVioletRed 219 112 147)
(PeachPuff 255 218 185)
(pink 255 192 203)
(plum 221 160 221)
(purple 160 32 240)
(red 255 0 0)
(RosyBrown 188 143 143)
(RoyalBlue 65 105 225)
(salmon 250 128 114)
(SeaGreen 46 139 87)
(seashell 255 245 238)
(sienna 160 82 45)
(SkyBlue 135 206 235)
(SlateBlue 106 90 205)
(SlateGray 112 128 144)
(snow 255 250 250)
(SpringGreen 0 255 127)
(SteelBlue 70 130 180)
(tan 210 180 140)
(thistle 216 191 216)
(tomato 255 99 71)
(turquoise 64 224 208)
(VioletRed 208 32 144)
(wheat 245 222 179)
(yellow 255 255 0)))
(define variant-color-exceptions
;; 21 exceptions to the normal variant-color formula.
'((CadetBlue1 152 245 255)
(coral1 255 114 86)
(DarkOrange1 255 127 0)
(HotPink1 255 110 180)
(HotPink2 238 106 167)
(HotPink3 205 96 144)
(HotPink4 139 58 98)
(IndianRed1 255 106 106)
(khaki1 255 246 143)
(LightPink1 255 174 185)
(LightSkyBlue1 176 226 255)
(maroon1 255 52 179)
(pink1 255 181 197)
(plum1 255 187 255)
(purple1 155 48 255)
(RoyalBlue1 72 118 255)
(salmon1 255 140 105)
(SkyBlue1 135 206 255)
(tan1 255 165 79)
(turquoise1 0 245 255)
(VioletRed1 255 62 150)))
(define grays
;; grays can accept an optional suffix [0-100] (204 total)
(apply append
'((gray 190 190 190)
(grey 190 190 190))
(map
(lambda (suffix)
(let ((numsym (number->symbol suffix))
(val ((case suffix ((30 70) ceiling) ; must be forced
((50 90) floor) ; must be forced
(else round))
(* suffix 255/100))))
(list
(list (symbol-append 'gray numsym) val val val)
(list (symbol-append 'grey numsym) val val val))))
(iota 101))))
(define (get-rgb1 name rgb)
"Brighten RGB as much as possible without altering proportions,
unless <name>1 is in variant-color-exceptions.
Eg. (get-rgb1 'foo '(210 180 140)) ==> '(255 218 170)
(get-rgb1 'tan '(210 180 140)) ==> '(255 165 79)"
(let* ((name1 (symbol-append name (number->symbol 1)))
(exception (assoc-ref variant-color-exceptions name1)))
(if exception
exception
(let ((factor (/ 255 (apply max rgb))))
(map (lambda (x) (floor (* x factor)))
rgb)))))
(define (derive-variant name rgb1 suffix)
"Derive appropriate color-variant based on SUFFIX, unless an
exception is listed in variant-color-exceptions."
(let* ((new-name (symbol-append name (number->symbol suffix)))
(exception (assoc-ref variant-color-exceptions new-name)))
(if exception
(cons new-name exception)
(let ((factor (case suffix ((1) 1.0)
((2) 0.9355)
((3) 0.8065)
((4) 0.5485))))
(cons new-name
(map (lambda (x)
(inexact->exact (floor (* x factor))))
rgb1))))))
(define (list-all-variants color-entry)
"Return a list where the car is COLOR-ENTRY and the cdr is the four
color-variants of COLOR-ENTRY."
(let* ((name (car color-entry))
(rgb (cdr color-entry))
(rgb1 (get-rgb1 name rgb)))
(cons color-entry
(map (lambda (x) (derive-variant name rgb1 x))
'(1 2 3 4)))))
(define (rgb255->rgb1 color-entry)
"Map a color-entry to the range [0,1].
Eg. (rgb255->rgb1 '(myColor 0 102 255)) ==> '(myColor 0 0.4 1)"
(cons (car color-entry)
(map (lambda (x)
(let ((val (/ x 255)))
(if (integer? val)
val
(exact->inexact val))))
(cdr color-entry))))
(define x11-color-list
(map rgb255->rgb1
(apply append
invariant-colors
(apply append (map list-all-variants variant-colors))
(list grays))))
(define (append-all 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))))))))
(define (make-x11-color-handler)
(let ((x11-color-table (make-hash-table 31)))
(lambda (arg)
(let* ((x11-color-table (make-hash-table 31))
(arg-sym (if (string? arg)
(if (string-index arg #\ )
(append-all arg)
(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))))))
(define-public x11-color (make-x11-color-handler))
_______________________________________________
lilypond-devel mailing list
lilypond-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/lilypond-devel
