summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--2d/helpers.scm23
-rw-r--r--2d/texture.scm24
2 files changed, 30 insertions, 17 deletions
diff --git a/2d/helpers.scm b/2d/helpers.scm
index 142161a..a9d2dfe 100644
--- a/2d/helpers.scm
+++ b/2d/helpers.scm
@@ -24,8 +24,11 @@
(define-module (2d helpers)
#:use-module (srfi srfi-1)
#:use-module (rnrs arithmetic bitwise)
+ #:use-module (2d agenda)
+ #:use-module (2d game)
#:export (any-equal?
- logand?))
+ logand?
+ define-guardian))
(define (any-equal? elem . args)
"Return #t if ELEM equals any of the elements in the list ARGS."
@@ -35,3 +38,21 @@
"Return #t if the result of a bitwise AND of the integers in list
ARGS is non-zero."
(not (zero? (apply logand args))))
+
+(define-syntax-rule (define-guardian name reaper)
+ "Define a new guardian called NAME and call REAPER when an object
+within the guardian is GC'd. Reaping is ensured to happen from the
+same thread that is running the game loop."
+ (begin
+ (define name (make-guardian))
+ (add-hook! after-gc-hook
+ (lambda ()
+ (define (reap)
+ (let ((obj (name)))
+ (when obj
+ (reaper obj)
+ (reap))))
+ ;; Scheduling the reaping procedure in the game
+ ;; loop's agenda ensures that the reaping will be
+ ;; done in the main thread.
+ (schedule game-agenda reap)))))
diff --git a/2d/texture.scm b/2d/texture.scm
index daa0568..faa2359 100644
--- a/2d/texture.scm
+++ b/2d/texture.scm
@@ -93,22 +93,14 @@ that will be rendered, in pixels."
;; Use a guardian and an after GC hook that ensures that OpenGL
;; textures are deleted when texture objects are GC'd.
-(define texture-guardian (make-guardian))
-
-(define (reap-textures)
- (let loop ((texture (texture-guardian)))
- (when texture
- ;; Do not reap texture regions
- (unless (texture-region? texture)
- ;; When attempting to reap structures upon guile exit, the
- ;; dynamic pointer to gl-delete-textures becomes invalid. So, we
- ;; ignore the error and move on.
- (catch 'misc-error
- (lambda () (gl-delete-texture (texture-id texture)))
- (lambda (key . args) #f)))
- (loop (texture-guardian)))))
-
-(add-hook! after-gc-hook reap-textures)
+(define-guardian texture-guardian
+ (lambda (texture)
+ ;; Do not reap texture regions
+ (unless (texture-region? texture)
+ ;; When attempting to reap structures upon guile exit, the
+ ;; dynamic pointer to gl-delete-textures becomes invalid. So, we
+ ;; ignore the error and move on.
+ (false-if-exception (gl-delete-texture (texture-id texture))))))
(define (bitmap->texture bitmap)
"Translates a freeimage bitmap into an OpenGL texture."