diff options
Diffstat (limited to 'chickadee/buffer.scm')
| -rw-r--r-- | chickadee/buffer.scm | 240 |
1 files changed, 0 insertions, 240 deletions
diff --git a/chickadee/buffer.scm b/chickadee/buffer.scm deleted file mode 100644 index a7a22fc..0000000 --- a/chickadee/buffer.scm +++ /dev/null @@ -1,240 +0,0 @@ -;;; Chickadee Game Toolkit -;;; Copyright © 2017 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 buffer) - #:use-module (chickadee) - #:use-module (chickadee scripting) - #:use-module (oop goops) - #:export (<buffer> - started? - start - stop - pause - resume - update - before-draw - draw - after-draw - abort - key-press - key-release - text-input - mouse-press - mouse-move - controller-add - controller-remove - controller-press - controller-release - controller-move - current-buffer - push-buffer! - pop-buffer! - replace-buffer! - use-buffers!)) - -(define-class <buffer> () - (started? #:init-value #f #:accessor buffer-started?) - (agenda #:init-thunk make-agenda #:getter buffer-agenda)) - -(define-method (start (buffer <buffer>)) - #t) - -(define-method (stop (buffer <buffer>)) - #t) - -(define-method (pause (buffer <buffer>)) - #t) - -(define-method (resume (buffer <buffer>)) - #t) - -(define-method (update (buffer <buffer>) dt) - #t) - -(define-method (abort (buffer <buffer>)) - (abort-game)) - -(define-method (before-draw (buffer <buffer>)) - #t) - -(define-method (draw (buffer <buffer>) alpha) - #t) - -(define-method (after-draw (buffer <buffer>)) - #t) - -(define-method (key-press (buffer <buffer>) key scancode modifiers repeat?) - #t) - -(define-method (key-release (buffer <buffer>) key scancode modifiers) - #t) - -(define-method (text-input (buffer <buffer>) text) - #t) - -(define-method (mouse-press (buffer <buffer>) button clicks x y) - #t) - -(define-method (mouse-release (buffer <buffer>) button x y) - #t) - -(define-method (mouse-move (buffer <buffer>) x y x-rel y-rel buttons) - #t) - -(define-method (controller-add (buffer <buffer>) controller) - #t) - -(define-method (controller-remove (buffer <buffer>) controller) - #t) - -(define-method (controller-press (buffer <buffer>) controller button) - #t) - -(define-method (controller-release (buffer <buffer>) controller button) - #t) - -(define-method (controller-move (buffer <buffer>) controller axis value) - #t) - - -;;; -;;; Buffer management -;;; - -(define *buffers* '()) - -(define (current-buffer) - "Return the current buffer." - (and (not (null? *buffers*)) - (car *buffers*))) - -(define-syntax-rule (with-buffer buffer body ...) - (with-agenda (buffer-agenda buffer) - body ...)) - -(define-syntax-rule (with-current-buffer name body ...) - (let ((name (current-buffer))) - (with-buffer name - body ...))) - -(define* (switch-buffers old new #:optional replace?) - (when (is-a? old <buffer>) - (with-buffer old - (if replace? - (stop old) - (pause old)))) - (with-buffer new - (if (buffer-started? new) - (resume new) - (begin - (start new) - (set! (buffer-started? new) #t))))) - -(define (push-buffer! buffer) - "Pause the current buffer and switch to BUFFER." - (let ((old (current-buffer))) - (set! *buffers* (cons buffer *buffers*)) - (switch-buffers old buffer))) - -(define (pop-buffer!) - "Stop the current buffer and switch back to the previously active -buffer, or terminate the game loop if the buffer stack is empty." - (let ((old (current-buffer))) - (set! *buffers* (cdr *buffers*)) - (if (null? *buffers*) - (begin - (stop old) - (abort-game)) - (switch-buffers old (current-buffer) #t)))) - -(define (replace-buffer! buffer) - "Stop the current buffer and switch to BUFFER." - (let ((old (current-buffer))) - (set! *buffers* (cons buffer (cdr *buffers*))) - (switch-buffers old buffer #t))) - -(define (use-buffers! initial-buffer) - "Install buffers into the game engine and set the current buffer to -INITIAL-BUFFER." - (add-hook! load-hook - (lambda () - (push-buffer! initial-buffer))) - (add-hook! update-hook - (lambda (dt) - (with-current-buffer buffer - (update-agenda 1) - (update buffer dt)))) - (add-hook! before-draw-hook - (lambda () - (with-current-buffer buffer - (before-draw buffer)))) - (add-hook! after-draw-hook - (lambda () - (with-current-buffer buffer - (after-draw buffer)))) - (add-hook! draw-hook - (lambda (alpha) - (with-current-buffer buffer - (draw buffer alpha)))) - (add-hook! quit-hook - (lambda () - (with-current-buffer buffer - (abort buffer)))) - (add-hook! key-press-hook - (lambda (key scancode modifiers repeat?) - (with-current-buffer buffer - (key-press buffer key scancode modifiers repeat?)))) - (add-hook! key-release-hook - (lambda (key scancode modifiers) - (with-current-buffer buffer - (key-release buffer key scancode modifiers)))) - (add-hook! text-input-hook - (lambda (text) - (with-current-buffer buffer - (text-input buffer text)))) - (add-hook! mouse-press-hook - (lambda (button clicks x y) - (with-current-buffer buffer - (mouse-press buffer button clicks x y)))) - (add-hook! mouse-release-hook - (lambda (button x y) - (with-current-buffer buffer - (mouse-release buffer button x y)))) - (add-hook! mouse-move-hook - (lambda (x y x-rel y-rel buttons) - (with-current-buffer buffer - (mouse-move buffer x y x-rel y-rel buttons)))) - (add-hook! controller-add-hook - (lambda (controller) - (with-current-buffer buffer - (controller-add buffer controller)))) - (add-hook! controller-remove-hook - (lambda (controller) - (with-current-buffer buffer - (controller-remove buffer controller)))) - (add-hook! controller-press-hook - (lambda (controller button) - (with-current-buffer buffer - (controller-press buffer controller button)))) - (add-hook! controller-release-hook - (lambda (controller button) - (with-current-buffer buffer - (controller-release buffer controller button)))) - (add-hook! controller-move-hook - (lambda (controller axis value) - (with-current-buffer buffer - (controller-move buffer controller axis value))))) |