;;; Sly ;;; Copyright (C) 2013, 2014 David Thompson ;;; ;;; 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 ;;; . ;;; Commentary: ;; ;; The game loop. ;; ;;; Code: (define-module (sly game) #:use-module (srfi srfi-1) #:use-module (srfi srfi-9) #:use-module (srfi srfi-11) #:use-module (srfi srfi-26) #:use-module (sdl2) #:use-module ((sdl2 video) #:prefix sdl2:) #:use-module (gl) #:use-module (sly agenda) #:use-module (sly event) #:use-module (sly guardian) #:use-module (sly math) #:use-module (sly signal) #:use-module (sly math vector) #:use-module (sly window) #:use-module (sly render) #:export (game-start-hook draw-hook after-game-loop-error-hook game-started? on-start run-game-loop stop-game-loop)) ;;; ;;; Hooks and initializers ;;; (define game-start-hook (make-hook)) (define draw-hook (make-hook 2)) (define after-game-loop-error-hook (make-hook)) (define-signal game-started? (hook->signal game-start-hook #f (lambda () #t))) (define-syntax on-start (syntax-rules () "Create a signal that evaluates EXP once the game loop has started. If INIT is specified, the signal uses the result of this expression as its initial value, otherwise #f is the initial value." ((_ exp) (signal-if game-started? exp #f)) ((_ exp init) (signal-if game-started? exp init)))) ;;; ;;; Game Loop ;;; (define (interval rate) (floor (/ 1000 rate))) (define (display-game-loop-error stack key . args) "Display a backtrace and error message using the current error port for the given STACK and error KEY with additional arguments ARGS." (let ((cep (current-error-port))) (display "Sly game loop error!\n\n" cep) (display "Backtrace:\n" cep) (display-backtrace stack cep) (newline cep) (apply display-error (stack-ref stack 0) cep args) (newline cep))) (define* (run-game-loop scene #:key (frame-rate 60) (tick-rate 60) (max-ticks-per-frame 4)) "Run the game loop. SCENE is a signal which contains the current scene renderer procedure. FRAME-RATE specifies the optimal number of frames to draw SCENE per second. TICK-RATE specifies the optimal game logic updates per second. Both FRAME-RATE and TICK-RATE are 60 by default. MAX-TICKS-PER-FRAME is the maximum number of times the game loop will update game state in a single frame. When this upper bound is reached due to poor performance, the game will start to slow down instead of becoming completely unresponsive and possibly crashing." (let ((tick-interval (interval tick-rate)) (frame-interval (interval frame-rate)) (gfx (make-graphics))) (define (draw dt alpha) "Render a frame." (let ((size (signal-ref window-size))) (gl-viewport 0 0 (inexact->exact (vx size)) (inexact->exact (vy size)))) (gl-clear (clear-buffer-mask color-buffer depth-buffer)) (run-hook draw-hook dt alpha) (with-graphics gfx (set-graphics-alpha! gfx alpha) ((signal-ref scene) gfx)) (swap-window)) (define (update lag) "Call the update callback. The update callback will be called as many times as tick-interval can divide LAG. The return value is the unused accumulator time." (define (iter lag ticks) (cond ((>= ticks max-ticks-per-frame) lag) ((>= lag tick-interval) (process-events) (agenda-tick!) (iter (- lag tick-interval) (1+ ticks))) (else lag))) (iter lag 0)) (define (alpha lag) "Calculate interpolation factor in the range [0, 1] for the leftover frame time LAG." (clamp 0 1 (/ lag tick-interval))) (define (frame-sleep time) "Sleep for the remainder of the frame that started at TIME." (let ((t (- (+ time frame-interval) (sdl-ticks)))) (usleep (max 0 (* t 1000))))) (define (process-frame previous-time lag) "Render and/or update the game as needed, integrating from the PREVIOUS-TIME to the current time, and updating using a game tick accumulator initialized to LAG. Returns a timestamp to be used as the starting point of the next delta time calculation and the leftover time in the game tick accumulator." (let* ((current-time (sdl-ticks)) (dt (- current-time previous-time))) (catch #t (lambda () (let ((lag (update (+ lag dt)))) (draw dt (alpha lag)) (frame-sleep current-time) (values current-time lag))) (lambda (key . args) (if (hook-empty? after-game-loop-error-hook) ;; Rethrow error if there's nothing to handle it. (apply throw key args) (begin (run-hook after-game-loop-error-hook) ;; An unknown amount of time has passed since running the ;; hook, so let's start with a fresh timer. (values (sdl-ticks) 0)))) (lambda (key . args) ;; Strip out 3 stack frames to get to the frame where the ;; error happened. The stripped frames include the throw ;; call, and the make-stack call. (apply display-game-loop-error (make-stack #t 3) key args))))) (define (game-loop previous-time lag) "Update game state, and render. PREVIOUS-TIME is the time in milliseconds of the last iteration of the game loop." (let-values (((time lag) (process-frame previous-time lag))) (game-loop time lag))) (call-with-prompt 'game-loop-prompt (lambda () ;; Catch SIGINT and kill the loop. (sigaction SIGINT (lambda (signum) (stop-game-loop))) ;; Let's play! (run-hook game-start-hook) (run-guardian) (game-loop (sdl-ticks) 0)) (lambda (cont callback) (when (procedure? callback) (callback cont)))))) (define (stop-game-loop) "Abort the game loop." (abort-to-prompt 'game-loop-prompt #f))