;;; 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 (rnrs base)
  #: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-delete!
            array-list-clear!
            array-list-for-each
            array-list-fold))

(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 #:optional (initial-capacity 32))
  (%make-array-list (make-vector initial-capacity) 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))
         (old-size (vector-length old-vec))
         (new-size (+ old-size (div old-size 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)
  (if (and (>= i 0) (< i (array-list-size array-list)))
      (vector-ref (array-list-vector array-list) i)
      (error "array list index out of bounds" 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)))
    ;; Remove element reference so it can be GC'd.
    (array-list-set! array-list index #f)
    (set-array-list-size! array-list index)
    item))

(define* (array-list-delete! array-list item #:key (equal? equal?) fast?)
  (let* ((v (array-list-vector array-list))
         (n (array-list-size array-list)))
    (let loop ((i 0))
      (when (< i n)
        (if (equal? item (vector-ref v i))
            (begin
              (if fast?
                  ;; Fast: Swap the last element with the element to be
                  ;; deleted.  Constant time but does not preserve
                  ;; order.
                  (let ((last (- n 1)))
                    (vector-set! v i (vector-ref v last))
                    (vector-set! v last #f))
                  ;; Slow: Shift all elements to the left. Linear time
                  ;; but preserves order.
                  (let shift ((j (+ i 1)))
                    (if (= j n)
                        (vector-set! v j #f)
                        (begin
                          (vector-set! v (- j 1) (vector-ref v j))
                          (shift (+ j 1))))))
              (set-array-list-size! array-list (- n 1)))
            (loop (+ i 1)))))))

(define (array-list-clear! array-list)
  (let ((size (array-list-size array-list))
        (vec (array-list-vector array-list)))
    ;; Remove all element references so they can be GC'd.
    (let loop ((i 0))
      (when (< i size)
        (vector-set! vec i #f)
        (loop (1+ i)))))
  (set-array-list-size! array-list 0)
  *unspecified*)

(define (array-list-for-each proc array-list)
  (let ((vec (array-list-vector array-list)))
    (let loop ((i 0))
      (when (< i (array-list-size array-list))
        (proc i (vector-ref vec i))
        (loop (1+ i))))))

(define (array-list-fold proc init array-list)
  (let ((vec (array-list-vector array-list)))
    (let loop ((i 0)
               (prev init))
      (if (< i (array-list-size array-list))
          (loop (1+ i) (proc i (vector-ref vec i) prev))
          prev))))