;; -*- geiser-scheme-implementation: guile -*-

;; Copyright 2019 Christopher Howard

;; This program 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.

;; This program 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 <https://www.gnu.org/licenses/>.

(define-module (buffer))

(use-modules (oop goops)
             (rnrs bytevectors))

(export circular-bytevector-copy!
        make-consumable-buffer
        insert!
        consume!
        edible-bytes
        bytes-free
        buffer-capacity)

(define-class <consumable-buffer> ()
  (storage #:accessor storage #| the storage bytevector |# )
  (insert-index #:accessor insert-index #| index for next write (data produced) |# )
  (consume-index #:accessor consume-index #| index for next read (data consumed) |# )
  (bytes-free #:accessor bytes-free #| inserted bytes that still can be consumed |# ))

(define-method (edible-bytes (c <consumable-buffer>))
  (- (bytevector-length (storage c)) (bytes-free c)))

(define-method (buffer-capacity (c <consumable-buffer>))
  (bytevector-length (storage c)))

(define* (make-consumable-buffer bytes #:optional (fill 0))
  "Create and initialize a new <consumable-buffer> object."
  (define c (make <consumable-buffer>))
  (set! (storage c) (make-bytevector bytes fill))
  (set! (insert-index c) 0)
  (set! (consume-index c) 0)
  (set! (bytes-free c) bytes)
  c)

(define (circular-bytevector-copy! source source-start target target-start len)
  "Just like bytevector-copy! from (rnrs bytevectors) but will wrap around both
 the source and target bytevectors for an unlimited length copy."
  (let* ((rem-source-space (- (bytevector-length source) source-start))
         (rem-target-space (- (bytevector-length target) target-start))
         (source-overrun (- len rem-source-space))
         (target-overrun (- len rem-target-space)))
    (cond
     ((and (<= source-overrun 0)
           (<= target-overrun 0))
        (bytevector-copy! source source-start target target-start len))
     ((= rem-source-space 0)
      (circular-bytevector-copy! source 0 target target-start len))
     ((= rem-target-space 0)
      (circular-bytevector-copy! source source-start target 0 len))
     (else (let ((amt-to-cpy (min rem-source-space rem-target-space)))
             (bytevector-copy! source source-start target target-start amt-to-cpy)
             (circular-bytevector-copy! source (+ source-start amt-to-cpy)
                                target (+ target-start amt-to-cpy)
                                (- len amt-to-cpy)))))))

(define-method (insert! source-bytevector source-start len (c <consumable-buffer>))
  "Copy data from source-bytevector into free bytes in the consumable buffer. Throw 
'insufficient-free-bytes if there are not enough free bytes in the buffer."
  (cond ((> len (bytes-free c))
         (throw 'insufficient-free-bytes))
        (else
         (circular-bytevector-copy! source-bytevector
                                    source-start
                                    (storage c)
                                    (insert-index c)
                                    len)
         (set! (insert-index c) (remainder (+ (insert-index c) len)
                                           (bytevector-length (storage c))))
         (set! (bytes-free c) (- (bytes-free c) len)))))

(define-method (consume! (c <consumable-buffer>) target-bytevector target-start len)
  "Copy data from the consumable buffer into the bytevector. Throw
'insufficient-edible-bytes if there are not enough inserted bytes."
  (let ((edible-bytes (- (bytevector-length (storage c)) (bytes-free c))))
    (cond ((> len edible-bytes)
           (throw 'insufficient-edible-bytes))
          (else
           (circular-bytevector-copy! (storage c)
                                      (consume-index c)
                                      target-bytevector
                                      target-start
                                      len)
           (set! (consume-index c) (remainder (+ (consume-index c) len)
                                              (bytevector-length (storage c))))
           (set!  (bytes-free c) (+ (bytes-free c) len))))))