diff options
author | Thomas White <taw@physics.org> | 2021-04-06 21:45:15 +0200 |
---|---|---|
committer | Thomas White <taw@physics.org> | 2021-04-06 23:05:44 +0200 |
commit | 686cad73eca73d9bbf7122e30bb5f433f0661b86 (patch) | |
tree | fadec0638ac245887817878b2e372286163da44e /guile/starlet/colours.scm | |
parent | 094e72b0e6215aa002a6a68951ba28521448185f (diff) |
Initial abstraction layer for colours
Diffstat (limited to 'guile/starlet/colours.scm')
-rw-r--r-- | guile/starlet/colours.scm | 45 |
1 files changed, 45 insertions, 0 deletions
diff --git a/guile/starlet/colours.scm b/guile/starlet/colours.scm new file mode 100644 index 0000000..d390c5d --- /dev/null +++ b/guile/starlet/colours.scm @@ -0,0 +1,45 @@ +(define-module (starlet colours) + #:use-module (oop goops) + #:export (<colour> + make-colour-cmy + make-colour-rgb + colour-as-cmy + white)) + + +(define-class <colour> (<object>) + (type + #:init-form (error "Colour type must be specified") + #:init-keyword #:type + #:getter colour-type) + + (value + #:init-form (error "Colour value must be specified") + #:init-keyword #:value + #:getter colour-value)) + + +(define-method (write (col <colour>) port) + (format port "#<<colour> ~a ~a>" + (colour-type col) + (colour-value col))) + + +(define (make-colour-cmy c m y) + (make <colour> + #:type 'cmy + #:value (list c m y))) + + +(define (make-colour-rgb r g b) + (make <colour> + #:type 'rgb + #:value (list r g b))) + + +(define white + (make-colour-cmy 0 0 0)) + + +(define (colour-as-cmy col) + (colour-value col)) |