diff options
| -rw-r--r-- | chickadee/render/color.scm | 39 |
1 files changed, 38 insertions, 1 deletions
diff --git a/chickadee/render/color.scm b/chickadee/render/color.scm index 387e6d2..0536848 100644 --- a/chickadee/render/color.scm +++ b/chickadee/render/color.scm @@ -29,7 +29,7 @@ #:export (color make-color color? color-r color-g color-b color-a - rgba rgb transparency + rgba rgb transparency string->color color* color+ color- color-inverse color-lerp white black red green blue yellow magenta cyan transparent @@ -102,6 +102,43 @@ For example: #xffffff will return a color with RGBA values 1, 1, 1, ALPHA. ALPHA is clamped to the range [0, 1]." (make-color 1 1 1 alpha)) +(define (string->color s) + "Convert the color code string S, in a format like \"#RRGGBBAA\", to +a color object." + (define (parse-digit i) + (match (string-ref s i) + (#\0 0) + (#\1 1) + (#\2 2) + (#\3 3) + (#\4 4) + (#\5 5) + (#\6 6) + (#\7 7) + (#\8 8) + (#\9 9) + ((or #\a #\A) 10) + ((or #\b #\B) 11) + ((or #\c #\C) 12) + ((or #\d #\D) 13) + ((or #\e #\E) 14) + ((or #\f #\F) 15))) + (define (parse-channel i) + (/ (+ (* (parse-digit i) 16) + (parse-digit (+ i 1))) + 255.0)) + ;; Support color codes with or without a "#" prefix and with or + ;; without an alpha channel. + (let* ((start (if (string-prefix? "#" s) 1 0)) + (alpha? (> (string-length s) (+ start 6))) + (red (parse-channel start)) + (green (parse-channel (+ start 2))) + (blue (parse-channel (+ start 4))) + (alpha (if alpha? + (parse-channel (+ start 6)) + 1.0))) + (make-color red green blue alpha))) + ;; TODO: Optimize and inline (define color* (match-lambda* |