diff options
| -rw-r--r-- | chickadee.scm | 127 |
1 files changed, 108 insertions, 19 deletions
diff --git a/chickadee.scm b/chickadee.scm index 58513d4..8250e19 100644 --- a/chickadee.scm +++ b/chickadee.scm @@ -22,15 +22,6 @@ ;;; Code: (define-module (chickadee) - #:use-module (sdl2) - #:use-module (sdl2 events) - #:use-module ((sdl2 input game-controller) #:prefix sdl2:) - #:use-module (sdl2 input joystick) - #:use-module ((sdl2 input keyboard) #:prefix sdl2:) - #:use-module ((sdl2 input mouse) #:prefix sdl2:) - #:use-module (sdl2 input text) - #:use-module (sdl2 mixer) - #:use-module (sdl2 video) #:use-module (chickadee config) #:use-module (chickadee game-loop) #:use-module (chickadee math matrix) @@ -40,7 +31,35 @@ #:use-module (chickadee render gpu) #:use-module (chickadee render viewport) #:use-module (chickadee utils) + #:use-module (ice-9 match) + #:use-module (sdl2) + #:use-module (sdl2 events) + #:use-module ((sdl2 input game-controller) #:prefix sdl2:) + #:use-module (sdl2 input joystick) + #:use-module ((sdl2 input keyboard) #:prefix sdl2:) + #:use-module ((sdl2 input mouse) #:prefix sdl2:) + #:use-module (sdl2 input text) + #:use-module (sdl2 mixer) + #:use-module ((sdl2 video) #:prefix sdl2:) + #:use-module (srfi srfi-9) #:export (current-window + window? + window-width + window-height + window-x + window-y + window-title + hide-window! + show-window! + maximize-window! + minimize-window! + raise-window! + restore-window! + set-window-border! + set-window-title! + set-window-size! + set-window-position! + set-window-fullscreen! controller-button-pressed? controller-axis controller-name @@ -111,8 +130,78 @@ not being pushed at all." (lambda (controller) (sdl2:game-controller-name controller)))) +(define-record-type <window> + (wrap-sdl-window sdl-window) + window? + (sdl-window unwrap-window)) + (define current-window (make-parameter #f)) +(define-syntax-rule (define-window-wrapper (name args ...) sdl-proc docstring) + (define (name window args ...) + docstring + (sdl-proc (unwrap-window window) args ...))) + +(define-window-wrapper (window-title) sdl2:window-title + "Return the title of WINDOW.") + +(define-window-wrapper (hide-window!) sdl2:hide-window! + "Hide WINDOW.") + +(define-window-wrapper (show-window!) sdl2:show-window! + "Show WINDOW.") + +(define-window-wrapper (maximize-window!) sdl2:maximize-window! + "Maximize WINDOW.") + +(define-window-wrapper (minimize-window!) sdl2:minimize-window! + "Minimize WINDOW.") + +(define-window-wrapper (raise-window!) sdl2:raise-window! + "Make WINDOW visible over all other windows.") + +(define-window-wrapper (restore-window!) sdl2:restore-window! + "Restore the size and position of a minimized or maximized WINDOW.") + +(define-window-wrapper (set-window-border! border?) sdl2:set-window-border! + "Enable/disable the border around WINDOW. If BORDER? is #f, the +border is disabled, otherwise it is enabled.") + +(define-window-wrapper (set-window-title! title) sdl2:set-window-title! + "Set the title of WINDOW to TITLE.") + +(define-window-wrapper (set-window-fullscreen! fullscreen?) sdl2:set-window-fullscreen! + "Enable or disable fullscreen mode for WINDOW. If FULLSCREEN? is +#f, fullscreen mode is disabled, otherwise it is enabled.") + +(define (window-width window) + "Return the width of WINDOW." + (match (sdl2:window-size (unwrap-window window)) + ((x _) x))) + +(define (window-height window) + "Return the height of WINDOW." + (match (sdl2:window-size (unwrap-window window)) + ((_ y) y))) + +(define (window-x window) + "Return the X coordinate of the upper-left corner of WINDOW." + (match (sdl2:window-position (unwrap-window window)) + ((x _) x))) + +(define (window-y window) + "Return the Y coordinate of the upper-left corner of WINDOW." + (match (sdl2:window-position (unwrap-window window)) + ((_ y) y))) + +(define (set-window-size! window width height) + "Change the dimensions of WINDOW to WIDTH x HEIGHT pixels." + (sdl2:set-window-size! (unwrap-window window) (list width height))) + +(define (set-window-position! window x y) + "Move the upper-left corner of WINDOW to pixel coordinates (X, Y)." + (sdl2:set-window-position! (unwrap-window window) (list x y))) + (define* (run-game #:key (window-title "Chickadee!") (window-width 640) @@ -139,11 +228,11 @@ not being pushed at all." (false-if-exception (mixer-init)) (open-audio) (start-text-input) - (let* ((window (make-window #:opengl? #t - #:title window-title - #:size (list window-width window-height) - #:fullscreen? window-fullscreen?)) - (gl-context (make-gl-context window)) + (let* ((window (sdl2:make-window #:opengl? #t + #:title window-title + #:size (list window-width window-height) + #:fullscreen? window-fullscreen?)) + (gl-context (sdl2:make-gl-context window)) (gpu (make-gpu gl-context)) (default-viewport (make-viewport 0 0 window-width window-height)) (default-projection (orthographic-projection 0 window-width @@ -226,17 +315,17 @@ not being pushed at all." (with-viewport default-viewport (with-projection default-projection (draw alpha))) - (swap-gl-window window)) + (sdl2:swap-gl-window window)) (dynamic-wind (const #t) (lambda () - (parameterize ((current-window window) + (parameterize ((current-window (wrap-sdl-window window)) (current-gpu gpu)) ;; Attempt to activate vsync, if possible. Some systems do ;; not support setting the OpenGL swap interval. (catch #t (lambda () - (set-gl-swap-interval! 'vsync)) + (sdl2:set-gl-swap-interval! 'vsync)) (lambda args (display "warning: could not enable vsync\n" (current-error-port)))) @@ -249,5 +338,5 @@ not being pushed at all." #:time sdl-ticks #:update-hz update-hz))) (lambda () - (delete-gl-context! gl-context) - (close-window! window))))) + (sdl2:delete-gl-context! gl-context) + (sdl2:close-window! window))))) |