summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--chickadee/render/color.scm39
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*