summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDavid Thompson <dthompson2@worcester.edu>2019-11-06 08:58:17 -0500
committerDavid Thompson <dthompson2@worcester.edu>2019-11-06 08:58:17 -0500
commit31c4a95afad01dc18683e3d36c4f7a131e4bd34f (patch)
treeade3a6c6742411cf211b71fe86ff0ab92cbb023d
parent4d88ff6baaeb34d68511c68878147416914eb962 (diff)
Add a bunch of window manipulation procedures.
-rw-r--r--chickadee.scm127
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)))))