;;; Chickadee Game Toolkit ;;; Copyright © 2016 David Thompson ;;; ;;; 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 ;;; . (define-module (chickadee) #:use-module (gl) #:use-module (sdl2) #:use-module (sdl2 events) #:use-module (sdl2 input text) #:use-module (chickadee color) #:use-module (chickadee math matrix) #:use-module (chickadee window) #:use-module (chickadee render) #:use-module (chickadee render gl) #:use-module (chickadee render gpu) #:use-module (chickadee render viewport) #:export (load-hook update-hook before-draw-hook draw-hook after-draw-hook quit-hook key-press-hook key-release-hook text-input-hook mouse-press-hook mouse-release-hook mouse-move-hook controller-add-hook controller-remove-hook controller-press-hook controller-release-hook controller-move-hook run-game abort-game time)) (define load-hook (make-hook 0)) (define update-hook (make-hook 1)) (define before-draw-hook (make-hook 0)) (define after-draw-hook (make-hook 0)) (define draw-hook (make-hook 1)) (define quit-hook (make-hook 0)) (define key-press-hook (make-hook 4)) (define key-release-hook (make-hook 3)) (define text-input-hook (make-hook 1)) (define mouse-press-hook (make-hook 4)) (define mouse-release-hook (make-hook 3)) (define mouse-move-hook (make-hook 5)) (define controller-add-hook (make-hook 1)) (define controller-remove-hook (make-hook 1)) (define controller-press-hook (make-hook 2)) (define controller-release-hook (make-hook 2)) (define controller-move-hook (make-hook 3)) (define open-controller (@@ (chickadee input controller) open-controller)) (define close-controller (@@ (chickadee input controller) close-controller)) (define lookup-controller (@@ (chickadee input controller) lookup-controller)) (define game-loop-prompt-tag (make-prompt-tag 'game-loop)) (define* (run-game #:key (window-title "Chickadee!") (window-width 640) (window-height 480) window-fullscreen? (update-hz 60)) (sdl-init) (start-text-input) (let ((window (open-window #:title window-title #:width window-width #:height window-height #:fullscreen? window-fullscreen?))) (define (process-event event) (cond ((quit-event? event) (run-hook quit-hook)) ((keyboard-down-event? event) (run-hook key-press-hook (keyboard-event-key event) (keyboard-event-scancode event) (keyboard-event-modifiers event) (keyboard-event-repeat event))) ((keyboard-up-event? event) (run-hook key-release-hook (keyboard-event-key event) (keyboard-event-scancode event) (keyboard-event-modifiers event))) ((text-input-event? event) (run-hook text-input-hook (text-input-event-text event))) ((mouse-button-down-event? event) (run-hook mouse-press-hook (mouse-button-event-button event) (mouse-button-event-clicks event) (mouse-button-event-x event) (mouse-button-event-y event))) ((mouse-button-up-event? event) (run-hook mouse-release-hook (mouse-button-event-button event) (mouse-button-event-x event) (mouse-button-event-y event))) ((mouse-motion-event? event) (run-hook mouse-move-hook (mouse-motion-event-x event) (mouse-motion-event-y event) (mouse-motion-event-x-rel event) (mouse-motion-event-y-rel event) (mouse-motion-event-buttons event))) ((and (controller-device-event? event) (eq? (controller-device-event-action event) 'added)) (run-hook controller-add-hook (open-controller (controller-device-event-which event)))) ((and (controller-device-event? event) (eq? (controller-device-event-action event) 'removed)) (let ((controller (lookup-controller (controller-device-event-which event)))) (run-hook controller-remove-hook controller) (close-controller controller))) ((controller-button-down-event? event) (run-hook controller-press-hook (lookup-controller (controller-button-event-which event)) (controller-button-event-button event))) ((controller-button-up-event? event) (run-hook controller-release-hook (lookup-controller (controller-button-event-which event)) (controller-button-event-button event))) ((controller-axis-event? event) (run-hook controller-move-hook (lookup-controller (controller-axis-event-which event)) (controller-axis-event-axis event) (/ (controller-axis-event-value event) 32768.0))))) (with-window window (let ((update-interval (round (/ 1000 update-hz))) (default-viewport (make-viewport 0 0 window-width window-height)) (default-projection (orthographic-projection 0 window-width window-height 0 0 1))) (call-with-prompt game-loop-prompt-tag (lambda () ;; Catch SIGINT and kill the loop. (sigaction SIGINT (lambda (signum) (abort-game))) (run-hook load-hook) (let loop ((previous-time (sdl-ticks)) (lag 0)) (let* ((current-time (sdl-ticks)) (delta (- current-time previous-time))) (let update-loop ((lag (+ lag delta))) (if (>= lag update-interval) (begin ;; Process all pending events. (let loop ((event (poll-event))) (when event (process-event event) (loop (poll-event)))) ;; Advance the simulation. (run-hook update-hook update-interval) (update-loop (- lag update-interval)) ;; Free any GPU resources that have been GC'd. (gpu-reap!)) (begin ;; Render a frame. (run-hook before-draw-hook) (with-viewport default-viewport (with-projection default-projection (run-hook draw-hook (/ lag update-interval)))) (swap-buffers window) (run-hook after-draw-hook) (loop current-time lag))))))) (lambda (cont callback) #f)))))) (define (abort-game) (abort-to-prompt game-loop-prompt-tag #f)) (define (time) (sdl-ticks))