(define (rand) (/ (random 42001) 42000)) (define (nn n) (cond ((< n 0) 0) ((> n 1) 1) (else n))) (define (c-to-l c) (if (<= c 0.03928) (/ c 12.92) (expt (/ (+ c 0.055) 1.055) 2.4))) (define (relative-luminance rgb) (apply + (map (lambda (color coefficient) (* coefficient (c-to-l color))) rgb '(0.2126 0.7152 0.0722)))) (define (contrast-ratio color1 color2) (let ((l1 (+ 0.05 (relative-luminance color1))) (l2 (+ 0.05 (relative-luminance color2)))) (if (> l1 l2) (/ l1 l2) (/ l2 l1)))) (define (l-to-c m) (if (<= m (/ 0.03928 12.92)) (* m 12.92) (- (* (expt m (/ 1 2.4)) 1.055) 0.055))) (define (color-with-luminance-higher-than N) (let* ((Rc 0.2126) (Gc 0.7152) (Bc 0.0722) (R-min-lum (nn (/ (- N Gc Bc) Rc))) (R-min-color (l-to-c R-min-lum)) (R-color (+ R-min-color (* (rand) (- 1 R-min-color)))) (R-lum (* Rc (c-to-l R-color))) (G-min-lum (nn (/ (- N R-lum Bc) Gc))) (G-min-color (l-to-c G-min-lum)) (G-color (+ G-min-color (* (rand) (- 1 G-min-color)))) (G-lum (* Gc (c-to-l G-color))) (B-min-lum (nn (/ (- N R-lum G-lum) Bc))) (B-min-color (l-to-c B-min-lum)) (B-color (+ B-min-color (* (rand) (- 1 B-min-color)))) (B-lum (* Bc (c-to-l B-color)))) (list R-color G-color B-color))) (define (color-with-luminance-lower-than N) (let* ((Rc 0.2126) (Gc 0.7152) (Bc 0.0722) (R-max-lum (nn (/ N Rc))) (R-max-color (l-to-c R-max-lum)) (R-color (* R-max-color (rand))) (R-lum (* Rc (c-to-l R-color))) (G-max-lum (nn (/ (- N R-lum) Gc))) (G-max-color (l-to-c G-max-lum)) (G-color (* G-max-color (rand))) (G-lum (* Gc (c-to-l G-color))) (B-max-lum (nn (/ (- N R-lum G-lum) Bc))) (B-max-color (l-to-c B-max-lum)) (B-color (* B-max-color (rand))) (B-lum (* Bc (c-to-l B-color)))) (list R-color G-color B-color))) (define (generate-contrast-color color ratio) (let ((color-lum (relative-luminance color))) (if (< color-lum (- (/ 1 ratio) 0.05)) (color-with-luminance-higher-than (+ (* (+ color-lum 0.05) ratio) 0.05)) (color-with-luminance-lower-than (- (/ (+ color-lum 0.05) ratio) 0.05)))))