diff options
Diffstat (limited to 'chickadee/window.scm')
-rw-r--r-- | chickadee/window.scm | 89 |
1 files changed, 89 insertions, 0 deletions
diff --git a/chickadee/window.scm b/chickadee/window.scm new file mode 100644 index 0000000..0ca94e4 --- /dev/null +++ b/chickadee/window.scm @@ -0,0 +1,89 @@ +;;; Chickadee Game Toolkit +;;; Copyright © 2016 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 window) + #:use-module (ice-9 match) + #:use-module (srfi srfi-9) + #:use-module ((sdl2) #:prefix sdl2:) + #:use-module ((sdl2 events) #:prefix sdl2:) + #:use-module ((sdl2 video) #:prefix sdl2:) + #:export (open-window + close-window + window? + window-title + window-width + window-height + window-fullscreen? + with-window + swap-buffers)) + +(define-record-type <window> + (make-window sdl-window gl-context) + window? + (sdl-window unwrap-window) + (gl-context window-gl-context)) + +(define* (open-window #:key + (title "Chickadee") + (width 640) + (height 480) + fullscreen?) + (sdl2:set-gl-attribute! 'context-major-version 3) + (sdl2:set-gl-attribute! 'context-minor-version 3) + (sdl2:set-gl-attribute! 'double-buffer 1) + (sdl2:set-gl-attribute! 'depth-size 24) + (sdl2:set-gl-attribute! 'red-size 8) + (sdl2:set-gl-attribute! 'green-size 8) + (sdl2:set-gl-attribute! 'blue-size 8) + (sdl2:set-gl-attribute! 'alpha-size 8) + (sdl2:set-gl-attribute! 'stencil-size 8) + (sdl2:set-gl-attribute! 'retained-backing 0) + (sdl2:set-gl-attribute! 'framebuffer-srgb-capable 1) + (let* ((sdl-window (sdl2:make-window #:opengl? #t + #:title title + #:size (list width height) + #:fullscreen? fullscreen?)) + (gl-context (sdl2:make-gl-context sdl-window)) + (window (make-window sdl-window gl-context))) + (sdl2:set-gl-swap-interval! 'vsync) + window)) + +(define (close-window! window) + "Close WINDOW." + (sdl2:delete-gl-context! (window-gl-context window)) + (sdl2:close-window! (unwrap-window window))) + +(define (window-title window) + "Return the title of WINDOW." + (sdl2:window-title (unwrap-window window))) + +(define (set-window-title! window title) + "Set TITLE for WINDOW." + (sdl2:set-window-title! (unwrap-window window) title)) + +(define (set-window-size! window width height) + (sdl2:set-window-size! (unwrap-window window) (list width height))) + +(define-syntax-rule (with-window window body ...) + (dynamic-wind + (const #t) + (lambda () body ...) + (lambda () + (close-window! window)))) + +(define (swap-buffers window) + (sdl2:swap-gl-window (unwrap-window window))) |