diff options
| -rw-r--r-- | chickadee/render.scm | 103 |
1 files changed, 43 insertions, 60 deletions
diff --git a/chickadee/render.scm b/chickadee/render.scm index 5b95d1b..f502369 100644 --- a/chickadee/render.scm +++ b/chickadee/render.scm @@ -30,6 +30,7 @@ #:use-module (chickadee render texture) #:use-module (chickadee render buffer) #:use-module (chickadee render viewport) + #:use-module (srfi srfi-9) #:export (current-viewport current-framebuffer current-blend-mode @@ -47,43 +48,55 @@ gpu-apply/instanced* gpu-apply/instanced)) -(define *current-viewport* null-viewport) -(define *current-framebuffer* null-framebuffer) -(define *current-blend-mode* 'replace) -(define *current-depth-test* #f) -(define *current-projection* (make-identity-matrix4)) -(define *current-textures* (make-vector 32 null-texture)) +(define-record-type <render-context> + (make-render-context viewport framebuffer blend-mode depth-test? + projection textures) + render-context? + (viewport render-context-viewport set-render-context-viewport!) + (framebuffer render-context-framebuffer set-render-context-framebuffer!) + (blend-mode render-context-blend-mode set-render-context-blend-mode!) + (depth-test? render-context-depth-test? set-render-context-depth-test!) + (projection render-context-projection set-render-context-projection!) + (textures render-context-textures)) + +(define render-context + (make-render-context null-viewport + null-framebuffer + 'replace + #f + (make-identity-matrix4) + (make-vector 32 null-texture))) (define (current-viewport) - *current-viewport*) + (render-context-viewport render-context)) (define (current-framebuffer) - *current-framebuffer*) + (render-context-framebuffer render-context)) (define (current-blend-mode) - *current-blend-mode*) + (render-context-blend-mode render-context)) (define (current-depth-test) - *current-depth-test*) + (render-context-depth-test? render-context)) (define (current-texture i) - (vector-ref *current-textures* i)) + (vector-ref (render-context-textures render-context) i)) (define (current-projection) - *current-projection*) + (render-context-projection render-context)) -(define-syntax-rule (with (name value) body ...) - (let ((prev name)) - (dynamic-wind - (lambda () (set! name value)) - (lambda () body ...) - (lambda () (set! name prev))))) +(define-syntax-rule (with (getter setter value) body ...) + (let ((prev (getter render-context))) + (setter render-context value) + body ... + (setter render-context prev))) (define-syntax-rule (with-viewport viewport body ...) - (with (*current-viewport* viewport) body ...)) + (with (render-context-viewport set-render-context-viewport! viewport) + body ...)) (define-syntax-rule (with-framebuffer framebuffer body ...) - (with (*current-framebuffer* framebuffer) + (with (render-context-framebuffer set-render-context-framebuffer! framebuffer) ;; As a convenience, initialize the viewport and projection ;; matrix as well so that the user doesn't have to explicitly ;; make a viewport and/or projection matrix unless they @@ -93,54 +106,24 @@ body ...)))) (define-syntax-rule (with-blend-mode blend-mode body ...) - (with (*current-blend-mode* blend-mode) body ...)) + (with (render-context-blend-mode set-render-context-blend-mode! blend-mode) + body ...)) (define-syntax-rule (with-depth-test depth-test body ...) - (with (*current-depth-test* depth-test) body ...)) + (with (render-context-depth-test? set-render-context-depth-test! depth-test) + body ...)) (define-syntax-rule (with-texture n texture body ...) - (let ((prev (vector-ref *current-textures* n))) + (let* ((textures (render-context-textures render-context)) + (prev (vector-ref textures n))) (dynamic-wind - (lambda () (vector-set! *current-textures* n texture)) + (lambda () (vector-set! textures n texture)) (lambda () body ...) - (lambda () (vector-set! *current-textures* n prev))))) - -(define-syntax-rule (with-shader shader body ...) - (with (*current-shader* shader) - (initialize-uniforms) - body ...)) - -(define-syntax-rule (with-vertex-array vertex-array body ...) - (with (*current-vertex-array* vertex-array) body ...)) + (lambda () (vector-set! textures n prev))))) (define-syntax-rule (with-projection matrix body ...) - (with (*current-projection* matrix) body ...)) - -;; (define (initialize-uniforms) -;; (hash-for-each (lambda (name uniform) -;; (unless (hash-get-handle *current-uniforms* name) -;; (hash-set! *current-uniforms* name -;; (uniform-default-value uniform)))) -;; (shader-uniforms *current-shader*))) - -;; (define-syntax uniform-let -;; (syntax-rules () -;; ((_ () body ...) (begin body ...)) -;; ((_ ((name value) . rest) body ...) -;; (let ((uniform (shader-uniform (current-shader) name)) -;; (prev (hash-ref *current-uniforms* name))) -;; (if uniform -;; (dynamic-wind -;; (lambda () -;; (hash-set! *current-uniforms* name value)) -;; (lambda () -;; (uniform-let rest body ...)) -;; (lambda () -;; (hash-set! *current-uniforms* name prev))) -;; (error "no such uniform: " name)))))) - -;; (define (uniform-ref name) -;; (uniform-value (shader-uniform (current-shader) name))) + (with (render-context-projection set-render-context-projection! matrix) + body ...)) (define (keyword->string kw) (symbol->string (keyword->symbol kw))) |