summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDavid Thompson <dthompson2@worcester.edu>2024-02-23 08:32:48 -0500
committerDavid Thompson <dthompson2@worcester.edu>2024-02-23 08:32:48 -0500
commit1484dbd1b7348af77fb8771183b9feb8a5b7fd60 (patch)
tree9de55ac17963175f9c311b9d3e1f691a11eac9e5
parent6d783ec06cd33cb0050ebeaa2a71d7e55e1422e1 (diff)
graphics: color: Use bytestructs.
-rw-r--r--chickadee/graphics/color.scm33
-rw-r--r--chickadee/graphics/shader.scm12
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))