From cdee6cb46427f685db8df2de04ece5ea47db86d3 Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Sat, 1 Apr 2017 14:28:29 -0400
Subject: Add array list module.

* chickadee/array-list.scm: New file.
* Makefile.am (SOURCES): Add it.
---
 Makefile.am              |   1 +
 chickadee/array-list.scm | 107 +++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 108 insertions(+)
 create mode 100644 chickadee/array-list.scm

diff --git a/Makefile.am b/Makefile.am
index 536217b..f185849 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -42,6 +42,7 @@ SOURCES = 					\
   chickadee/config.scm				\
   chickadee/utils.scm				\
   chickadee/heap.scm				\
+  chickadee/array-list.scm			\
   chickadee/audio.scm				\
   chickadee/input/controller.scm		\
   chickadee/input/keyboard.scm			\
diff --git a/chickadee/array-list.scm b/chickadee/array-list.scm
new file mode 100644
index 0000000..dad0b8d
--- /dev/null
+++ b/chickadee/array-list.scm
@@ -0,0 +1,107 @@
+;;; Chickadee Game Toolkit
+;;; Copyright © 2017 David Thompson <davet@gnu.org>
+;;;
+;;; Chickadee is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published
+;;; by the Free Software Foundation, either version 3 of the License,
+;;; or (at your option) any later version.
+;;;
+;;; Chickadee is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+(define-module (chickadee array-list)
+  #:use-module (ice-9 format)
+  #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-9 gnu)
+  #:use-module (srfi srfi-43)
+  #:export (make-array-list
+            array-list
+            array-list?
+            array-list-empty?
+            array-list-size
+            array-list-ref
+            array-list-set!
+            array-list-push!
+            array-list-pop!
+            array-list-clear!
+            array-list-for-each))
+
+(define-record-type <array-list>
+  (%make-array-list vector size)
+  array-list?
+  (vector array-list-vector set-array-list-vector!)
+  (size array-list-size set-array-list-size!))
+
+(define (display-array-list array-list port)
+  (display "<array-list" port)
+  (array-list-for-each (lambda (i item)
+                         (display " " port)
+                         (display item port))
+                       array-list)
+  (display ">" port))
+
+(set-record-type-printer! <array-list> display-array-list)
+
+(define (make-array-list)
+  (%make-array-list (make-vector 32) 0))
+
+(define (array-list . items)
+  (let ((l (make-array-list)))
+    (for-each (lambda (item)
+                (array-list-push! l item))
+              items)
+    l))
+
+(define (array-list-capacity array-list)
+  (vector-length (array-list-vector array-list)))
+
+(define (array-list-full? array-list)
+  (= (array-list-size array-list)
+     (array-list-capacity array-list)))
+
+(define (array-list-empty? array-list)
+  (zero? (array-list-size array-list)))
+
+(define (expand-array-list! array-list)
+  (let* ((old-vec (array-list-vector array-list))
+         (new-size (* (vector-length old-vec) 2))
+         (new-vec (make-vector new-size)))
+    (vector-copy! new-vec 0 old-vec)
+    (set-array-list-vector! array-list new-vec)))
+
+(define (array-list-ref array-list i)
+  (vector-ref (array-list-vector array-list) i))
+
+(define (array-list-set! array-list i x)
+  (vector-set! (array-list-vector array-list) i x))
+
+(define (array-list-push! array-list item)
+  (when (array-list-full? array-list)
+    (expand-array-list! array-list))
+  (let ((index (array-list-size array-list)))
+    (set-array-list-size! array-list (1+ index))
+    (array-list-set! array-list index item)))
+
+(define (array-list-pop! array-list)
+  (let* ((index (1- (array-list-size array-list)))
+         (item (array-list-ref array-list index)))
+    (set-array-list-size! array-list index)
+    item))
+
+(define (array-list-clear! array-list)
+  (set-array-list-size! array-list 0)
+  *unspecified*)
+
+(define (array-list-for-each proc array-list)
+  (let ((size (array-list-size array-list))
+        (vec (array-list-vector array-list)))
+    (let loop ((i 0))
+      (when (< i size)
+        (proc i (vector-ref vec i))
+        (loop (1+ i))))))
-- 
cgit v1.2.3