From f02b353e84d4fea27630216dca8a8c7aa144b77d Mon Sep 17 00:00:00 2001 From: Thomas White Date: Sun, 18 Apr 2021 11:38:17 +0200 Subject: Extend attribute-handling functions to handle colour component IDs The following routines become generic functions with special cases for when a specific colour channel is being referred to: - set-in-state! - find-attr - get-attr-home-val - state-find - current-value --- guile/starlet/colours.scm | 24 +++++++++++++++++++++++- 1 file changed, 23 insertions(+), 1 deletion(-) (limited to 'guile/starlet/colours.scm') diff --git a/guile/starlet/colours.scm b/guile/starlet/colours.scm index b5ff71b..2553089 100644 --- a/guile/starlet/colours.scm +++ b/guile/starlet/colours.scm @@ -21,7 +21,8 @@ colour-component-id? colour-component-id - get-colour-component)) + get-colour-component + extract-colour-component)) (define-class () @@ -150,3 +151,24 @@ (define (colour-component-id a) (make #:component a)) + + +(define (extract-colour-component col component-id) + (cond + ((eq? (get-colour-component component-id) 'cyan) + (cyan (colour-as-cmy col))) + ((eq? (get-colour-component component-id) 'magenta) + (magenta (colour-as-cmy col))) + ((eq? (get-colour-component component-id) 'yellow) + (yellow (colour-as-cmy col))) + ((eq? (get-colour-component component-id) 'red) + (red (colour-as-rgb col))) + ((eq? (get-colour-component component-id) 'green) + (green (colour-as-rgb col))) + ((eq? (get-colour-component component-id) 'blue) + (blue (colour-as-rgb col))) + (else (raise-exception (make-exception + (make-exception-with-message + "Invalid colour component ID") + (make-exception-with-irritants + (get-colour-component component-id))))))) -- cgit v1.2.3