summaryrefslogtreecommitdiff
path: root/chickadee.scm
blob: 09212fed3fb9fc0582a3670364f11f9b7f37434f (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
;;; Chickadee Game Toolkit
;;; Copyright © 2016, 2018 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)
  #:export (run-game
            abort-game))


;;;
;;; Error handling
;;;

(define (display-game-loop-error stack key args)
  (let ((port (current-error-port)))
    (display "Backtrace:\n" port)
    (display-backtrace stack port)
    (newline port)
    (apply display-error (stack-ref stack 0) port args)
    (newline port)))

(define (call-with-error-handling handler thunk)
  (let ((stack #f))
    (catch #t
      thunk
      (lambda (key . args)
        (display-game-loop-error stack key args)
        (error stack key args))
      (lambda (key . args)
        (set! stack (make-stack #t 3))))))

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


;;;
;;; Game loop core
;;;

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

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

(define* (run-game #:key update render time error (update-hz 60))
  (let ((timestep (round (/ 1000 update-hz))))
    (call-with-prompt game-loop-prompt-tag
      (lambda ()
        ;; Catch SIGINT and kill the loop.
        (sigaction SIGINT
          (lambda (signum)
            (abort-game)))
        ;; 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))
          (let* ((current-time (time))
                 (delta (- current-time previous-time)))
            (let update-loop ((buffer (+ buffer delta)))
              (if (>= buffer timestep)
                  (begin
                    (with-error-handling error (update timestep))
                    (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.
                    (with-error-handling error (render (/ buffer timestep)))
                    (loop current-time buffer)))))))
      (lambda (cont callback)
        #f))))