From 87730c7d9ba00d6fc024594a05cb5d0e6e000dde Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Wed, 28 Apr 2021 21:15:51 -0400
Subject: Add ring-buffer-clear! procedure.

---
 starling/ring-buffer.scm | 39 +++++++++++----------------------------
 1 file changed, 11 insertions(+), 28 deletions(-)

diff --git a/starling/ring-buffer.scm b/starling/ring-buffer.scm
index 2b67f78..1138755 100644
--- a/starling/ring-buffer.scm
+++ b/starling/ring-buffer.scm
@@ -5,7 +5,8 @@
             ring-buffer-length
             ring-buffer-put!
             ring-buffer-get!
-            ring-buffer-ref))
+            ring-buffer-ref
+            ring-buffer-clear!))
 
 (define-record-type <ring-buffer>
   (%make-ring-buffer vector length head tail)
@@ -52,30 +53,12 @@
         (vector-ref v (modulo (+ (ring-buffer-head ring) i)
                               (vector-length v))))))
 
-;; (define (test)
-;;   (define (do-test ring)
-;;     (ring-buffer-put! ring 'h)
-;;     (pk ring)
-;;     (ring-buffer-put! ring 'e)
-;;     (pk ring)
-;;     (ring-buffer-put! ring 'l)
-;;     (pk ring)
-;;     (ring-buffer-put! ring 'l)
-;;     (pk ring)
-;;     (ring-buffer-put! ring 'o)
-;;     (pk ring)
-;;     (ring-buffer-put! ring 'w)
-;;     (pk ring)
-;;     (ring-buffer-put! ring 'o)
-;;     (pk ring)
-;;     (ring-buffer-put! ring 'r)
-;;     (pk ring)
-;;     (ring-buffer-put! ring 'l)
-;;     (pk ring)
-;;     (ring-buffer-put! ring 'd)
-;;     (pk ring)
-;;     (pk (ring-buffer-get! ring) (ring-buffer-get! ring) (ring-buffer-get! ring) (ring-buffer-get! ring))
-;;     (pk ring))
-;;   (let ((ring (make-ring-buffer 4)))
-;;     (do-test ring)
-;;     (do-test ring)))
+(define (ring-buffer-clear! ring)
+  (let ((l (ring-buffer-length ring))
+        (v (ring-buffer-vector ring)))
+    (set-ring-buffer-head! ring 0)
+    (set-ring-buffer-tail! ring 0)
+    (let loop ((i 0))
+      (when (< i l)
+        (vector-set! v i #f)
+        (loop (+ i 1))))))
-- 
cgit v1.2.3