math: rect: Use bytestructs.

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! <color> ((() 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! <rect> ((() x)) bv i)
+        (bytestruct-pack! <color> ((() 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 (<rect>
+            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 <rect>
-  (wrap-rect bv)
+(define-byterecord-type <rect>
+  (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 <rect>))
 
 (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! <rect> 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> 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: ~f y: ~f width: ~f height: ~f>"
-          (rect-x rect) (rect-y rect) (rect-width rect) (rect-height rect)))
-
-(set-record-type-printer! <rect> 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)