diff options
author | David Thompson <dthompson2@worcester.edu> | 2016-02-15 14:52:03 -0500 |
---|---|---|
committer | David Thompson <dthompson2@worcester.edu> | 2016-02-15 14:52:03 -0500 |
commit | 0de5247b7653394bf9ceecfc17d188dab3c7bcd5 (patch) | |
tree | 6ef8d323c32ed62bbdd90ea72f541e414c848d25 /sly/render | |
parent | 000315b8f5e2cfe45db0ebfe42f9208c9c0d95e1 (diff) |
Use a single foreign object guardian.
Rather than each foreign resource type creating its own guardian, let's
just use one instead so that there is only a single guardian to talk to
each frame.
* sly/guardian.scm: New file.
* Makefile.am (SOURCES): Add it.
* sly/game.scm (run-game-loop): Start guardian worker.
* sly/render/mesh.scm (mesh-guardian): Delete.
(free-mesh): New procedure.
(make-mesh): Guard newly created meshes.
* sly/render/shader.scm (shader-stage-guardian): Delete.
(free-shader-stage): New procedure.
(make-shader-stage): Guard newly created shader stages.
(shader-guardian): Delete.
(free-shader): New procedure.
(make-shader): Guard newly created shaders.
* sly/render/texture.scm (texture-guardian): Delete.
(free-texture): New procedure.
(make-texture): Guard newly created textures.
Diffstat (limited to 'sly/render')
-rw-r--r-- | sly/render/mesh.scm | 27 | ||||
-rw-r--r-- | sly/render/shader.scm | 28 | ||||
-rw-r--r-- | sly/render/texture.scm | 20 |
3 files changed, 37 insertions, 38 deletions
diff --git a/sly/render/mesh.scm b/sly/render/mesh.scm index acf9a0f..f1d6e2c 100644 --- a/sly/render/mesh.scm +++ b/sly/render/mesh.scm @@ -34,6 +34,7 @@ #:use-module (gl low-level) #:use-module (gl enums) #:use-module (sly utils) + #:use-module (sly guardian) #:use-module (sly wrappers gl) #:use-module (sly math vector) #:use-module (sly render color) @@ -264,17 +265,18 @@ allows vertex buffers to be updated with new vertex data." (length mesh-length) (vertex-buffers mesh-vertex-buffers)) -(define-guardian mesh-guardian - (lambda (mesh) - ;; Delete vertex array and vertex buffers. - (glDeleteVertexArrays 1 (u32vector (mesh-id mesh))) - (let ((buffers (mesh-vertex-buffers mesh))) - (glDeleteBuffers (length buffers) - (list->u32vector - (map (match-lambda - ((_ . vbo) - (vertex-buffer-id vbo))) - buffers)))))) +(define (free-mesh mesh) + ;; Delete vertex array and vertex buffers. + (glDeleteVertexArrays 1 (u32vector (mesh-id mesh))) + (let ((buffers (mesh-vertex-buffers mesh))) + (glDeleteBuffers (length buffers) + (list->u32vector + (map (match-lambda + ((_ . vbo) + (vertex-buffer-id vbo))) + buffers))))) + +(register-finalizer mesh? free-mesh) (define null-mesh (%make-mesh 0 0 '())) @@ -309,8 +311,7 @@ allows vertex buffers to be updated with new vertex data." (vertex-attrib-pointer vertex-position-location position-buffer) (vertex-attrib-pointer vertex-texture-location texture-buffer) (apply-vertex-buffer index-buffer)) - (mesh-guardian mesh) - mesh)) + (guard mesh))) (define (build-mesh indices positions textures) (let ((index-buffer (vector->vertex-buffer indices #t)) diff --git a/sly/render/shader.scm b/sly/render/shader.scm index 556d626..3367b57 100644 --- a/sly/render/shader.scm +++ b/sly/render/shader.scm @@ -26,6 +26,7 @@ #:use-module (gl) #:use-module (gl low-level) #:use-module (sly utils) + #:use-module (sly guardian) #:use-module (sly math transform) #:use-module (sly math vector) #:use-module (sly render color) @@ -88,10 +89,11 @@ (eq? (shader-stage-type stage) 'fragment)) ;; Reap GL shaders when their wrapper objects are GC'd. -(define-guardian shader-stage-guardian - (lambda (stage) - (false-if-exception - (glDeleteShader (shader-stage-id stage))))) +(define (free-shader-stage stage) + (false-if-exception + (glDeleteShader (shader-stage-id stage)))) + +(register-finalizer shader-stage? free-shader-stage) (define-status %shader-stage-compiled? glGetShaderiv compile-status) @@ -135,10 +137,9 @@ or 'fragment') and compile the GLSL program contained in the string SOURCE." (let* ((id (glCreateShader (gl-shader-type type))) (stage (%make-shader-stage type id))) - (shader-stage-guardian stage) (set-shader-stage-source stage source) (compile-shader-stage stage) - stage)) + (guard stage))) (define (make-vertex-shader-stage source) "Create a new GLSL vertex shader stage and compile the GLSL program @@ -205,10 +206,11 @@ stored in the file FILE-NAME." (uniform-location uniform) (error "Uniform not found: " name)))) -(define-guardian shader-guardian - (lambda (shader) - (false-if-exception - (glDeleteProgram (shader-id shader))))) +(define (free-shader shader) + (false-if-exception + (glDeleteProgram (shader-id shader)))) + +(register-finalizer shader? free-shader) (define-status shader-linked? glGetProgramiv link-status) (define-logger display-linking-error glGetProgramiv glGetProgramInfoLog) @@ -252,10 +254,8 @@ VERTEX-STAGE and FRAGMENT-STAGE." (for-each (lambda (stage) (glDetachShader id (shader-stage-id stage))) stages) - (let* ((uniforms (map build-uniform uniforms)) - (shader (%make-shader id uniforms))) - (shader-guardian shader) - shader)) + (let* ((uniforms (map build-uniform uniforms))) + (guard (%make-shader id uniforms)))) throw (lambda _ ;; Make sure to delete program in case linking fails. diff --git a/sly/render/texture.scm b/sly/render/texture.scm index bb7f88c..2e77b0f 100644 --- a/sly/render/texture.scm +++ b/sly/render/texture.scm @@ -31,8 +31,9 @@ #:use-module (gl contrib packed-struct) #:use-module (sdl2 image) #:use-module (sdl2 surface) - #:use-module (sly render color) + #:use-module (sly guardian) #:use-module (sly utils) + #:use-module (sly render color) #:use-module (sly math vector) #:use-module (sly wrappers gl) #:export (make-texture @@ -90,9 +91,7 @@ a texture object (if this texture only represents a region of another texture) or #f. WIDTH and HEIGHT are the texture dimensions in pixels. S1, T1, S2, and T2 are the OpenGL texture coordinates representing the area of the texture that will be rendered." - (let ((texture (%make-texture id parent width height s1 t1 s2 t2))) - (texture-guardian texture) - texture)) + (guard (%make-texture id parent width height s1 t1 s2 t2))) (define (make-texture-region texture x y width height) "Creates new texture region object. TEXTURE is the region's parent @@ -109,13 +108,12 @@ that will be rendered, in pixels." (/ (+ x width) w) (/ (+ y height) h)))) -;; Use a guardian and an after GC hook that ensures that OpenGL -;; textures are deleted when texture objects are GC'd. -(define-guardian texture-guardian - (lambda (texture) - ;; Do not reap texture regions - (unless (texture-region? texture) - (gl-delete-texture (texture-id texture))))) +(define (free-texture texture) + ;; Do not reap texture regions. + (unless (texture-region? texture) + (gl-delete-texture (texture-id texture)))) + +(register-finalizer texture? free-texture) (define* (bytevector->texture pixels width height min-filter mag-filter #:optional (format (pixel-format rgba))) |