diff options
Diffstat (limited to 'chickadee/render.scm')
-rw-r--r-- | chickadee/render.scm | 135 |
1 files changed, 135 insertions, 0 deletions
diff --git a/chickadee/render.scm b/chickadee/render.scm new file mode 100644 index 0000000..d55c76e --- /dev/null +++ b/chickadee/render.scm @@ -0,0 +1,135 @@ +;;; Chickadee Game Toolkit +;;; Copyright © 2016 David Thompson <davet@gnu.org> +;;; +;;; Chickadee is free software: you can redistribute it and/or modify +;;; it under the terms of the GNU General Public License as published +;;; by the Free Software Foundation, either version 3 of the License, +;;; or (at your option) any later version. +;;; +;;; Chickadee is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;; General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with this program. If not, see +;;; <http://www.gnu.org/licenses/>. + +;;; Commentary: +;; +;; High-level rendering API. +;; +;;; Code: + +(define-module (chickadee render) + #:use-module (srfi srfi-88) + #:use-module (chickadee math matrix) + #:use-module (chickadee render gpu) + #:use-module (chickadee render blend) + #:use-module (chickadee render shader) + #:use-module (chickadee render texture) + #:use-module (chickadee render vertex-buffer) + #:export (current-blend-mode + current-depth-test + current-texture + current-projection + with-blend-mode + with-depth-test + with-texture + with-projection + gpu-apply + gpu-apply*)) + +(define *current-blend-mode* 'replace) +(define *current-depth-test* #f) +(define *current-texture* null-texture) +(define *current-projection* (make-identity-matrix4)) + +(define (current-blend-mode) + *current-blend-mode*) + +(define (current-depth-test) + *current-depth-test*) + +(define (current-texture) + *current-texture*) + +(define (current-projection) + *current-projection*) + +(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-blend-mode blend-mode body ...) + (with (*current-blend-mode* blend-mode) body ...)) + +(define-syntax-rule (with-depth-test depth-test body ...) + (with (*current-depth-test* depth-test) body ...)) + +(define-syntax-rule (with-texture texture body ...) + (with (*current-texture* texture) body ...)) + +(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 ...)) + +(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))) + +(define-syntax uniform-apply + (lambda (x) + (syntax-case x () + ((_ shader ()) (datum->syntax x #t)) + ((_ shader (name value . rest)) + (with-syntax ((sname (datum->syntax x (keyword->string + (syntax->datum #'name))))) + #'(begin + (set-uniform-value! (shader-uniform shader sname) value) + (uniform-apply shader rest))))))) + +(define-syntax-rule (gpu-apply* shader vertex-array count . uniforms) + (begin + (gpu-state-set! *blend-mode-state* (current-blend-mode)) + (gpu-state-set! *depth-test-state* (current-depth-test)) + (gpu-state-set! *texture-state* (current-texture)) + (gpu-state-set! *shader-state* shader) + (gpu-state-set! *vertex-array-state* vertex-array) + (uniform-apply shader uniforms) + (render-vertices count))) + +(define-syntax-rule (gpu-apply shader vertex-array uniforms ...) + (gpu-apply* shader vertex-array #f uniforms ...)) |