diff options
| -rw-r--r-- | 2d/helpers.scm | 23 | ||||
| -rw-r--r-- | 2d/texture.scm | 24 |
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." |