;;; Chickadee Game Toolkit
;;; Copyright © 2016, 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 game-loop)
  #:export (run-game*
            abort-game
            current-timestep))


;;;
;;; Error handling
;;;

(define (call-with-error-handling handler thunk)
  "Call THUNK and respond to any exceptions with HANDLER.  Return #t if
an error was handled."
  (if handler
      (let ((stack #f))
        (define (pre-unwind-handler . args)
          (set! stack (make-stack #t 4)))
        (define (throw-handler)
          (with-throw-handler #t thunk pre-unwind-handler)
          #f)
        (define (exception-handler e)
          (handler e stack)
          #t)
        (with-exception-handler exception-handler throw-handler #:unwind? #t))
      (begin
        (thunk)
        #f)))

(define-syntax-rule (with-error-handling handler body ...)
  (call-with-error-handling handler (lambda () body ...)))


;;;
;;; Game loop kernel
;;;

(define game-loop-prompt-tag (make-prompt-tag 'game-loop))

(define (abort-game)
  (abort-to-prompt game-loop-prompt-tag #f))

(define current-timestep (make-parameter 0.0))

(define* (run-game* #:key init update render time error
                    (update-hz 60))
  (let ((timestep (/ 1.0 update-hz)))
    (parameterize ((current-timestep timestep))
      (call-with-prompt game-loop-prompt-tag
        (lambda ()
          ;; Catch SIGINT and kill the loop.
          (sigaction SIGINT
            (lambda (signum)
              (abort-game)))
          (init)
          ;; A simple analogy is that we are filling up a bucket
          ;; with water.  When the bucket fills up to a marked
          ;; line, we dump it out.  Our water is time, and each
          ;; time we dump the bucket we update the game.  Updating
          ;; the game on a fixed timestep like this yields a
          ;; stable simulation.
          (let loop ((previous-time (time))
                     (buffer 0.0))
            (let* ((current-time (time))
                   (delta (- current-time previous-time)))
              (let update-loop ((buffer (+ buffer delta)))
                (if (>= buffer timestep)
                    ;; Short-circuit the update loop if an error
                    ;; occurred, and reset the current time to now in
                    ;; order to discard the undefined amount of time
                    ;; that was spent handling the error.
                    (if (with-error-handling error (update timestep))
                        (loop (time) 0.0)
                        (update-loop (- buffer timestep)))
                    (begin
                      ;; We render upon every iteration of the loop, and
                      ;; thus rendering is decoupled from updating.
                      ;; It's possible to render multiple times before
                      ;; an update is performed.
                      (if (with-error-handling error
                            (render (/ buffer timestep))
                            (usleep 1))
                          (loop (time) 0.0)
                          (loop current-time buffer))))))))
        (lambda (cont callback)
          #f)))))