;;; Chickadee Game Toolkit
;;; Copyright © 2017, 2018 David Thompson <dthompson2@worcester.edu>
;;;
;;; Licensed under the Apache License, Version 2.0 (the "License");
;;; you may not use this file except in compliance with the License.
;;; You may obtain a copy of the License at
;;;
;;;    http://www.apache.org/licenses/LICENSE-2.0
;;;
;;; Unless required by applicable law or agreed to in writing, software
;;; distributed under the License is distributed on an "AS IS" BASIS,
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;;; See the License for the specific language governing permissions and
;;; limitations under the License.

(define-module (chickadee scripting channel)
  #:use-module (chickadee data queue)
  #:use-module (chickadee scripting script)
  #:use-module (ice-9 match)
  #:use-module (srfi srfi-9)
  #:use-module (srfi srfi-9 gnu)
  #:export (make-channel
            channel?
            channel-get!
            channel-get
            channel-put!
            channel-put
            channel-clear!))

;; A very simplified notion of channels compared to guile-fibers.  In
;; our case, everything is cooperative and on the same thread, so we
;; have less to worry about.
(define-record-type <channel>
  (%make-channel get-queue put-queue)
  channel?
  (get-queue channel-get-queue)
  (put-queue channel-put-queue))

(define (display-channel channel port)
  (display "<channel>" port))

(set-record-type-printer! <channel> display-channel)

(define (make-channel)
  "Return a new channel."
  (%make-channel (make-queue) (make-queue)))

(define (maybe-deliver channel)
  (let ((getq (channel-get-queue channel))
        (putq (channel-put-queue channel)))
    (if (and (not (queue-empty? getq))
             (not (queue-empty? putq)))
        (match (dequeue! putq)
          ((data . put-cont)
           (let ((get-cont (dequeue! getq)))
             (get-cont data)
             (put-cont)))))))

(define (channel-get! channel proc)
  "Asynchronously retrieve a value from CHANNEL and call PROC with
that value."
  (enqueue! (channel-get-queue channel) proc)
  (maybe-deliver channel))

(define (channel-get channel)
  "Retrieve a value from CHANNEL.  The current script suspends until a
value is available."
  (yield
   (lambda (cont)
     (channel-get! channel cont))))

(define noop (lambda () #t))

(define* (channel-put! channel data #:optional (thunk noop))
  "Asynchronously send DATA to CHANNEL and call THUNK after it has
been received."
  (enqueue! (channel-put-queue channel) (cons data thunk))
  (maybe-deliver channel))

(define (channel-put channel data)
  "Send DATA to CHANNEL.  The current script suspends until another
script is available to retrieve the value."
  (yield
   (lambda (cont)
     (channel-put! channel data cont))))

(define (channel-clear! channel)
  "Clear all messages and scripts awaiting messages in CHANNEL."
  (queue-clear! (channel-get-queue channel))
  (queue-clear! (channel-put-queue channel)))