diff options
author | David Thompson <dthompson2@worcester.edu> | 2024-02-23 08:32:48 -0500 |
---|---|---|
committer | David Thompson <dthompson2@worcester.edu> | 2024-02-23 08:32:48 -0500 |
commit | 1484dbd1b7348af77fb8771183b9feb8a5b7fd60 (patch) | |
tree | 9de55ac17963175f9c311b9d3e1f691a11eac9e5 | |
parent | 6d783ec06cd33cb0050ebeaa2a71d7e55e1422e1 (diff) |
graphics: color: Use bytestructs.
-rw-r--r-- | chickadee/graphics/color.scm | 33 | ||||
-rw-r--r-- | chickadee/graphics/shader.scm | 12 |
2 files changed, 14 insertions, 31 deletions
diff --git a/chickadee/graphics/color.scm b/chickadee/graphics/color.scm index 1611f89..ed89082 100644 --- a/chickadee/graphics/color.scm +++ b/chickadee/graphics/color.scm @@ -20,6 +20,7 @@ ;;; Code: (define-module (chickadee graphics color) + #:use-module (chickadee data bytestruct) #:use-module (chickadee graphics engine) #:use-module (chickadee graphics gl) #:use-module (chickadee math) @@ -28,7 +29,8 @@ #:use-module (srfi srfi-9) #:use-module (srfi srfi-9 gnu) #:use-module (srfi srfi-1) - #:export (make-color + #:export (<color> + make-color make-color8 color? color-r @@ -128,31 +130,16 @@ color-mask-blue? color-mask-alpha?)) -(define-record-type <color> - (wrap-color bv) +(define-byterecord-type <color> + (%make-color r g b a) color? - (bv unwrap-color)) - -(define-inlinable (color-r color) - (f32vector-ref (unwrap-color color) 0)) - -(define-inlinable (color-g color) - (f32vector-ref (unwrap-color color) 1)) - -(define-inlinable (color-b color) - (f32vector-ref (unwrap-color color) 2)) - -(define-inlinable (color-a color) - (f32vector-ref (unwrap-color color) 3)) - -(define (display-color c port) - (format port "#<color r: ~1,3f, g: ~1,3f, b: ~1,3f, a: ~1,3f>" - (color-r c) (color-g c) (color-b c) (color-a c))) - -(set-record-type-printer! <color> display-color) + (r f32 color-r) + (g f32 color-g) + (b f32 color-b) + (a f32 color-a)) (define* (make-color r g b #:optional (a 1.0)) - (wrap-color (f32vector r g b a))) + (%make-color r g b a)) (define* (make-color8 r g b #:optional (a 255)) (make-color (/ r 255.0) (/ g 255.0) (/ b 255.0) (/ a 255.0))) diff --git a/chickadee/graphics/shader.scm b/chickadee/graphics/shader.scm index edde064..3d8d369 100644 --- a/chickadee/graphics/shader.scm +++ b/chickadee/graphics/shader.scm @@ -198,17 +198,13 @@ #:validator (lambda (x) (or (rect? x) (color? x))) #:serializer (let ((unwrap-rect (@@ (chickadee math rect) unwrap-rect))) - (lambda (bv i v) + (lambda (bv i x) ;; As of now, there is no vec4 Scheme type, but we do want to ;; accept colors and rects as vec4s since there is no special ;; color or rect type in GLSL. - (if (rect? v) - (bytevector-copy! (unwrap-rect v) 0 bv i 16) - (begin - (bytevector-ieee-single-native-set! bv i (color-r v)) - (bytevector-ieee-single-native-set! bv (+ i 4) (color-g v)) - (bytevector-ieee-single-native-set! bv (+ i 8) (color-b v)) - (bytevector-ieee-single-native-set! bv (+ i 12) (color-a v)))))) + (if (rect? x) + (bytevector-copy! (unwrap-rect x) 0 bv i 16) + (bytestruct-pack! <color> ((() x)) bv i)))) #:setter gl-uniform4fv #:null (make-null-rect)) |