From 589cfe74979b90663297e0865621bf2c304bb5ff Mon Sep 17 00:00:00 2001 From: David Thompson Date: Fri, 23 Feb 2024 08:54:08 -0500 Subject: math: rect: Use bytestructs. --- chickadee/graphics/shader.scm | 15 ++++--- chickadee/math/rect.scm | 92 ++++++++----------------------------------- 2 files changed, 23 insertions(+), 84 deletions(-) diff --git a/chickadee/graphics/shader.scm b/chickadee/graphics/shader.scm index 3d8d369..ab0a8cf 100644 --- a/chickadee/graphics/shader.scm +++ b/chickadee/graphics/shader.scm @@ -197,14 +197,13 @@ #:size 16 ; 16 bytes = 4 floats = 1 vec4 #:validator (lambda (x) (or (rect? x) (color? x))) #:serializer - (let ((unwrap-rect (@@ (chickadee math rect) unwrap-rect))) - (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? x) - (bytevector-copy! (unwrap-rect x) 0 bv i 16) - (bytestruct-pack! ((() x)) bv i)))) + (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? x) + (bytestruct-pack! ((() x)) bv i) + (bytestruct-pack! ((() x)) bv i))) #:setter gl-uniform4fv #:null (make-null-rect)) diff --git a/chickadee/math/rect.scm b/chickadee/math/rect.scm index cc99fb0..6b774e2 100644 --- a/chickadee/math/rect.scm +++ b/chickadee/math/rect.scm @@ -14,14 +14,16 @@ ;;; limitations under the License. (define-module (chickadee math rect) + #:use-module (chickadee data bytestruct) + #:use-module (chickadee math) + #:use-module (chickadee math vector) #:use-module (ice-9 format) #:use-module (rnrs bytevectors) #:use-module (srfi srfi-4) #:use-module (srfi srfi-9) #:use-module (srfi srfi-9 gnu) - #:use-module (chickadee math) - #:use-module (chickadee math vector) - #:export (make-rect + #:export ( + make-rect make-null-rect rect rect? @@ -67,75 +69,43 @@ rect-contains? rect-contains-vec2?)) -;; This record type just wraps a 4 element f32vector as a workaround -;; for Guile not being able to unbox struct fields. Since floating -;; point numbers are heap-allocated in Guile, the name of this game is -;; to help the compiler unbox as much floating point math as possible. -;; Doing so greatly reduces allocation and thus improves the user -;; experience because there are less GC pauses. By using bytevectors -;; and inlining nearly everything, the compiler is able to optimize -;; away a lot of scm->f64 and f64->scm instructions. - -(define-record-type - (wrap-rect bv) +(define-byterecord-type + (make-rect x y width height) rect? - (bv unwrap-rect)) + (x f32 rect-x set-rect-x!) + (y f32 rect-y set-rect-y!) + (width f32 rect-width set-rect-width!) + (height f32 rect-height set-rect-height!)) (define (make-null-rect) - (wrap-rect (make-f32vector 4 0.0))) + (bytestruct-alloc )) (define-syntax-rule (with-new-rect name body ...) (let ((name (make-null-rect))) body ... name)) -(define-inlinable (rect-get rect i) - (f32vector-ref (unwrap-rect rect) i)) - -(define-inlinable (rect-set! rect i x) - (f32vector-set! (unwrap-rect rect) i x)) - -(define-inlinable (make-rect x y width height) - (with-new-rect rect - (rect-set! rect 0 x) - (rect-set! rect 1 y) - (rect-set! rect 2 width) - (rect-set! rect 3 height))) - (define-inlinable (rect x y width height) (make-rect x y width height)) (define (rect-copy! source-rect target-rect) "Copy TARGET-RECT to SOURCE-RECT." - (bytevector-copy! (unwrap-rect source-rect) - 0 - (unwrap-rect target-rect) - 0 - 16)) + (bytestruct-copy! source-rect target-rect)) (define (rect-copy rect) "Return a new rect that is a copy of RECT." - (with-new-rect new - (rect-copy! rect new))) + (bytestruct-copy rect)) ;;; ;;; Functional operations ;;; -(define-inlinable (rect-x rect) - "Return the x coordinate of the lower left corner of RECT." - (rect-get rect 0)) - (define-inlinable (rect-left rect) "Return the x coordinate of the lower left corner of RECT." - (rect-get rect 0)) - -(define-inlinable (rect-y rect) - "Return the y coordinate of the lower left corner of RECT." - (rect-get rect 1)) + (rect-x rect)) (define-inlinable (rect-bottom rect) "Return the y coordinate of the lower left corner of RECT." - (rect-get rect 1)) + (rect-y rect)) (define-inlinable (rect-right rect) "Return the x coordinate of the upper right corner of RECT." @@ -153,14 +123,6 @@ "Return the y coordinate of the center of RECT." (+ (rect-y rect) (/ (rect-height rect) 2.0))) -(define-inlinable (rect-width rect) - "Return the width of RECT." - (rect-get rect 2)) - -(define-inlinable (rect-height rect) - "Return the height of RECT." - (rect-get rect 3)) - (define-inlinable (rect-area rect) "Return the area of RECT." (* (rect-width rect) (rect-height rect))) @@ -173,33 +135,11 @@ "Restrict Y to the portion of the y axis covered by RECT." (clamp (rect-bottom rect) (rect-top rect) y)) -(define (display-rect rect port) - (format port "#" - (rect-x rect) (rect-y rect) (rect-width rect) (rect-height rect))) - -(set-record-type-printer! display-rect) - ;;; ;;; In-place operations ;;; -(define-inlinable (set-rect-x! rect x) - "Set the left x coordinate of RECT to X." - (rect-set! rect 0 x)) - -(define-inlinable (set-rect-y! rect y) - "Set the bottom y coordinate of RECT to Y." - (rect-set! rect 1 y)) - -(define-inlinable (set-rect-width! rect width) - "Set the width of RECT to WIDTH." - (rect-set! rect 2 width)) - -(define-inlinable (set-rect-height! rect height) - "Set the height of RECT to HEIGHT." - (rect-set! rect 3 height)) - (define-inlinable (rect-move! rect x y) "Move RECT to location (X, Y) in-place." (set-rect-x! rect x) -- cgit v1.2.3