summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDavid Thompson <dthompson2@worcester.edu>2021-01-21 19:29:46 -0500
committerDavid Thompson <dthompson2@worcester.edu>2021-01-26 17:12:02 -0500
commitaa45ad29efab50318d38bfd096b07021c4c7bde6 (patch)
treecb4f2347e94aa257a7906945bb5b1c389a22c93b
parent578de9a16d58385f4e9926c7c0effae6127c9270 (diff)
graphics: Rewrite rendering engine.
-rw-r--r--.dir-locals.el2
-rw-r--r--Makefile.am6
-rw-r--r--chickadee.scm21
-rw-r--r--chickadee/graphics.scm252
-rw-r--r--chickadee/graphics/blend.scm13
-rw-r--r--chickadee/graphics/buffer.scm261
-rw-r--r--chickadee/graphics/color.scm14
-rw-r--r--chickadee/graphics/depth.scm16
-rw-r--r--chickadee/graphics/engine.scm291
-rw-r--r--chickadee/graphics/font.scm7
-rw-r--r--chickadee/graphics/framebuffer.scm77
-rw-r--r--chickadee/graphics/gl.scm9
-rw-r--r--chickadee/graphics/gpu.scm248
-rw-r--r--chickadee/graphics/model.scm49
-rw-r--r--chickadee/graphics/multisample.scm37
-rw-r--r--chickadee/graphics/particles.scm150
-rw-r--r--chickadee/graphics/path.scm117
-rw-r--r--chickadee/graphics/pbr.scm39
-rw-r--r--chickadee/graphics/phong.scm45
-rw-r--r--chickadee/graphics/polygon.scm21
-rw-r--r--chickadee/graphics/shader.scm81
-rw-r--r--chickadee/graphics/sprite.scm363
-rw-r--r--chickadee/graphics/stencil.scm13
-rw-r--r--chickadee/graphics/texture.scm111
-rw-r--r--chickadee/graphics/tiled.scm3
-rw-r--r--chickadee/graphics/viewport.scm29
-rw-r--r--doc/api.texi30
-rw-r--r--examples/grid.scm1
-rw-r--r--examples/model.scm5
-rw-r--r--examples/particles.scm1
-rw-r--r--examples/sprite-batch.scm1
31 files changed, 1121 insertions, 1192 deletions
diff --git a/.dir-locals.el b/.dir-locals.el
index aca7480..f255f96 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -24,6 +24,8 @@
(eval . (put 'with-transform 'scheme-indent-function 1))
(eval . (put 'with-geometry 'scheme-indent-function 1))
(eval . (put 'with-geometry* 'scheme-indent-function 2))
+ (eval . (put 'with-graphics-state 'scheme-indent-function 1))
+ (eval . (put 'with-graphics-state! 'scheme-indent-function 1))
(eval . (put 'translate 'scheme-indent-function 1))
(eval . (put 'rotate 'scheme-indent-function 1))
(eval . (put 'scale 'scheme-indent-function 1)))))
diff --git a/Makefile.am b/Makefile.am
index 510e9fd..998c378 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -61,19 +61,19 @@ SOURCES = \
chickadee/audio/vorbis.scm \
chickadee/audio/wav.scm \
chickadee/audio.scm \
- chickadee/graphics/color.scm \
chickadee/graphics/gl.scm \
- chickadee/graphics/gpu.scm \
+ chickadee/graphics/engine.scm \
+ chickadee/graphics/color.scm \
chickadee/graphics/blend.scm \
chickadee/graphics/polygon.scm \
chickadee/graphics/depth.scm \
chickadee/graphics/stencil.scm \
+ chickadee/graphics/multisample.scm \
chickadee/graphics/texture.scm \
chickadee/graphics/shader.scm \
chickadee/graphics/buffer.scm \
chickadee/graphics/viewport.scm \
chickadee/graphics/framebuffer.scm \
- chickadee/graphics.scm \
chickadee/graphics/sprite.scm \
chickadee/graphics/font.scm \
chickadee/graphics/tiled.scm \
diff --git a/chickadee.scm b/chickadee.scm
index 3b6d6fd..82eb1b4 100644
--- a/chickadee.scm
+++ b/chickadee.scm
@@ -1,5 +1,5 @@
;;; Chickadee Game Toolkit
-;;; Copyright © 2018 David Thompson <davet@gnu.org>
+;;; Copyright © 2018, 2021 David Thompson <davet@gnu.org>
;;; Copyright © 2020 Peter Elliott <pelliott@ualberta.ca>
;;;
;;; Chickadee is free software: you can redistribute it and/or modify
@@ -27,10 +27,9 @@
#:use-module (chickadee config)
#:use-module (chickadee game-loop)
#:use-module (chickadee math matrix)
- #:use-module (chickadee graphics)
#:use-module (chickadee graphics color)
+ #:use-module (chickadee graphics engine)
#:use-module (chickadee graphics gl)
- #:use-module (chickadee graphics gpu)
#:use-module (chickadee graphics viewport)
#:use-module (chickadee utils)
#:use-module (gl)
@@ -281,15 +280,11 @@ border is disabled, otherwise it is enabled.")
#:height window-height
#:fullscreen? window-fullscreen?
#:multisample? #f)))
- (gpu (make-gpu (window-gl-context window)))
+ (gfx (make-graphics-engine (window-gl-context window)))
(default-viewport (make-viewport 0 0 window-width window-height))
(default-projection (orthographic-projection 0 window-width
window-height 0
- 0 1))
- (clear-mask (logior (attrib-mask color-buffer)
- (attrib-mask depth-buffer)
- (attrib-mask stencil-buffer)
- (attrib-mask accum-buffer))))
+ 0 1)))
(define (invert-y y)
;; SDL's origin is the top-left, but our origin is the bottom
;; left so we need to invert Y coordinates that SDL gives us.
@@ -363,10 +358,10 @@ border is disabled, otherwise it is enabled.")
;; that were queued to play this frame start playing immediately.
(update-audio)
;; Free any GPU resources that have been GC'd.
- (gpu-reap! gpu))
+ (graphics-engine-reap! gfx))
(define (render-sdl-opengl alpha)
- (with-viewport default-viewport
- (clear-screen)
+ (with-graphics-state! ((viewport default-viewport))
+ (clear-viewport)
(with-projection default-projection
(draw alpha)))
(sdl2:swap-gl-window (unwrap-window window)))
@@ -374,7 +369,7 @@ border is disabled, otherwise it is enabled.")
(const #t)
(lambda ()
(parameterize ((current-window window)
- (current-gpu gpu))
+ (current-graphics-engine gfx))
;; Attempt to activate vsync, if possible. Some systems do
;; not support setting the OpenGL swap interval.
(catch #t
diff --git a/chickadee/graphics.scm b/chickadee/graphics.scm
deleted file mode 100644
index 67abacb..0000000
--- a/chickadee/graphics.scm
+++ /dev/null
@@ -1,252 +0,0 @@
-;;; 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 graphics)
- #:use-module (chickadee math matrix)
- #:use-module (chickadee graphics blend)
- #:use-module (chickadee graphics buffer)
- #:use-module (chickadee graphics color)
- #:use-module (chickadee graphics framebuffer)
- #:use-module (chickadee graphics gpu)
- #:use-module (chickadee graphics polygon)
- #:use-module (chickadee graphics shader)
- #:use-module (chickadee graphics texture)
- #:use-module (chickadee graphics viewport)
- #:use-module (srfi srfi-9)
- #:export (current-viewport
- current-framebuffer
- current-blend-mode
- current-polygon-mode
- current-cull-face-mode
- current-depth-test
- current-stencil-test
- current-texture
- current-projection
- current-multisample
- current-color-mask
- with-viewport
- with-framebuffer
- with-blend-mode
- with-polygon-mode
- with-cull-face-mode
- with-depth-test
- with-stencil-test
- with-texture
- with-projection
- with-multisample
- with-color-mask
- clear-screen
- gpu-apply
- gpu-apply*
- gpu-apply/instanced*
- gpu-apply/instanced))
-
-(define-record-type <render-context>
- (make-render-context viewport framebuffer blend-mode polygon-mode
- cull-face-mode depth-test stencil-test projection
- multisample? color-mask 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!)
- (polygon-mode render-context-polygon-mode set-render-context-polygon-mode!)
- (cull-face-mode render-context-cull-face-mode set-render-context-cull-face-mode!)
- (depth-test render-context-depth-test set-render-context-depth-test!)
- (stencil-test render-context-stencil-test set-render-context-stencil-test!)
- (projection render-context-projection set-render-context-projection!)
- (multisample? render-context-multisample? set-render-context-multisample!)
- (color-mask render-context-color-mask set-render-context-color-mask!)
- (textures render-context-textures))
-
-(define render-context
- (make-render-context null-viewport
- null-framebuffer
- 'replace
- fill-polygon-mode
- back-cull-face-mode
- #f
- #f
- (make-identity-matrix4)
- #f
- default-color-mask
- (make-vector 32 null-texture)))
-
-(define (current-viewport)
- (render-context-viewport render-context))
-
-(define (current-framebuffer)
- (render-context-framebuffer render-context))
-
-(define (current-blend-mode)
- (render-context-blend-mode render-context))
-
-(define (current-polygon-mode)
- (render-context-polygon-mode render-context))
-
-(define (current-cull-face-mode)
- (render-context-cull-face-mode render-context))
-
-(define (current-depth-test)
- (render-context-depth-test render-context))
-
-(define (current-stencil-test)
- (render-context-stencil-test render-context))
-
-(define (current-texture i)
- (vector-ref (render-context-textures render-context) i))
-
-(define (current-projection)
- (render-context-projection render-context))
-
-(define (current-multisample)
- (render-context-multisample? render-context))
-
-(define (current-color-mask)
- (render-context-color-mask render-context))
-
-(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 (render-context-viewport set-render-context-viewport! viewport)
- body ...))
-
-(define (clear-screen)
- (let ((viewport (current-viewport)))
- (set-gpu-framebuffer! (current-gpu) (current-framebuffer))
- (set-gpu-viewport! (current-gpu) viewport)
- (clear-viewport viewport)))
-
-(define-syntax-rule (with-framebuffer framebuffer body ...)
- (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
- ;; actually want to do fancy viewport manipulations.
- (with-viewport (framebuffer-viewport framebuffer)
- (with-projection (framebuffer-projection framebuffer)
- body ...))))
-
-(define-syntax-rule (with-blend-mode blend-mode body ...)
- (with (render-context-blend-mode set-render-context-blend-mode! blend-mode)
- body ...))
-
-(define-syntax-rule (with-polygon-mode polygon-mode body ...)
- (with (render-context-polygon-mode set-render-context-polygon-mode! polygon-mode)
- body ...))
-
-(define-syntax-rule (with-cull-face-mode cull-face-mode body ...)
- (with (render-context-cull-face-mode set-render-context-cull-face-mode! cull-face-mode)
- body ...))
-
-(define-syntax-rule (with-depth-test depth-test body ...)
- (with (render-context-depth-test set-render-context-depth-test! depth-test)
- body ...))
-
-(define-syntax-rule (with-stencil-test stencil-test body ...)
- (with (render-context-stencil-test set-render-context-stencil-test! stencil-test)
- body ...))
-
-(define-syntax-rule (with-texture n texture body ...)
- (let* ((textures (render-context-textures render-context))
- (prev (vector-ref textures n)))
- (dynamic-wind
- (lambda () (vector-set! textures n texture))
- (lambda () body ...)
- (lambda () (vector-set! textures n prev)))))
-
-(define-syntax-rule (with-projection matrix body ...)
- (with (render-context-projection set-render-context-projection! matrix)
- body ...))
-
-(define-syntax-rule (with-multisample multisample? body ...)
- (with (render-context-multisample? set-render-context-multisample! multisample?)
- body ...))
-
-(define-syntax-rule (with-color-mask color-mask body ...)
- (with (render-context-color-mask set-render-context-color-mask! color-mask)
- body ...))
-
-(define (keyword->string kw)
- (symbol->string (keyword->symbol kw)))
-
-(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->symbol
- (syntax->datum #'name)))))
- #'(begin
- (shader-uniform-set! shader 'sname value)
- (uniform-apply shader rest)))))))
-
-(define-syntax-rule (gpu-prepare shader vertex-array uniforms)
- (let ((gpu (current-gpu)))
- ;; It's important that the framebuffer is set before setting the
- ;; viewport because applying a new viewport will clear the current
- ;; framebuffer.
- (set-gpu-framebuffer! gpu (current-framebuffer))
- (set-gpu-viewport! gpu (current-viewport))
- (set-gpu-blend-mode! gpu (current-blend-mode))
- (set-gpu-polygon-mode! gpu (current-polygon-mode))
- (set-gpu-cull-face-mode! gpu (current-cull-face-mode))
- (set-gpu-depth-test! gpu (current-depth-test))
- (set-gpu-stencil-test! gpu (current-stencil-test))
- (set-gpu-multisample! gpu (current-multisample))
- (set-gpu-color-mask! gpu (current-color-mask))
- (set-gpu-shader! gpu shader)
- (let loop ((i 0))
- (when (< i 32)
- (set-gpu-texture! gpu i (current-texture i))
- (loop (1+ i))))
- (uniform-apply shader uniforms)
- ;; Sampler2D values aren't explicitly passed as uniform values via
- ;; gpu-apply, so we have to bind them to the proper texture units
- ;; behind the scenes.
- (shader-uniform-for-each
- (lambda (uniform)
- (when (eq? (uniform-type uniform) sampler-2d)
- (set-uniform-value! shader uniform (uniform-value uniform))))
- shader)))
-
-(define-syntax-rule (gpu-apply* shader vertex-array offset count . uniforms)
- (begin
- (gpu-prepare shader vertex-array uniforms)
- (render-vertices vertex-array #:count count #:offset offset)))
-
-(define-syntax-rule (gpu-apply shader vertex-array uniforms ...)
- (gpu-apply* shader vertex-array 0 #f uniforms ...))
-
-(define-syntax-rule (gpu-apply/instanced* shader vertex-array offset count instances .
- uniforms)
- (begin
- (gpu-prepare shader vertex-array uniforms)
- (render-vertices/instanced vertex-array instances #:count count #:offset offset)))
-
-(define-syntax-rule (gpu-apply/instanced shader vertex-array instances
- uniforms ...)
- (gpu-apply/instanced* shader vertex-array 0 #f instances uniforms ...))
diff --git a/chickadee/graphics/blend.scm b/chickadee/graphics/blend.scm
index 465a449..a189210 100644
--- a/chickadee/graphics/blend.scm
+++ b/chickadee/graphics/blend.scm
@@ -1,5 +1,5 @@
;;; Chickadee Game Toolkit
-;;; Copyright © 2016 David Thompson <davet@gnu.org>
+;;; Copyright © 2016, 2021 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
@@ -18,11 +18,11 @@
(define-module (chickadee graphics blend)
#:use-module (ice-9 match)
#:use-module (gl)
+ #:use-module (chickadee graphics engine)
#:use-module (chickadee graphics gl)
- #:use-module (chickadee graphics gpu)
- #:export (apply-blend-mode))
+ #:export (current-blend-mode))
-(define (apply-blend-mode blend-mode)
+(define (bind-blend-mode blend-mode)
(if blend-mode
(begin
(gl-enable (enable-cap blend))
@@ -61,3 +61,8 @@
(gl-blend-func (blending-factor-src one)
(blending-factor-dest zero)))))
(gl-disable (enable-cap blend))))
+
+(define-graphics-state blend-mode
+ current-blend-mode
+ #:default 'replace
+ #:bind bind-blend-mode)
diff --git a/chickadee/graphics/buffer.scm b/chickadee/graphics/buffer.scm
index 66609a2..f5ec8c6 100644
--- a/chickadee/graphics/buffer.scm
+++ b/chickadee/graphics/buffer.scm
@@ -1,5 +1,5 @@
;;; Chickadee Game Toolkit
-;;; Copyright © 2016, 2017, 2019, 2020 David Thompson <davet@gnu.org>
+;;; Copyright © 2016-2021 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
@@ -24,7 +24,6 @@
(define-module (chickadee graphics buffer)
#:use-module (ice-9 format)
#:use-module (ice-9 match)
- #:use-module (oop goops)
#:use-module (rnrs bytevectors)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-4)
@@ -35,10 +34,9 @@
#:use-module (chickadee math matrix)
#:use-module (chickadee math vector)
#:use-module (chickadee graphics color)
+ #:use-module (chickadee graphics engine)
#:use-module (chickadee graphics gl)
- #:use-module (chickadee graphics gpu)
#:export (make-buffer
- make-streaming-buffer
buffer?
index-buffer?
buffer-mapped?
@@ -49,11 +47,10 @@
buffer-usage
buffer-data
null-buffer
- apply-buffer
+ current-buffer
map-buffer!
unmap-buffer!
resize-buffer!
- with-mapped-buffer
make-dynamic-buffer
dynamic-buffer?
@@ -68,7 +65,6 @@
dynamic-buffer-import!
make-buffer-view
- make-streaming-buffer-view
buffer-view?
buffer-view->buffer
buffer-view-name
@@ -84,12 +80,12 @@
buffer-view-divisor
make-vertex-array
- apply-vertex-array
vertex-array?
vertex-array-indices
vertex-array-attributes
vertex-array-mode
null-vertex-array
+ current-vertex-array
render-vertices
render-vertices/instanced
@@ -142,18 +138,26 @@
(define null-buffer
(%make-buffer 0 "null" 0 0 'vertex 'static #f))
-(define <<buffer>> (class-of null-buffer))
-
(define (free-buffer buffer)
(gl-delete-buffers 1 (u32vector (buffer-id buffer))))
-(define-method (gpu-finalize (buffer <<buffer>>))
- (free-buffer buffer))
-
(define (apply-buffer buffer)
(gl-bind-buffer (buffer-target-gl buffer)
(buffer-id buffer)))
+(define (bind-buffer buffer)
+ (gl-bind-buffer (buffer-target-gl buffer)
+ (buffer-id buffer)))
+
+(define-graphics-finalizer buffer-finalizer
+ #:predicate buffer?
+ #:free free-buffer)
+
+(define-graphics-state buffer
+ current-buffer
+ #:default null-buffer
+ #:bind bind-buffer)
+
(define (generate-buffer-gl)
(let ((bv (u32vector 1)))
(gl-gen-buffers 1 (bytevector->pointer bv))
@@ -165,13 +169,13 @@
(define (buffer-usage-gl buffer)
(match (buffer-usage buffer)
- ('static (arb-vertex-buffer-object static-draw-arb))
- ('stream (arb-vertex-buffer-object stream-draw-arb))))
+ ('static (version-1-5 static-draw))
+ ('stream (version-1-5 stream-draw))))
(define (buffer-target-gl buffer)
(if (index-buffer? buffer)
- (arb-vertex-buffer-object element-array-buffer-arb)
- (arb-vertex-buffer-object array-buffer-arb)))
+ (version-1-5 element-array-buffer)
+ (version-1-5 array-buffer)))
(define* (make-buffer data #:key
(name "anonymous")
@@ -202,31 +206,23 @@ NAME is simply an arbitrary string for debugging purposes that is
never sent to the GPU."
;; Weird bugs will occur when creating a new vertex buffer while a
;; vertex array is bound.
- (set-gpu-vertex-array! (current-gpu) null-vertex-array)
- (let ((buffer (gpu-guard
- (%make-buffer (generate-buffer-gl)
- name
- length
- stride
- target
- usage
- #f))))
- (set-gpu-vertex-buffer! (current-gpu) buffer)
- (gl-buffer-data (buffer-target-gl buffer)
- length
- (if data
- (bytevector->pointer data offset)
- %null-pointer)
- (buffer-usage-gl buffer))
- (set-gpu-vertex-buffer! (current-gpu) null-buffer)
- buffer))
-
-(define* (make-streaming-buffer length #:key
- (name "anonymous")
- (target 'vertex))
- "Return a new vertex buffer of LENGTH bytes, named NAME, suitable
-for streaming data to the GPU every frame."
- (make-buffer #f #:usage 'stream #:length length #:name name #:target target))
+ (with-graphics-state! ((vertex-array null-vertex-array))
+ (let ((buffer (%make-buffer (generate-buffer-gl)
+ name
+ length
+ stride
+ target
+ usage
+ #f)))
+ (graphics-engine-guard! buffer)
+ (with-graphics-state! ((buffer buffer))
+ (gl-buffer-data (buffer-target-gl buffer)
+ length
+ (if data
+ (bytevector->pointer data offset)
+ %null-pointer)
+ (buffer-usage-gl buffer)))
+ buffer)))
(define (buffer-mapped? buffer)
"Return #t if buffer data has been mapped from GPU."
@@ -240,22 +236,22 @@ vertex buffer data back to the GPU."
(unless (buffer-mapped? buffer) ;; Don't map a buffer that is already mapped!
(let ((target (buffer-target-gl buffer))
(length (buffer-length buffer)))
- (set-gpu-vertex-buffer! (current-gpu) buffer)
- (when (eq? (buffer-usage buffer) 'stream)
- ;; Orphan the buffer to avoid implicit synchronization.
- ;; See: https://www.opengl.org/wiki/Buffer_Object_Streaming#Buffer_re-specification
- (gl-buffer-data target length %null-pointer (buffer-usage-gl buffer)))
- (let ((ptr (gl-map-buffer target (match mode
- ('read-write (version-1-5 read-write))
- ('read-only (version-1-5 read-only))
- ('write-only (version-1-5 write-only))))))
- (set-buffer-data! buffer (pointer->bytevector ptr length))))))
+ (with-graphics-state! ((buffer buffer))
+ (when (eq? (buffer-usage buffer) 'stream)
+ ;; Orphan the buffer to avoid implicit synchronization.
+ ;; See: https://www.opengl.org/wiki/Buffer_Object_Streaming#Buffer_re-specification
+ (gl-buffer-data target length %null-pointer (buffer-usage-gl buffer)))
+ (let ((ptr (gl-map-buffer target (match mode
+ ('read-write (version-1-5 read-write))
+ ('read-only (version-1-5 read-only))
+ ('write-only (version-1-5 write-only))))))
+ (set-buffer-data! buffer (pointer->bytevector ptr length)))))))
(define (unmap-buffer! buffer)
"Return the mapped vertex buffer data for BUFFER to the GPU."
- (set-gpu-vertex-buffer! (current-gpu) buffer)
- (gl-unmap-buffer (buffer-target-gl buffer))
- (set-buffer-data! buffer #f))
+ (with-graphics-state! ((buffer buffer))
+ (gl-unmap-buffer (buffer-target-gl buffer))
+ (set-buffer-data! buffer #f)))
(define (resize-buffer! buffer length)
"Resize BUFFER to LENGTH bytes, preserving all existing mapped data
@@ -277,14 +273,6 @@ resized."
(bytevector-length new-bv)))))))
(error "cannot resize static buffer")))
-(define-syntax-rule (with-mapped-buffer buffer body ...)
- (dynamic-wind
- (lambda ()
- (map-buffer! buffer))
- (lambda () body ...)
- (lambda ()
- (unmap-buffer! buffer))))
-
;;;
;;; Dynamic Buffers
@@ -465,35 +453,6 @@ element is used for 2 instances, and so on."
(%make-buffer-view name buffer offset component-type
normalized? length type max min sparse divisor))
-(define* (make-streaming-buffer-view type component-type length #:key
- (name "anonymous")
- (target 'vertex)
- data
- (divisor 0))
- "Return a new typed buffer to hold LENGTH elements of TYPE whose
-components are comprised of COMPONENT-TYPE values. The underlying
-untyped buffer is configured for GPU streaming. Optonally, a NAME can
-be specified for the buffer. If the buffer will be used for instanced
-rendering, the DIVISOR argument must be used to specify the rate at
-which attributes advance when rendering multiple instances."
- (let* ((buffer-length
- (* length (type-size type) (component-type-size component-type)))
- (buffer (if data
- (make-buffer data
- #:name name
- #:length buffer-length
- #:usage 'stream
- #:target target)
- (make-streaming-buffer buffer-length
- #:name name
- #:target target))))
- (make-buffer-view #:name name
- #:buffer buffer
- #:type type
- #:component-type component-type
- #:length length
- #:divisor divisor)))
-
(define (display-buffer-view buffer-view port)
(format port "#<buffer-view name: ~s buffer: ~a type: ~s component-type: ~s length: ~d offset: ~d divisor: ~d>"
(buffer-view-name buffer-view)
@@ -524,20 +483,20 @@ which attributes advance when rendering multiple instances."
('double (data-type double))))
(define* (apply-buffer-view buffer-view #:optional attribute-index)
- (set-gpu-vertex-buffer! (current-gpu) (buffer-view->buffer buffer-view))
- ;; If there is no attribute-index, we assume this is being bound for
- ;; use as an index buffer.
- (when attribute-index
- (gl-enable-vertex-attrib-array attribute-index)
- (gl-vertex-attrib-pointer attribute-index
- (buffer-view-type-size buffer-view)
- (buffer-view-type-gl buffer-view)
- (buffer-view-normalized? buffer-view)
- (buffer-view-stride buffer-view)
- (make-pointer (buffer-view-offset buffer-view)))
- (let ((divisor (buffer-view-divisor buffer-view)))
- (when divisor
- (gl-vertex-attrib-divisor attribute-index divisor)))))
+ (with-graphics-state! ((buffer (buffer-view->buffer buffer-view)))
+ ;; If there is no attribute-index, we assume this is being bound for
+ ;; use as an index buffer.
+ (when attribute-index
+ (gl-enable-vertex-attrib-array attribute-index)
+ (gl-vertex-attrib-pointer attribute-index
+ (buffer-view-type-size buffer-view)
+ (buffer-view-type-gl buffer-view)
+ (buffer-view-normalized? buffer-view)
+ (buffer-view-stride buffer-view)
+ (make-pointer (buffer-view-offset buffer-view)))
+ (let ((divisor (buffer-view-divisor buffer-view)))
+ (when divisor
+ (gl-vertex-attrib-divisor attribute-index divisor))))))
;;;
@@ -562,8 +521,6 @@ which attributes advance when rendering multiple instances."
(define null-vertex-array (%make-vertex-array 0 #f '() 'triangles))
-(define <<vertex-array>> (class-of null-vertex-array))
-
(define (generate-vertex-array)
(let ((bv (u32vector 1)))
(gl-gen-vertex-arrays 1 (bytevector->pointer bv))
@@ -572,12 +529,21 @@ which attributes advance when rendering multiple instances."
(define (free-vertex-array va)
(gl-delete-vertex-arrays 1 (u32vector (vertex-array-id va))))
-(define-method (gpu-finalize (va <<vertex-array>>))
- (free-vertex-array va))
-
(define (apply-vertex-array va)
(gl-bind-vertex-array (vertex-array-id va)))
+(define (bind-vertex-array va)
+ (gl-bind-vertex-array (vertex-array-id va)))
+
+(define-graphics-finalizer vertex-array-finalizer
+ #:predicate vertex-array?
+ #:free free-vertex-array)
+
+(define-graphics-state vertex-array
+ current-vertex-array
+ #:default null-vertex-array
+ #:bind bind-vertex-array)
+
(define* (make-vertex-array #:key indices attributes (mode 'triangles))
"Return a new vertex array using the index data within the typed
buffer INDICES and the vertex attribute data within ATTRIBUTES, an
@@ -595,18 +561,19 @@ argument may be overridden. The following values are supported:
- triangles
- triangle-strip
- triangle-fan"
- (let ((array (gpu-guard
- (%make-vertex-array (generate-vertex-array)
- indices
- attributes
- mode))))
- (set-gpu-vertex-array! (current-gpu) array)
- (for-each (match-lambda
- ((index . buffer-view)
- (apply-buffer-view buffer-view index)))
- attributes)
- (when indices (apply-buffer-view indices))
- (set-gpu-vertex-array! (current-gpu) null-vertex-array)
+ (let ((array (%make-vertex-array (generate-vertex-array)
+ indices
+ attributes
+ mode)))
+ (graphics-engine-guard! array)
+ (with-graphics-state! ((vertex-array array))
+ (for-each (match-lambda
+ ((index . buffer-view)
+ (apply-buffer-view buffer-view index)))
+ attributes)
+ (when indices (apply-buffer-view indices)))
+ ;; Restore the old array. Is this needed?
+ ;; (graphics-engine-commit!)
array))
(define (vertex-array-mode-gl array)
@@ -620,32 +587,32 @@ argument may be overridden. The following values are supported:
('triangle-fan (begin-mode triangle-fan))))
(define* (render-vertices array #:key count (offset 0))
- (set-gpu-vertex-array! (current-gpu) array)
- (let ((indices (vertex-array-indices array)))
- (if indices
- (begin
- (apply-buffer-view indices)
- (gl-draw-elements (vertex-array-mode-gl array)
- (or count
- (buffer-view-length indices))
- (buffer-view-type-gl indices)
- %null-pointer))
- (gl-draw-arrays (vertex-array-mode-gl array) offset count))))
+ (with-graphics-state! ((vertex-array array))
+ (let ((indices (vertex-array-indices array)))
+ (if indices
+ (begin
+ (apply-buffer-view indices)
+ (gl-draw-elements (vertex-array-mode-gl array)
+ (or count
+ (buffer-view-length indices))
+ (buffer-view-type-gl indices)
+ %null-pointer))
+ (gl-draw-arrays (vertex-array-mode-gl array) offset count)))))
(define* (render-vertices/instanced array instances #:key count (offset 0))
- (set-gpu-vertex-array! (current-gpu) array)
- (let ((indices (vertex-array-indices array)))
- (if indices
- (begin
- (apply-buffer-view indices)
- (gl-draw-elements-instanced (vertex-array-mode-gl array)
- (or count
- (buffer-view-length indices))
- (buffer-view-type-gl indices)
- %null-pointer
- instances))
- (gl-draw-arrays-instanced (vertex-array-mode-gl array)
- offset count instances))))
+ (with-graphics-state! ((vertex-array array))
+ (let ((indices (vertex-array-indices array)))
+ (if indices
+ (begin
+ (apply-buffer-view indices)
+ (gl-draw-elements-instanced (vertex-array-mode-gl array)
+ (or count
+ (buffer-view-length indices))
+ (buffer-view-type-gl indices)
+ %null-pointer
+ instances))
+ (gl-draw-arrays-instanced (vertex-array-mode-gl array)
+ offset count instances)))))
;;;
diff --git a/chickadee/graphics/color.scm b/chickadee/graphics/color.scm
index e8026ba..e2766df 100644
--- a/chickadee/graphics/color.scm
+++ b/chickadee/graphics/color.scm
@@ -1,5 +1,5 @@
;;; Chickadee Game Toolkit
-;;; Copyright © 2016, 2018 David Thompson <davet@gnu.org>
+;;; Copyright © 2016, 2018, 2021 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
@@ -22,6 +22,7 @@
;;; Code:
(define-module (chickadee graphics color)
+ #:use-module (chickadee graphics engine)
#:use-module (chickadee graphics gl)
#:use-module (chickadee math)
#:use-module (ice-9 match)
@@ -115,12 +116,12 @@
default-color-mask
null-color-mask
+ current-color-mask
color-mask?
color-mask-red?
color-mask-green?
color-mask-blue?
- color-mask-alpha?
- apply-color-mask))
+ color-mask-alpha?))
(define-record-type <color>
(wrap-color bv)
@@ -350,8 +351,13 @@ a color object."
(define default-color-mask (make-color-mask #t #t #t #t))
(define null-color-mask (make-color-mask #f #f #f #f))
-(define (apply-color-mask mask)
+(define (bind-color-mask mask)
(gl-color-mask (color-mask-red? mask)
(color-mask-green? mask)
(color-mask-blue? mask)
(color-mask-alpha? mask)))
+
+(define-graphics-state color-mask
+ current-color-mask
+ #:default default-color-mask
+ #:bind bind-color-mask)
diff --git a/chickadee/graphics/depth.scm b/chickadee/graphics/depth.scm
index 8e622e4..a67d079 100644
--- a/chickadee/graphics/depth.scm
+++ b/chickadee/graphics/depth.scm
@@ -1,5 +1,5 @@
;;; Chickadee Game Toolkit
-;;; Copyright © 2020 David Thompson <davet@gnu.org>
+;;; Copyright © 2020, 2021 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
@@ -18,8 +18,8 @@
(define-module (chickadee graphics depth)
#:use-module (ice-9 match)
#:use-module (gl)
+ #:use-module (chickadee graphics engine)
#:use-module (chickadee graphics gl)
- #:use-module (chickadee graphics gpu)
#:use-module (srfi srfi-9)
#:export (make-depth-test
depth-test?
@@ -27,8 +27,7 @@
depth-test-function
depth-test-near
depth-test-far
- default-depth-test
- apply-depth-test))
+ current-depth-test))
(define-record-type <depth-test>
(%make-depth-test write? function near far)
@@ -41,9 +40,7 @@
(define* (make-depth-test #:key (write? #t) (function 'less-than) (near 0.0) (far 1.0))
(%make-depth-test write? function near far))
-(define default-depth-test (make-depth-test))
-
-(define (apply-depth-test depth-test)
+(define (bind-depth-test depth-test)
(if depth-test
(let ((glfunc (match (depth-test-function depth-test)
('always (depth-function always))
@@ -59,3 +56,8 @@
(gl-depth-mask (depth-test-write? depth-test))
(gl-depth-range (depth-test-near depth-test) (depth-test-far depth-test)))
(gl-disable (enable-cap depth-test))))
+
+(define-graphics-state depth-test
+ current-depth-test
+ #:default #f
+ #:bind bind-depth-test)
diff --git a/chickadee/graphics/engine.scm b/chickadee/graphics/engine.scm
new file mode 100644
index 0000000..5c5b403
--- /dev/null
+++ b/chickadee/graphics/engine.scm
@@ -0,0 +1,291 @@
+(define-module (chickadee graphics engine)
+ #:use-module (chickadee graphics gl)
+ #:use-module (chickadee math matrix)
+ #:use-module (gl)
+ #:use-module (ice-9 atomic)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-9)
+ #:use-module (system foreign)
+ #:export (define-graphics-state
+ define-graphics-finalizer
+ define-graphics-variable
+ make-graphics-engine
+ graphics-engine?
+ graphics-engine-gl-context
+ graphics-engine-gl-version
+ graphics-engine-glsl-version
+ graphics-engine-max-texture-size
+ graphics-engine-state-ref
+ graphics-variable-ref
+ graphics-variable-set!
+ graphics-engine-commit!
+ graphics-engine-guard!
+ graphics-engine-reap!
+ current-graphics-engine
+ current-projection
+ with-projection
+ with-graphics-state
+ with-graphics-state!))
+
+
+;;;
+;;; States
+;;;
+
+;; A "graphics state" is CPU-side storage for GPU-side state. The
+;; goal is to track changes and minimize the number of GPU state
+;; changes (because they are expensive) by only communicating with the
+;; GPU when the value really needs updating.
+
+(define-record-type <graphics-state-spec>
+ (%make-graphics-state-spec name default binder)
+ graphics-state-spec?
+ (name graphics-state-spec-name)
+ (default graphics-state-spec-default)
+ (binder graphics-state-spec-binder))
+
+(define* (make-graphics-state-spec name #:key default bind)
+ (%make-graphics-state-spec name default bind))
+
+(define-record-type <graphics-state>
+ (%make-graphics-state binder value bound-value dirty?)
+ graphics-state?
+ (binder graphics-state-binder)
+ (value graphics-state-ref %graphics-state-set!)
+ (bound-value graphics-state-bound-value set-graphics-state-bound-value!)
+ (dirty? graphics-state-dirty? set-graphics-state-dirty!))
+
+(define (make-graphics-state bind default)
+ (%make-graphics-state bind default default #f))
+
+(define (graphics-state-set! state new-value)
+ (let ((current-value (graphics-state-bound-value state)))
+ (%graphics-state-set! state new-value)
+ (set-graphics-state-dirty! state (not (eq? new-value current-value)))))
+
+(define (graphics-state-bind-maybe state)
+ (when (graphics-state-dirty? state)
+ (let ((x (graphics-state-ref state)))
+ ((graphics-state-binder state) x)
+ (set-graphics-state-bound-value! state x)
+ (set-graphics-state-dirty! state #f))))
+
+(define *graphics-states* (make-hash-table))
+
+(define-syntax-rule (define-graphics-state name getter args ...)
+ (begin
+ (define name
+ (let ((spec (make-graphics-state-spec 'name args ...)))
+ (hashq-set! *graphics-states* 'name spec)
+ spec))
+ (define* (getter #:optional (engine (current-graphics-engine)))
+ (graphics-engine-state-ref 'name engine))))
+
+
+;;;
+;;; Finalizers
+;;;
+
+;; Graphics finalizers delete GPU-side resources when Guile is ready
+;; to GC them.
+
+(define-record-type <graphics-finalizer>
+ (%make-graphics-finalizer name predicate free)
+ graphics-finalizer?
+ (name graphics-finalizer-name)
+ (predicate graphics-finalizer-predicate)
+ (free graphics-finalizer-free))
+
+(define* (make-graphics-finalizer name #:key predicate free)
+ (%make-graphics-finalizer name predicate free))
+
+;; Need to box this value so that the compiler doesn't inline the
+;; initial value everywhere.
+(define *graphics-finalizers* (make-atomic-box '()))
+
+(define-syntax-rule (define-graphics-finalizer name args ...)
+ (define name
+ (let ((finalizer (make-graphics-finalizer 'name args ...)))
+ (atomic-box-set! *graphics-finalizers*
+ (cons (cons 'name finalizer)
+ (atomic-box-ref *graphics-finalizers*)))
+ finalizer)))
+
+
+;;;
+;;; Variables
+;;;
+
+;; Graphics variables are a special type of variable storage that is
+;; dynamically scoped to the currently active graphics engine. Their
+;; initial values are lazily evaluated upon graphics engine creation.
+
+(define-record-type <graphics-variable>
+ (make-graphics-variable name init)
+ graphics-variable?
+ (name graphics-variable-name)
+ (init graphics-variable-init))
+
+(define (eval-graphics-variable var)
+ ((graphics-variable-init var)))
+
+(define *graphics-variables* (make-hash-table))
+
+(define-syntax-rule (define-graphics-variable name init-form)
+ (define name
+ (let ((var (make-graphics-variable 'name (lambda () init-form))))
+ (hashq-set! *graphics-variables* var var)
+ var)))
+
+
+;;;
+;;; Engine
+;;;
+
+(define-record-type <graphics-engine>
+ (%make-graphics-engine gl-context gl-version glsl-version max-texture-size
+ projection-matrix view-matrix mvp-matrix
+ guardian states modified-states variables)
+ graphics-engine?
+ (gl-context %graphics-engine-gl-context)
+ (gl-version %graphics-engine-gl-version)
+ (glsl-version %graphics-engine-glsl-version)
+ (max-texture-size %graphics-engine-max-texture-size)
+ (projection-matrix %graphics-engine-projection-matrix
+ %set-graphics-engine-projection-matrix!)
+ (view-matrix %graphics-engine-view-matrix
+ %set-graphics-engine-view-matrix!)
+ (mvp-matrix %graphics-engine-mvp-matrix)
+ (guardian graphics-engine-guardian)
+ (states graphics-engine-states)
+ (modified-states graphics-engine-modified-states)
+ (variables graphics-engine-variables))
+
+(define (make-graphics-engine gl-context)
+ (define (max-texture-size)
+ (let ((bv (make-s32vector 1)))
+ (gl-get-integer-v (get-p-name max-texture-size)
+ (bytevector->pointer bv))
+ (s32vector-ref bv 0)))
+ (define (extract-version attr)
+ (car (string-split (pointer->string (gl-get-string attr)) #\space)))
+ (define (glsl-version)
+ (extract-version (version-2-0 shading-language-version)))
+ (define (make-states)
+ (let ((table (make-hash-table)))
+ (hash-for-each (lambda (key spec)
+ (let ((binder (graphics-state-spec-binder spec))
+ (default (graphics-state-spec-default spec)))
+ (hashq-set! table
+ (graphics-state-spec-name spec)
+ (make-graphics-state binder default))))
+ *graphics-states*)
+ table))
+ (let* ((variables (make-hash-table))
+ (engine (%make-graphics-engine gl-context
+ (extract-version (string-name version))
+ (glsl-version)
+ (max-texture-size)
+ (make-identity-matrix4)
+ (make-identity-matrix4)
+ (make-null-matrix4)
+ (make-guardian)
+ (make-states)
+ (make-hash-table)
+ variables)))
+ ;; Variable initialization must be delayed until after engine
+ ;; creation because variable initializers may modify graphics
+ ;; engine state to create shaders, textures, etc.
+ (parameterize ((current-graphics-engine engine))
+ (hash-for-each (lambda (key var)
+ (hashq-set! variables var (eval-graphics-variable var)))
+ *graphics-variables*))
+ engine))
+
+(define current-graphics-engine (make-parameter #f))
+
+(define* (graphics-engine-gl-context #:optional (engine (current-graphics-engine)))
+ (%graphics-engine-gl-context engine))
+
+(define* (graphics-engine-gl-version #:optional (engine (current-graphics-engine)))
+ (%graphics-engine-gl-version engine))
+
+(define* (graphics-engine-glsl-version #:optional (engine (current-graphics-engine)))
+ (%graphics-engine-glsl-version engine))
+
+(define* (graphics-engine-max-texture-size #:optional (engine (current-graphics-engine)))
+ (%graphics-engine-max-texture-size engine))
+
+(define* (current-projection #:optional (engine (current-graphics-engine)))
+ (%graphics-engine-projection-matrix engine))
+
+(define-syntax-rule (with-projection matrix body ...)
+ (let ((old (current-projection)))
+ (set-graphics-engine-projection-matrix! matrix)
+ (let ((result (begin body ...)))
+ (set-graphics-engine-projection-matrix! old)
+ result)))
+
+(define* (set-graphics-engine-projection-matrix! matrix #:optional (engine (current-graphics-engine)))
+ (%set-graphics-engine-projection-matrix! engine matrix))
+
+(define* (graphics-engine-state-ref name #:optional
+ (engine (current-graphics-engine)))
+ (graphics-state-ref (hashq-ref (graphics-engine-states engine) name)))
+
+(define* (graphics-engine-state-set! name value #:optional
+ (engine (current-graphics-engine)))
+ (let ((state (hashq-ref (graphics-engine-states engine) name)))
+ (graphics-state-set! state value)
+ (hashq-set! (graphics-engine-modified-states engine)
+ name
+ #t)))
+
+(define* (graphics-variable-ref var #:optional
+ (engine (current-graphics-engine)))
+ (hashq-ref (graphics-engine-variables engine) var))
+
+(define* (graphics-variable-set! var value #:optional
+ (engine (current-graphics-engine)))
+ (hashq-set! (graphics-engine-variables engine) var value))
+
+(define* (graphics-engine-commit! #:optional (engine (current-graphics-engine)))
+ (let ((states (graphics-engine-states engine))
+ (modified-states (graphics-engine-modified-states engine)))
+ (hash-for-each (lambda (key value)
+ (graphics-state-bind-maybe (hashq-ref states key)))
+ modified-states)
+ (hash-clear! modified-states)))
+
+(define* (graphics-engine-guard! obj #:optional
+ (engine (current-graphics-engine)))
+ ((graphics-engine-guardian engine) obj))
+
+(define* (graphics-engine-reap! #:optional (engine (current-graphics-engine)))
+ (let ((guardian (graphics-engine-guardian engine)))
+ (let loop ((obj (guardian)))
+ (when obj
+ (let ((finalizer (find (lambda (f)
+ (let ((pred (graphics-finalizer-predicate f)))
+ (pred obj)))
+ (atomic-box-ref *graphics-finalizers*))))
+ (if finalizer
+ ((graphics-finalizer-free finalizer) obj)
+ (error "no finalizer for graphics engine object" obj)))
+ (loop (guardian))))))
+
+(define-syntax-rule (with-graphics-state ((name value) ...) body ...)
+ (let ((thunk (lambda ()
+ (graphics-engine-state-set! 'name value) ...
+ body ...))
+ (name (graphics-engine-state-ref 'name))
+ ...)
+ (let ((result (thunk)))
+ ;; Restore old values
+ (graphics-engine-state-set! 'name name) ...
+ result)))
+
+(define-syntax-rule (with-graphics-state! ((name value) ...) body ...)
+ (with-graphics-state ((name value) ...)
+ (graphics-engine-commit!)
+ body ...))
diff --git a/chickadee/graphics/font.scm b/chickadee/graphics/font.scm
index d022e86..c282c66 100644
--- a/chickadee/graphics/font.scm
+++ b/chickadee/graphics/font.scm
@@ -1,5 +1,5 @@
;;; Chickadee Game Toolkit
-;;; Copyright © 2017, 2020 David Thompson <davet@gnu.org>
+;;; Copyright © 2017, 2020, 2021 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
@@ -37,9 +37,8 @@
#:use-module (chickadee math matrix)
#:use-module (chickadee math rect)
#:use-module (chickadee math vector)
- #:use-module (chickadee graphics)
#:use-module (chickadee graphics color)
- #:use-module (chickadee graphics gpu)
+ #:use-module (chickadee graphics engine)
#:use-module (chickadee graphics shader)
#:use-module (chickadee graphics sprite)
#:use-module (chickadee graphics texture)
@@ -109,7 +108,7 @@ display it at POINT-SIZE. By default, the ASCII character is used."
(chars (make-hash-table))
(kernings (make-hash-table))
(batches (make-hash-table))
- (texture-size (min (gpu-max-texture-size (current-gpu)) 2048)))
+ (texture-size (min (graphics-engine-max-texture-size) 2048)))
;; TODO: Use actual screen DPI.
(set-char-size! face (* point-size 64) 0 96 96)
(let ((glyph (face-glyph-slot face))
diff --git a/chickadee/graphics/framebuffer.scm b/chickadee/graphics/framebuffer.scm
index 091ab3f..edf97a2 100644
--- a/chickadee/graphics/framebuffer.scm
+++ b/chickadee/graphics/framebuffer.scm
@@ -1,5 +1,5 @@
;;; Chickadee Game Toolkit
-;;; Copyright © 2017 David Thompson <davet@gnu.org>
+;;; Copyright © 2017, 2021 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
@@ -22,7 +22,6 @@
;;; Code:
(define-module (chickadee graphics framebuffer)
- #:use-module (oop goops)
#:use-module (ice-9 match)
#:use-module (srfi srfi-9)
#:use-module (system foreign)
@@ -30,8 +29,8 @@
#:use-module (gl enums)
#:use-module (chickadee math matrix)
#:use-module (chickadee graphics color)
+ #:use-module (chickadee graphics engine)
#:use-module (chickadee graphics gl)
- #:use-module (chickadee graphics gpu)
#:use-module ((chickadee graphics texture) #:select (make-texture null-texture))
#:use-module (chickadee graphics viewport)
#:export (make-framebuffer
@@ -40,7 +39,8 @@
framebuffer-viewport
framebuffer-projection
null-framebuffer
- apply-framebuffer))
+ current-framebuffer
+ with-framebuffer))
(define (generate-framebuffer)
"Generate a new OpenGL framebuffer object."
@@ -66,8 +66,6 @@
(define null-framebuffer
(%make-framebuffer 0 0 null-texture null-viewport (make-identity-matrix4)))
-(define <<framebuffer>> (class-of null-framebuffer))
-
(define (free-framebuffer framebuffer)
(gl-delete-renderbuffers 1
(bytevector->pointer
@@ -78,13 +76,23 @@
(u32vector
(framebuffer-id framebuffer)))))
-(define-method (gpu-finalize (framebuffer <<framebuffer>>))
- (free-framebuffer framebuffer))
-
(define (apply-framebuffer framebuffer)
(gl-bind-framebuffer (version-3-0 framebuffer)
(framebuffer-id framebuffer)))
+(define (bind-framebuffer framebuffer)
+ (gl-bind-framebuffer (version-3-0 framebuffer)
+ (framebuffer-id framebuffer)))
+
+(define-graphics-finalizer framebuffer-finalizer
+ #:predicate framebuffer?
+ #:free free-framebuffer)
+
+(define-graphics-state framebuffer
+ current-framebuffer
+ #:default null-framebuffer
+ #:bind bind-framebuffer)
+
(define %clear-color (transparency 0.0))
(define make-framebuffer
@@ -113,28 +121,39 @@ dimensions WIDTH x HEIGHT."
texture
viewport
projection)))
- (set-gpu-framebuffer! (current-gpu) framebuffer)
- ;; Setup depth buffer.
- (gl-bind-renderbuffer (version-3-0 renderbuffer)
- renderbuffer-id)
- (gl-renderbuffer-storage (version-3-0 renderbuffer)
- (pixel-format depth-component)
- width
- height)
- (gl-framebuffer-renderbuffer (version-3-0 framebuffer)
- (arb-framebuffer-object depth-attachment)
- (version-3-0 renderbuffer)
- renderbuffer-id)
- ;; Setup framebuffer.
- (gl-framebuffer-texture-2d (version-3-0 framebuffer)
- (version-3-0 color-attachment0)
- (texture-target texture-2d)
- ((@@ (chickadee graphics texture) texture-id)
- texture)
- 0)
- (gl-draw-buffers 1 (bytevector->pointer draw-buffers))
+ (graphics-engine-guard! framebuffer)
+ (with-graphics-state! ((framebuffer framebuffer))
+ ;; Setup depth buffer.
+ (gl-bind-renderbuffer (version-3-0 renderbuffer)
+ renderbuffer-id)
+ (gl-renderbuffer-storage (version-3-0 renderbuffer)
+ (pixel-format depth-component)
+ width
+ height)
+ (gl-framebuffer-renderbuffer (version-3-0 framebuffer)
+ (arb-framebuffer-object depth-attachment)
+ (version-3-0 renderbuffer)
+ renderbuffer-id)
+ ;; Setup framebuffer.
+ (gl-framebuffer-texture-2d (version-3-0 framebuffer)
+ (version-3-0 color-attachment0)
+ (texture-target texture-2d)
+ ((@@ (chickadee graphics texture) texture-id)
+ texture)
+ 0)
+ (gl-draw-buffers 1 (bytevector->pointer draw-buffers)))
;; Check for errors.
(unless (= (gl-check-framebuffer-status (version-3-0 framebuffer))
(version-3-0 framebuffer-complete))
(error "Framebuffer cannot be created"))
framebuffer))))
+
+(define-syntax-rule (with-framebuffer framebuffer body ...)
+ ;; 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 actually want to do
+ ;; fancy viewport manipulations.
+ (with-graphics-state ((framebuffer framebuffer)
+ (viewport (framebuffer-viewport framebuffer)))
+ (with-projection (framebuffer-projection framebuffer)
+ body ...)))
diff --git a/chickadee/graphics/gl.scm b/chickadee/graphics/gl.scm
index 739165f..2ba0ec2 100644
--- a/chickadee/graphics/gl.scm
+++ b/chickadee/graphics/gl.scm
@@ -1,5 +1,5 @@
;;; Chickadee Game Toolkit
-;;; Copyright © 2016 David Thompson <davet@gnu.org>
+;;; Copyright © 2016, 2021 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
@@ -337,3 +337,10 @@ object.")
(re-export (%glPolygonMode . gl-polygon-mode)
(%glCullFace . gl-cull-face)
(%glColorMask . gl-color-mask))
+
+
+;;;
+;;; Errors
+;;;
+
+(re-export (%glGetError . gl-get-error))
diff --git a/chickadee/graphics/gpu.scm b/chickadee/graphics/gpu.scm
deleted file mode 100644
index c5d4702..0000000
--- a/chickadee/graphics/gpu.scm
+++ /dev/null
@@ -1,248 +0,0 @@
-;;; Chickadee Game Toolkit
-;;; Copyright © 2016, 2019 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/>.
-
-(define-module (chickadee graphics gpu)
- #:use-module (chickadee graphics gl)
- #:use-module (gl)
- #:use-module (gl enums)
- #:use-module (oop goops)
- #:use-module (srfi srfi-9)
- #:use-module (system foreign)
- #:export (make-gpu-state
- gpu-state-ref
- gpu-state-set!
-
- gpu-finalize
- gpu-guard
- gpu-reap!
-
- make-gpu
- current-gpu
- gpu?
- gpu-gl-context
- gpu-gl-version
- gpu-glsl-version
- gpu-max-texture-size
- gpu-blend-mode
- gpu-polygon-mode
- gpu-cull-face-mode
- gpu-depth-test
- gpu-stencil-test
- gpu-framebuffer
- gpu-shader
- gpu-texture
- gpu-vertex-buffer
- gpu-vertex-array
- gpu-viewport
- gpu-multisample
- gpu-color-mask
- set-gpu-blend-mode!
- set-gpu-polygon-mode!
- set-gpu-cull-face-mode!
- set-gpu-depth-test!
- set-gpu-stencil-test!
- set-gpu-framebuffer!
- set-gpu-shader!
- set-gpu-texture!
- set-gpu-vertex-buffer!
- set-gpu-vertex-array!
- set-gpu-viewport!
- set-gpu-multisample!
- set-gpu-color-mask!))
-
-
-;;;
-;;; GPU state
-;;;
-
-(define-record-type <gpu-state>
- (make-gpu-state bind value)
- gpu-state?
- (bind gpu-state-bind)
- (value gpu-state-ref %gpu-state-set!))
-
-(define (gpu-state-set! state new-value)
- (unless (eq? new-value (gpu-state-ref state))
- ((gpu-state-bind state) new-value)
- (%gpu-state-set! state new-value)))
-
-
-;;;
-;;; GPU
-;;;
-
-(define-record-type <gpu>
- (%make-gpu gl-context
- gl-version
- glsl-version
- guardian
- max-texture-size
- blend-mode
- polygon-mode
- cull-face-mode
- depth-test
- stencil-test
- framebuffer
- shader
- textures
- vertex-buffer
- vertex-array
- viewport
- multisample
- color-mask)
- gpu?
- (gl-context gpu-gl-context)
- (gl-version gpu-gl-version)
- (glsl-version gpu-glsl-version)
- (guardian gpu-guardian)
- (max-texture-size gpu-max-texture-size)
- (blend-mode %gpu-blend-mode)
- (polygon-mode %gpu-polygon-mode)
- (cull-face-mode %gpu-cull-face-mode)
- (depth-test %gpu-depth-test)
- (stencil-test %gpu-stencil-test)
- (framebuffer %gpu-framebuffer)
- (shader %gpu-shader)
- (textures gpu-textures)
- (vertex-buffer %gpu-vertex-buffer)
- (vertex-array %gpu-vertex-array)
- (viewport %gpu-viewport)
- (multisample %gpu-multisample)
- (color-mask %gpu-color-mask))
-
-(define current-gpu (make-parameter #f))
-
-(define-generic gpu-finalize)
-
-(define (gpu-guard obj)
- "Protect OBJ for the garbage collector until OBJ has been deleted
-from the GPU's memory."
- ((gpu-guardian (current-gpu)) obj)
- obj)
-
-(define (gpu-reap! gpu)
- "Delete all GPU objects that are no longer being referenced."
- (let ((guardian (gpu-guardian gpu)))
- (let loop ((obj (guardian)))
- (when obj
- (gpu-finalize obj)
- (loop (guardian))))))
-
-(define (max-texture-size)
- (let ((bv (make-s32vector 1)))
- (gl-get-integer-v (get-p-name max-texture-size)
- (bytevector->pointer bv))
- (s32vector-ref bv 0)))
-
-(define (apply-multisample multisample?)
- (if multisample?
- (gl-enable (version-1-3 multisample))
- (gl-disable (version-1-3 multisample))))
-
-(define (make-gpu gl-context)
- (define (extract-version attr)
- (car (string-split (pointer->string (gl-get-string attr)) #\space)))
- (let ((textures (make-vector 32))
- ;; Lazily resolve bindings to avoid circular dependencies.
- (blend-module (resolve-interface '(chickadee graphics blend)))
- (polygon-module (resolve-interface '(chickadee graphics polygon)))
- (depth-module (resolve-interface '(chickadee graphics depth)))
- (stencil-module (resolve-interface '(chickadee graphics stencil)))
- (buffer-module (resolve-interface '(chickadee graphics buffer)))
- (framebuffer-module (resolve-interface '(chickadee graphics framebuffer)))
- (shader-module (resolve-interface '(chickadee graphics shader)))
- (texture-module (resolve-interface '(chickadee graphics texture)))
- (viewport-module (resolve-interface '(chickadee graphics viewport)))
- (color-module (resolve-interface '(chickadee graphics color)))
- (gl-version (extract-version (string-name version)))
- (glsl-version (extract-version (version-2-0 shading-language-version))))
- ;; Create state for 32 texture units.
- (let loop ((i 0))
- (when (< i 32)
- (vector-set! textures i
- (let ((apply-texture (module-ref texture-module 'apply-texture)))
- (make-gpu-state (lambda (texture)
- (apply-texture i texture))
- (module-ref texture-module 'null-texture))))
- (loop (+ i 1))))
- (%make-gpu gl-context
- gl-version
- glsl-version
- (make-guardian)
- (max-texture-size)
- (make-gpu-state (module-ref blend-module 'apply-blend-mode)
- 'replace)
- (make-gpu-state (module-ref polygon-module 'apply-polygon-mode)
- (module-ref polygon-module 'fill-polygon-mode))
- (make-gpu-state (module-ref polygon-module 'apply-cull-face-mode)
- (module-ref polygon-module 'back-cull-face-mode))
- (make-gpu-state (module-ref depth-module 'apply-depth-test) #f)
- (make-gpu-state (module-ref stencil-module 'apply-stencil-test) #f)
- (make-gpu-state (module-ref framebuffer-module 'apply-framebuffer)
- (module-ref framebuffer-module 'null-framebuffer))
- (make-gpu-state (module-ref shader-module 'apply-shader)
- (module-ref shader-module 'null-shader))
- textures
- (make-gpu-state (module-ref buffer-module 'apply-buffer)
- (module-ref buffer-module 'null-buffer))
- (make-gpu-state (module-ref buffer-module 'apply-vertex-array)
- (module-ref buffer-module 'null-vertex-array))
- (make-gpu-state (module-ref viewport-module 'apply-viewport)
- (module-ref viewport-module 'null-viewport))
- (make-gpu-state apply-multisample #f)
- (make-gpu-state (module-ref color-module 'apply-color-mask)
- (module-ref color-module 'default-color-mask)))))
-
-(define-syntax-rule (define-gpu-getter name ref)
- (define (name gpu)
- (gpu-state-ref (ref gpu))))
-
-(define-gpu-getter gpu-blend-mode %gpu-blend-mode)
-(define-gpu-getter gpu-blend-mode %gpu-polygon-mode)
-(define-gpu-getter gpu-blend-mode %gpu-cull-face-mode)
-(define-gpu-getter gpu-depth-test %gpu-depth-test)
-(define-gpu-getter gpu-stencil-test %gpu-stencil-test)
-(define-gpu-getter gpu-framebuffer %gpu-framebuffer)
-(define-gpu-getter gpu-shader %gpu-shader)
-(define-gpu-getter gpu-vertex-buffer %gpu-vertex-buffer)
-(define-gpu-getter gpu-vertex-array %gpu-vertex-array)
-(define-gpu-getter gpu-viewport %gpu-viewport)
-(define-gpu-getter gpu-multisample %gpu-multisample)
-(define-gpu-getter gpu-color-mask %gpu-color-mask)
-
-(define-syntax-rule (define-gpu-setter name ref)
- (define (name gpu x)
- (gpu-state-set! (ref gpu) x)))
-
-(define-gpu-setter set-gpu-blend-mode! %gpu-blend-mode)
-(define-gpu-setter set-gpu-polygon-mode! %gpu-polygon-mode)
-(define-gpu-setter set-gpu-cull-face-mode! %gpu-cull-face-mode)
-(define-gpu-setter set-gpu-depth-test! %gpu-depth-test)
-(define-gpu-setter set-gpu-stencil-test! %gpu-stencil-test)
-(define-gpu-setter set-gpu-framebuffer! %gpu-framebuffer)
-(define-gpu-setter set-gpu-shader! %gpu-shader)
-(define-gpu-setter set-gpu-vertex-buffer! %gpu-vertex-buffer)
-(define-gpu-setter set-gpu-vertex-array! %gpu-vertex-array)
-(define-gpu-setter set-gpu-viewport! %gpu-viewport)
-(define-gpu-setter set-gpu-multisample! %gpu-multisample)
-(define-gpu-setter set-gpu-color-mask! %gpu-color-mask)
-
-(define (gpu-texture gpu texture-unit)
- (gpu-state-ref (vector-ref (gpu-textures gpu) texture-unit)))
-
-(define (set-gpu-texture! gpu texture-unit texture)
- (gpu-state-set! (vector-ref (gpu-textures gpu) texture-unit) texture))
diff --git a/chickadee/graphics/model.scm b/chickadee/graphics/model.scm
index 6e696f7..8fce4ba 100644
--- a/chickadee/graphics/model.scm
+++ b/chickadee/graphics/model.scm
@@ -1,5 +1,5 @@
;;; Chickadee Game Toolkit
-;;; Copyright © 2019 David Thompson <davet@gnu.org>
+;;; Copyright © 2019, 2021 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
@@ -26,10 +26,10 @@
#:use-module (chickadee json)
#:use-module (chickadee math matrix)
#:use-module (chickadee math vector)
- #:use-module (chickadee graphics)
#:use-module (chickadee graphics buffer)
#:use-module (chickadee graphics color)
#:use-module (chickadee graphics depth)
+ #:use-module (chickadee graphics engine)
#:use-module (chickadee graphics pbr)
#:use-module (chickadee graphics phong)
#:use-module (chickadee graphics shader)
@@ -59,15 +59,14 @@
;;;
(define-record-type <render-state>
- (%make-render-state shader renderer world-matrix view-matrix)
+ (%make-render-state renderer world-matrix view-matrix)
render-state?
- (shader render-state-shader)
(renderer render-state-renderer)
(world-matrix render-state-world-matrix)
(view-matrix render-state-view-matrix))
-(define* (make-render-state #:key shader renderer)
- (%make-render-state shader renderer
+(define (make-render-state renderer)
+ (%make-render-state renderer
(make-identity-matrix4)
(make-identity-matrix4)))
@@ -97,18 +96,16 @@
(material primitive-material))
(define (draw-primitive/phong primitive state)
- (gpu-apply/phong (render-state-shader state)
- (primitive-vertex-array primitive)
- (primitive-material primitive)
- (render-state-world-matrix state)
- (render-state-view-matrix state)))
+ (shader-apply/phong (primitive-vertex-array primitive)
+ (primitive-material primitive)
+ (render-state-world-matrix state)
+ (render-state-view-matrix state)))
(define (draw-primitive/pbr primitive state)
- (gpu-apply/pbr (render-state-shader state)
- (primitive-vertex-array primitive)
- (primitive-material primitive)
- (render-state-world-matrix state)
- (render-state-view-matrix state)))
+ (shader-apply/pbr (primitive-vertex-array primitive)
+ (primitive-material primitive)
+ (render-state-world-matrix state)
+ (render-state-view-matrix state)))
;;;
@@ -175,14 +172,16 @@
(define* (make-model #:key name scenes (default-scene (car scenes)) render-state)
(%make-model name scenes default-scene render-state))
+(define %depth-test (make-depth-test))
+
(define (draw-model model model-matrix view-matrix)
- (with-depth-test default-depth-test
+ (with-graphics-state ((depth-test %depth-test))
(let ((state (model-render-state model)))
- (render-state-reset! state)
- (render-state-view-matrix-mult! state view-matrix)
- (render-state-world-matrix-mult! state model-matrix)
- ;; TODO: Support drawing non-default scenes.
- (draw-scene-node (model-default-scene model) state))))
+ (render-state-reset! state)
+ (render-state-view-matrix-mult! state view-matrix)
+ (render-state-world-matrix-mult! state model-matrix)
+ ;; TODO: Support drawing non-default scenes.
+ (draw-scene-node (model-default-scene model) state))))
;;;
@@ -630,8 +629,7 @@
(make-model #:name model-name
#:scenes (list scene)
#:render-state
- (make-render-state #:shader (load-phong-shader)
- #:renderer draw-primitive/phong)))))))
+ (make-render-state draw-primitive/phong)))))))
;;;
@@ -1069,5 +1067,4 @@
(make-model #:name (basename file-name)
#:scenes (list default-scene)
#:render-state
- (make-render-state #:shader (load-pbr-shader)
- #:renderer draw-primitive/pbr))))))
+ (make-render-state draw-primitive/pbr))))))
diff --git a/chickadee/graphics/multisample.scm b/chickadee/graphics/multisample.scm
new file mode 100644
index 0000000..aa66d2e
--- /dev/null
+++ b/chickadee/graphics/multisample.scm
@@ -0,0 +1,37 @@
+;;; Chickadee Game Toolkit
+;;; Copyright © 2021 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:
+;;
+;; Multisampling.
+;;
+;;; Code:
+
+(define-module (chickadee graphics multisample)
+ #:use-module (chickadee graphics engine)
+ #:use-module (gl)
+ #:export (current-multisample))
+
+(define (bind-multisample multisample?)
+ (if multisample?
+ (gl-enable (version-1-3 multisample))
+ (gl-disable (version-1-3 multisample))))
+
+(define-graphics-state multisample?
+ current-multisample
+ #:default #f
+ #:bind bind-multisample)
diff --git a/chickadee/graphics/particles.scm b/chickadee/graphics/particles.scm
index 8048ba1..b19804c 100644
--- a/chickadee/graphics/particles.scm
+++ b/chickadee/graphics/particles.scm
@@ -1,5 +1,5 @@
;;; Chickadee Game Toolkit
-;;; Copyright © 2018 David Thompson <davet@gnu.org>
+;;; Copyright © 2018, 2021 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
@@ -26,9 +26,9 @@
#:use-module (chickadee math matrix)
#:use-module (chickadee math rect)
#:use-module (chickadee math vector)
- #:use-module (chickadee graphics)
#:use-module (chickadee graphics buffer)
#:use-module (chickadee graphics color)
+ #:use-module (chickadee graphics engine)
#:use-module (chickadee graphics shader)
#:use-module (chickadee graphics texture)
#:export (make-particle-emitter
@@ -76,43 +76,23 @@ indefinitely."
(let ((life (particle-emitter-life emitter)))
(and life (<= life 0))))
-(define-record-type <particles>
- (%make-particles capacity size bv shader geometry
- texture animation-rows animation-columns
- speed-range acceleration-range direction-range
- blend-mode start-color end-color lifetime
- sort emitters)
- particles?
- (capacity particles-capacity)
- (size particles-size set-particles-size!)
- (bv particles-bv)
- (shader particles-shader)
- (geometry particles-geometry)
- (texture particles-texture set-particles-texture!)
- (animation-rows particles-animation-rows)
- (animation-columns particles-animation-columns)
- (speed-range particles-speed-range set-particles-speed-range!)
- (acceleration-range particles-acceleration-range
- set-particles-acceleration-range!)
- (direction-range particles-direction-range set-particles-direction-range!)
- (blend-mode particles-blend-mode set-particles-blend-mode!)
- (start-color particles-start-color set-particles-start-color!)
- (end-color particles-end-color set-particles-end-color!)
- (lifetime particles-lifetime set-particles-lifetime!)
- (sort particles-sort set-particles-sort!)
- (emitters particles-emitters set-particles-emitters!))
-
-(define (add-particle-emitter particles emitter)
- "Add EMITTER to PARTICLES."
- (set-particles-emitters! particles
- (cons emitter (particles-emitters particles))))
+(define-geometry-type <quad-vertex>
+ quad-vertex-ref
+ quad-vertex-set!
+ quad-vertex-append!
+ (position vec2)
+ (texture vec2))
-(define (remove-particle-emitter particles emitter)
- "Remove EMITTER from PARTICLES."
- (set-particles-emitters! particles
- (delete emitter (particles-emitters particles))))
+(define-geometry-type <particle-vertex>
+ particle-vertex-ref
+ particle-vertex-set!
+ particle-vertex-append!
+ (position vec2)
+ (velocity vec2)
+ (acceleration vec2)
+ (life int))
-(define (make-particles-shader)
+(define-graphics-variable particles-shader
(strings->shader
"
#ifdef GLSL330
@@ -185,21 +165,42 @@ void main (void) {
}
"))
-(define-geometry-type <quad-vertex>
- quad-vertex-ref
- quad-vertex-set!
- quad-vertex-append!
- (position vec2)
- (texture vec2))
+(define-graphics-variable mvp-matrix (make-null-matrix4))
-(define-geometry-type <particle-vertex>
- particle-vertex-ref
- particle-vertex-set!
- particle-vertex-append!
- (position vec2)
- (velocity vec2)
- (acceleration vec2)
- (life int))
+(define-record-type <particles>
+ (%make-particles capacity size bv geometry
+ texture animation-rows animation-columns
+ speed-range acceleration-range direction-range
+ blend-mode start-color end-color lifetime
+ sort emitters)
+ particles?
+ (capacity particles-capacity)
+ (size particles-size set-particles-size!)
+ (bv particles-bv)
+ (geometry particles-geometry)
+ (texture particles-texture set-particles-texture!)
+ (animation-rows particles-animation-rows)
+ (animation-columns particles-animation-columns)
+ (speed-range particles-speed-range set-particles-speed-range!)
+ (acceleration-range particles-acceleration-range
+ set-particles-acceleration-range!)
+ (direction-range particles-direction-range set-particles-direction-range!)
+ (blend-mode particles-blend-mode set-particles-blend-mode!)
+ (start-color particles-start-color set-particles-start-color!)
+ (end-color particles-end-color set-particles-end-color!)
+ (lifetime particles-lifetime set-particles-lifetime!)
+ (sort particles-sort set-particles-sort!)
+ (emitters particles-emitters set-particles-emitters!))
+
+(define (add-particle-emitter particles emitter)
+ "Add EMITTER to PARTICLES."
+ (set-particles-emitters! particles
+ (cons emitter (particles-emitters particles))))
+
+(define (remove-particle-emitter particles emitter)
+ "Remove EMITTER from PARTICLES."
+ (set-particles-emitters! particles
+ (delete emitter (particles-emitters particles))))
(define* (make-particles capacity #:key
(blend-mode 'alpha)
@@ -292,7 +293,6 @@ default.
(make-bytevector (* (+ capacity 1)
(geometry-type-stride
<particle-vertex>)))
- (make-particles-shader)
geometry
texture
animation-rows
@@ -427,29 +427,29 @@ default.
(geometry-import! (particles-geometry particles) <particle-vertex> bv 0
(particles-size particles))))))
-(define draw-particles*
- (let ((mvp (make-null-matrix4)))
- (lambda (particles matrix)
- "Render PARTICLES with MATRIX applied."
- (let ((geometry (particles-geometry particles)))
- (with-blend-mode (particles-blend-mode particles)
- (with-texture 0 (particles-texture particles)
- (gpu-apply/instanced (particles-shader particles)
- (geometry-vertex-array geometry)
- (particles-size particles)
- #:mvp (if matrix
- (begin
- (matrix4-mult! mvp matrix
- (current-projection))
- mvp)
- (current-projection))
- #:start-color (particles-start-color particles)
- #:end-color (particles-end-color particles)
- #:lifetime (particles-lifetime particles)
- #:animation-rows
- (particles-animation-rows particles)
- #:animation-columns
- (particles-animation-columns particles))))))))
+(define (draw-particles* particles matrix)
+ "Render PARTICLES with MATRIX applied."
+ (let ((shader (graphics-variable-ref particles-shader))
+ (mvp (graphics-variable-ref mvp-matrix))
+ (geometry (particles-geometry particles)))
+ (with-graphics-state ((blend-mode (particles-blend-mode particles))
+ (texture-0 (particles-texture particles)))
+ (shader-apply/instanced shader
+ (geometry-vertex-array geometry)
+ (particles-size particles)
+ #:mvp (if matrix
+ (begin
+ (matrix4-mult! mvp matrix
+ (current-projection))
+ mvp)
+ (current-projection))
+ #:start-color (particles-start-color particles)
+ #:end-color (particles-end-color particles)
+ #:lifetime (particles-lifetime particles)
+ #:animation-rows
+ (particles-animation-rows particles)
+ #:animation-columns
+ (particles-animation-columns particles)))))
(define (draw-particles particles)
"Render PARTICLES."
diff --git a/chickadee/graphics/path.scm b/chickadee/graphics/path.scm
index 34e7f3c..0ab7131 100644
--- a/chickadee/graphics/path.scm
+++ b/chickadee/graphics/path.scm
@@ -1,5 +1,5 @@
;;; Chickadee Game Toolkit
-;;; Copyright © 2020 David Thompson <davet@gnu.org>
+;;; Copyright © 2020, 2021 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
@@ -24,13 +24,14 @@
(define-module (chickadee graphics path)
#:use-module (chickadee array-list)
#:use-module (chickadee config)
- #:use-module (chickadee graphics)
+ #:use-module (chickadee graphics buffer)
#:use-module (chickadee graphics color)
+ #:use-module (chickadee graphics engine)
#:use-module (chickadee graphics gl)
+ #:use-module (chickadee graphics multisample)
#:use-module (chickadee graphics polygon)
#:use-module (chickadee graphics shader)
#:use-module (chickadee graphics stencil)
- #:use-module (chickadee graphics buffer)
#:use-module (chickadee math)
#:use-module (chickadee math bezier)
#:use-module (chickadee math matrix)
@@ -1092,10 +1093,11 @@
;;; Rendering
;;;
-(define path-shader
- (delay
- (load-shader (scope-datadir "shaders/path-vert.glsl")
- (scope-datadir "shaders/path-frag.glsl"))))
+(define-graphics-variable path-shader
+ (load-shader (scope-datadir "shaders/path-vert.glsl")
+ (scope-datadir "shaders/path-frag.glsl")))
+
+(define-graphics-variable mvp-matrix (make-null-matrix4))
(define stencil-flip
(make-stencil-test #:on-pass 'invert))
@@ -1105,30 +1107,31 @@
#:function 'not-equal))
(define *debug?* #f)
-(define *mvp* (make-null-matrix4))
;; TODO: gradients
(define* (draw-filled-path filled-path matrix)
- (let ((counts (filled-path-counts filled-path))
+ (let ((shader (graphics-variable-ref path-shader))
+ (mvp (graphics-variable-ref mvp-matrix))
+ (counts (filled-path-counts filled-path))
(offsets (filled-path-offsets filled-path))
(n (filled-path-count filled-path))
(quad-geometry (filled-path-quad-geometry filled-path))
(stencil-geometry (filled-path-stencil-geometry filled-path)))
- (matrix4-mult! *mvp* matrix (current-projection))
+ (matrix4-mult! mvp matrix (current-projection))
;; Wireframe debug mode.
(when *debug?*
- (with-polygon-mode line-polygon-mode
+ (with-graphics-state ((polygon-mode line-polygon-mode))
(let loop ((i 0))
(when (< i n)
- (gpu-apply* (force path-shader)
- (geometry-vertex-array stencil-geometry)
- (u32vector-ref offsets i)
- (u32vector-ref counts i)
- #:mvp (current-projection)
- #:mode 0)
+ (shader-apply* shader
+ (geometry-vertex-array stencil-geometry)
+ (u32vector-ref offsets i)
+ (u32vector-ref counts i)
+ #:mvp (current-projection)
+ #:mode 0)
(loop (+ i 1))))))
;; Anti-alias the edges of the fill.
- (with-multisample #t
+ (with-graphics-state ((multisample? #t))
;; Render fan to stencil buffer. Each time a triangle is
;; rasterized, it flips the values in the stencil buffer for
;; those fragments. So, the first time a triangle is rendered,
@@ -1140,51 +1143,53 @@
;;
;; For more information, see:
;; http://developer.download.nvidia.com/devzone/devcenter/gamegraphics/files/opengl/gpupathrender.pdf
- (with-color-mask null-color-mask
- (with-stencil-test stencil-flip
- (let loop ((i 0))
- (when (< i n)
- (gpu-apply* (force path-shader)
- (geometry-vertex-array stencil-geometry)
- (u32vector-ref offsets i)
- (u32vector-ref counts i)
- #:mvp *mvp*
- #:mode 0)
- (loop (+ i 1))))))
+ (with-graphics-state ((color-mask null-color-mask)
+ (stencil-test stencil-flip))
+ (let loop ((i 0))
+ (when (< i n)
+ (shader-apply* shader
+ (geometry-vertex-array stencil-geometry)
+ (u32vector-ref offsets i)
+ (u32vector-ref counts i)
+ #:mvp mvp
+ #:mode 0)
+ (loop (+ i 1)))))
;; Render a quad with the stencil applied. The quad is the size
;; of the path's bounding box. The stencil test will make it so
;; we only draw fragments that are part of the filled path.
- (with-stencil-test stencil-cover-and-clear
- (with-blend-mode (filled-path-blend-mode filled-path)
- (gpu-apply (force path-shader)
- (geometry-vertex-array quad-geometry)
- #:mvp *mvp*
- #:mode 0
- #:color (filled-path-color filled-path)))))))
+ (with-graphics-state ((stencil-test stencil-cover-and-clear)
+ (blend-mode (filled-path-blend-mode filled-path)))
+ (shader-apply shader
+ (geometry-vertex-array quad-geometry)
+ #:mvp mvp
+ #:mode 0
+ #:color (filled-path-color filled-path))))))
;; TODO: dashed stroke
;; TODO: miter styles and miter limit
(define* (draw-stroked-path stroked-path matrix)
- (matrix4-mult! *mvp* matrix (current-projection))
- (with-blend-mode (stroked-path-blend-mode stroked-path)
- (let ((geometry (stroked-path-geometry stroked-path)))
- (gpu-apply* (force path-shader)
- (geometry-vertex-array geometry)
- 0
- (geometry-index-count geometry)
- #:mvp *mvp*
- #:color (stroked-path-color stroked-path)
- #:mode 1
- #:feather (stroked-path-feather stroked-path)
- #:stroke-cap (match (stroked-path-cap stroked-path)
- (#f 0) ; no cap
- ('butt 1)
- ('square 2)
- ('round 3)
- ('triangle-out 4)
- ('triangle-in 5)
- (x (error "unsupported line cap style" x)))
- #:stroke-width (stroked-path-width stroked-path)))))
+ (let ((shader (graphics-variable-ref path-shader))
+ (mvp (graphics-variable-ref mvp-matrix)))
+ (matrix4-mult! mvp matrix (current-projection))
+ (with-graphics-state ((blend-mode (stroked-path-blend-mode stroked-path)))
+ (let ((geometry (stroked-path-geometry stroked-path)))
+ (shader-apply* shader
+ (geometry-vertex-array geometry)
+ 0
+ (geometry-index-count geometry)
+ #:mvp mvp
+ #:color (stroked-path-color stroked-path)
+ #:mode 1
+ #:feather (stroked-path-feather stroked-path)
+ #:stroke-cap (match (stroked-path-cap stroked-path)
+ (#f 0) ; no cap
+ ('butt 1)
+ ('square 2)
+ ('round 3)
+ ('triangle-out 4)
+ ('triangle-in 5)
+ (x (error "unsupported line cap style" x)))
+ #:stroke-width (stroked-path-width stroked-path))))))
;;;
diff --git a/chickadee/graphics/pbr.scm b/chickadee/graphics/pbr.scm
index 375f5d0..b28d594 100644
--- a/chickadee/graphics/pbr.scm
+++ b/chickadee/graphics/pbr.scm
@@ -1,5 +1,5 @@
;;; Chickadee Game Toolkit
-;;; Copyright © 2019 David Thompson <davet@gnu.org>
+;;; Copyright © 2019, 2021 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
@@ -23,8 +23,8 @@
(define-module (chickadee graphics pbr)
#:use-module (chickadee math vector)
- #:use-module (chickadee graphics)
#:use-module (chickadee graphics color)
+ #:use-module (chickadee graphics engine)
#:use-module (chickadee graphics shader)
#:use-module (chickadee graphics texture)
#:use-module (srfi srfi-9)
@@ -47,7 +47,7 @@
pbr-material-double-sided?
default-pbr-material
load-pbr-shader
- gpu-apply/pbr))
+ shader-apply/pbr))
(define-shader-type <pbr-material>
make-pbr-material
@@ -85,12 +85,11 @@
#:alpha-cutoff 0.5
#:double-sided? #f))
-;; TODO: Actually implement PBR. For now it's just the minimal amount
-;; of code needed to render the base texture of a mesh.
-(define pbr-shader
- (delay
- (strings->shader
- "
+(define-graphics-variable pbr-shader
+ ;; TODO: Actually implement PBR. For now it's just the minimal amount
+ ;; of code needed to render the base texture of a mesh.
+ (strings->shader
+ "
#ifdef GLSL330
layout (location = 0) in vec3 position;
layout (location = 1) in vec2 texcoord0;
@@ -115,7 +114,7 @@ void main(void) {
gl_Position = projection * view * model * vec4(position.xyz, 1.0);
}
"
- "
+ "
#ifdef GLSL120
attribute vec2 fragTex;
#else
@@ -136,15 +135,13 @@ void main (void) {
vec4(baseColorFactor, 1.0);
#endif
}
-")))
+"))
-(define (load-pbr-shader)
- (force pbr-shader))
-
-(define (gpu-apply/pbr shader vertex-array material model-matrix view-matrix)
- (with-texture 0 (pbr-material-base-color-texture material)
- (gpu-apply shader vertex-array
- #:model model-matrix
- #:view view-matrix
- #:projection (current-projection)
- #:base-color-factor (pbr-material-base-color-factor material))))
+(define (shader-apply/pbr vertex-array material model-matrix view-matrix)
+ (let ((shader (graphics-variable-ref pbr-shader)))
+ (with-graphics-state ((texture-0 (pbr-material-base-color-texture material)))
+ (shader-apply shader vertex-array
+ #:model model-matrix
+ #:view view-matrix
+ #:projection (current-projection)
+ #:base-color-factor (pbr-material-base-color-factor material)))))
diff --git a/chickadee/graphics/phong.scm b/chickadee/graphics/phong.scm
index 514bb24..150d6a1 100644
--- a/chickadee/graphics/phong.scm
+++ b/chickadee/graphics/phong.scm
@@ -1,5 +1,5 @@
;;; Chickadee Game Toolkit
-;;; Copyright © 2019 David Thompson <davet@gnu.org>
+;;; Copyright © 2019, 2021 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
@@ -23,8 +23,8 @@
(define-module (chickadee graphics phong)
#:use-module (chickadee math vector)
- #:use-module (chickadee graphics)
#:use-module (chickadee graphics color)
+ #:use-module (chickadee graphics engine)
#:use-module (chickadee graphics shader)
#:use-module (chickadee graphics texture)
#:use-module (srfi srfi-9)
@@ -45,7 +45,7 @@
phong-material-use-bump-map?
default-phong-material
load-phong-shader
- gpu-apply/phong))
+ shader-apply/phong))
;;;
@@ -110,10 +110,9 @@
;;; Phong Shader
;;;
-(define phong-shader
- (delay
- (strings->shader
- "
+(define-graphics-variable phong-shader
+ (strings->shader
+ "
#ifdef GLSL330
layout (location = 0) in vec3 position;
layout (location = 1) in vec2 texcoord;
@@ -147,7 +146,7 @@ void main() {
fragTex = texcoord;
}
"
- "
+ "
struct Material {
vec3 ambient;
sampler2D ambientMap;
@@ -235,19 +234,17 @@ void main() {
gl_FragColor = vec4(ambientColor + diffuseColor + specularColor, 1.0);
#endif
}
-")))
-
-(define (load-phong-shader)
- (force phong-shader))
-
-(define (gpu-apply/phong shader vertex-array material model-matrix view-matrix)
- (with-texture 0 (phong-material-ambient-map material)
- (with-texture 1 (phong-material-diffuse-map material)
- (with-texture 2 (phong-material-specular-map material)
- (with-texture 3 (phong-material-bump-map material)
- (gpu-apply shader vertex-array
- #:model model-matrix
- #:view view-matrix
- #:projection (current-projection)
- #:material material
- #:directional-light default-directional-light))))))
+"))
+
+(define (shader-apply/phong vertex-array material model-matrix view-matrix)
+ (let ((shader (graphics-variable-ref phong-shader)))
+ (with-graphics-state ((texture-0 (phong-material-ambient-map material))
+ (texture-1 (phong-material-diffuse-map material))
+ (texture-2 (phong-material-specular-map material))
+ (texture-3 (phong-material-bump-map material)))
+ (shader-apply shader vertex-array
+ #:model model-matrix
+ #:view view-matrix
+ #:projection (current-projection)
+ #:material material
+ #:directional-light default-directional-light))))
diff --git a/chickadee/graphics/polygon.scm b/chickadee/graphics/polygon.scm
index b84cc63..1b6a5a7 100644
--- a/chickadee/graphics/polygon.scm
+++ b/chickadee/graphics/polygon.scm
@@ -1,5 +1,5 @@
;;; Chickadee Game Toolkit
-;;; Copyright © 2020 David Thompson <davet@gnu.org>
+;;; Copyright © 2020, 2021 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
@@ -22,6 +22,7 @@
;;; Code:
(define-module (chickadee graphics polygon)
+ #:use-module (chickadee graphics engine)
#:use-module (chickadee graphics gl)
#:use-module (gl)
#:use-module (ice-9 match)
@@ -33,7 +34,7 @@
fill-polygon-mode
line-polygon-mode
point-polygon-mode
- apply-polygon-mode
+ current-polygon-mode
make-cull-face-mode
cull-face-mode?
@@ -43,7 +44,7 @@
back-cull-face-mode
front-cull-face-mode
front-and-back-cull-face-mode
- apply-cull-face-mode))
+ current-cull-face-mode))
(define-record-type <polygon-mode>
(make-polygon-mode front back)
@@ -55,7 +56,7 @@
(define line-polygon-mode (make-polygon-mode 'line 'line))
(define point-polygon-mode (make-polygon-mode 'point 'point))
-(define (apply-polygon-mode mode)
+(define (bind-polygon-mode mode)
(define (glmode sym)
(match sym
('fill (polygon-mode fill))
@@ -69,6 +70,11 @@
(gl-polygon-mode (cull-face-mode front) (glmode front))
(gl-polygon-mode (cull-face-mode back) (glmode back))))))
+(define-graphics-state polygon-mode
+ current-polygon-mode
+ #:default fill-polygon-mode
+ #:bind bind-polygon-mode)
+
(define-record-type <cull-face-mode>
(make-cull-face-mode front? back?)
cull-face-mode?
@@ -80,7 +86,7 @@
(define front-cull-face-mode (make-cull-face-mode #t #f))
(define front-and-back-cull-face-mode (make-cull-face-mode #t #t))
-(define (apply-cull-face-mode mode)
+(define (bind-cull-face-mode mode)
(let ((front? (cull-face-mode-front? mode))
(back? (cull-face-mode-back? mode)))
(cond
@@ -95,3 +101,8 @@
(gl-cull-face (cull-face-mode back)))
(else
(gl-disable (enable-cap cull-face))))))
+
+(define-graphics-state cull-face-mode
+ current-cull-face-mode
+ #:default back-cull-face-mode
+ #:bind bind-cull-face-mode)
diff --git a/chickadee/graphics/shader.scm b/chickadee/graphics/shader.scm
index 010882c..2bd0f18 100644
--- a/chickadee/graphics/shader.scm
+++ b/chickadee/graphics/shader.scm
@@ -1,5 +1,5 @@
;;; Chickadee Game Toolkit
-;;; Copyright © 2016, 2019 David Thompson <davet@gnu.org>
+;;; Copyright © 2016, 2019, 2021 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
@@ -20,7 +20,6 @@
#:use-module (ice-9 rdelim)
#:use-module (ice-9 match)
#:use-module (ice-9 pretty-print)
- #:use-module (oop goops)
#:use-module (system foreign)
#:use-module (rnrs bytevectors)
#:use-module (rnrs io ports)
@@ -31,9 +30,10 @@
#:use-module (gl)
#:use-module (chickadee math matrix)
#:use-module (chickadee math vector)
+ #:use-module (chickadee graphics buffer)
#:use-module (chickadee graphics color)
+ #:use-module (chickadee graphics engine)
#:use-module (chickadee graphics gl)
- #:use-module (chickadee graphics gpu)
#:use-module (chickadee graphics texture)
#:export (shader-data-type?
bool
@@ -53,7 +53,7 @@
make-shader
shader?
null-shader
- apply-shader
+ current-shader
load-shader
strings->shader
shader-uniform
@@ -69,7 +69,11 @@
attribute?
attribute-name
attribute-location
- attribute-type))
+ attribute-type
+ shader-apply
+ shader-apply*
+ shader-apply/instanced*
+ shader-apply/instanced))
;;;
@@ -470,13 +474,20 @@
(define null-shader (%make-shader 0 (make-hash-table) (make-hash-table) #f #f))
-(define <<shader>> (class-of null-shader))
+(define (bind-shader shader)
+ (gl-use-program (shader-id shader)))
-(define-method (gpu-finalize (shader <<shader>>))
+(define (free-shader shader)
(gl-delete-program (shader-id shader)))
-(define (apply-shader shader)
- (gl-use-program (shader-id shader)))
+(define-graphics-finalizer shader-finalizer
+ #:predicate shader?
+ #:free free-shader)
+
+(define-graphics-state shader
+ current-shader
+ #:default null-shader
+ #:bind bind-shader)
(define (make-shader vertex-port fragment-port)
"Read GLSL source from VERTEX-PORT and FRAGMENT-PORT and compile
@@ -509,7 +520,7 @@ them into a GPU shader program."
;; Set up preprocessor directives dynamically based on the current
;; OpenGL context's GLSL version so that we can write shaders that
;; are compatible with as many systems as possible.
- (let ((glsl-version (gpu-glsl-version (current-gpu))))
+ (let ((glsl-version (graphics-engine-glsl-version)))
(cond
((string>= glsl-version "3.3")
"#version 330
@@ -723,10 +734,12 @@ them into a GPU shader program."
(call-with-values
(lambda () (extract-uniforms id))
(lambda (namespace scratch-size)
- (let ((scratch (make-bytevector scratch-size)))
- (gpu-guard
- (%make-shader id (extract-attributes id) namespace
- scratch (bytevector->pointer scratch))))))))
+ (let* ((scratch (make-bytevector scratch-size))
+ (scratch-ptr (bytevector->pointer scratch))
+ (shader (%make-shader id (extract-attributes id) namespace
+ scratch scratch-ptr)))
+ (graphics-engine-guard! shader)
+ shader)))))
(define (load-shader vertex-source-file fragment-source-file)
"Compile the GLSL source code within VERTEX-SOURCE-FILE and
@@ -824,3 +837,43 @@ shader program."
;; Walk the uniform namespace tree until we get to a leaf node or
;; nodes.
(traverse (shader-uniform shader uniform-name) x))
+
+(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->symbol
+ (syntax->datum #'name)))))
+ #'(begin
+ (shader-uniform-set! shader 'sname value)
+ (uniform-apply shader rest)))))))
+
+(define-syntax-rule (shader-apply** shader* vertex-array uniforms exp)
+ (with-graphics-state! ((shader shader*))
+ (uniform-apply shader* uniforms)
+ ;; Sampler2D values aren't explicitly passed as uniform values via
+ ;; shader-apply, so we have to bind them to the proper texture units
+ ;; behind the scenes.
+ (shader-uniform-for-each
+ (lambda (uniform)
+ (when (eq? (uniform-type uniform) sampler-2d)
+ (set-uniform-value! shader* uniform (uniform-value uniform))))
+ shader*)
+ exp))
+
+(define-syntax-rule (shader-apply* shader vertex-array offset count . uniforms)
+ (shader-apply** shader vertex-array uniforms
+ (render-vertices vertex-array #:count count #:offset offset)))
+
+(define-syntax-rule (shader-apply shader vertex-array uniforms ...)
+ (shader-apply* shader vertex-array 0 #f uniforms ...))
+
+(define-syntax-rule (shader-apply/instanced* shader vertex-array offset count instances .
+ uniforms)
+ (shader-apply** shader vertex-array uniforms
+ (render-vertices/instanced vertex-array instances #:count count #:offset offset)))
+
+(define-syntax-rule (shader-apply/instanced shader vertex-array instances
+ uniforms ...)
+ (shader-apply/instanced* shader vertex-array 0 #f instances uniforms ...))
diff --git a/chickadee/graphics/sprite.scm b/chickadee/graphics/sprite.scm
index 2f7c53d..cdb0ed9 100644
--- a/chickadee/graphics/sprite.scm
+++ b/chickadee/graphics/sprite.scm
@@ -1,5 +1,5 @@
;;; Chickadee Game Toolkit
-;;; Copyright © 2016, 2019, 2020 David Thompson <davet@gnu.org>
+;;; Copyright © 2016, 2019, 2020, 2021 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
@@ -23,8 +23,9 @@
#:use-module (chickadee math matrix)
#:use-module (chickadee math rect)
#:use-module (chickadee math vector)
- #:use-module (chickadee graphics)
+ #:use-module (chickadee graphics blend)
#:use-module (chickadee graphics color)
+ #:use-module (chickadee graphics engine)
#:use-module (chickadee graphics shader)
#:use-module (chickadee graphics texture)
#:use-module (chickadee graphics buffer)
@@ -45,10 +46,20 @@
draw-nine-patch*
draw-nine-patch))
-(define unbatched-sprite-shader
- (delay
- (strings->shader
- "
+(define-geometry-type <sprite-vertex>
+ sprite-vertex-ref
+ sprite-vertex-set!
+ sprite-vertex-append!
+ (position vec2)
+ (texture vec2))
+
+(define-graphics-variable sprite-geometry
+ (make-geometry <sprite-vertex> 4 #:index-capacity 6))
+(define-graphics-variable sprite-model-matrix (make-null-matrix4))
+(define-graphics-variable sprite-mvp-matrix (make-null-matrix4))
+(define-graphics-variable sprite-shader
+ (strings->shader
+ "
#ifdef GLSL330
layout (location = 0) in vec2 position;
layout (location = 1) in vec2 tex;
@@ -71,8 +82,7 @@ void main(void) {
gl_Position = mvp * vec4(position.xy, 0.0, 1.0);
}
"
- "
-
+ "
#ifdef GLSL120
varying vec2 fragTex;
#else
@@ -91,70 +101,60 @@ void main (void) {
gl_FragColor = texture2D(colorTexture, fragTex) * tint;
#endif
}
-")))
-
-(define-geometry-type <sprite-vertex>
- sprite-vertex-ref
- sprite-vertex-set!
- sprite-vertex-append!
- (position vec2)
- (texture vec2))
-
-(define draw-sprite*
- (let* ((geometry (delay (make-geometry <sprite-vertex> 4 #:index-capacity 6)))
- (mvp (make-null-matrix4)))
- (lambda* (texture
- rect
- matrix
- #:key
- (tint white)
- (blend-mode 'alpha)
- (texcoords (texture-gl-tex-rect texture)))
- (let ((geometry (force geometry)))
- (with-geometry geometry
- (let* ((x1 (rect-x rect))
- (y1 (rect-y rect))
- (x2 (+ x1 (rect-width rect)))
- (y2 (+ y1 (rect-height rect)))
- (s1 (rect-x texcoords))
- (t1 (rect-y texcoords))
- (s2 (+ (rect-x texcoords) (rect-width texcoords)))
- (t2 (+ (rect-y texcoords) (rect-height texcoords))))
- ;; Texture origin is at the top-left, so we need to flip the Y
- ;; coordinate relative to the vertices.
- (sprite-vertex-append! geometry
- (x1 y1 s1 t2)
- (x2 y1 s2 t2)
- (x2 y2 s2 t1)
- (x1 y2 s1 t1))
- (geometry-index-append! geometry 0 3 2 0 2 1)))
- (with-blend-mode blend-mode
- (with-texture 0 texture
- (gpu-apply (force unbatched-sprite-shader)
- (geometry-vertex-array geometry)
- #:tint tint
- #:mvp (if matrix
- (begin
- (matrix4-mult! mvp matrix
- (current-projection))
- mvp)
- (current-projection)))))))))
+"))
+
+(define* (draw-sprite* texture
+ rect
+ matrix
+ #:key
+ (tint white)
+ (blend-mode 'alpha)
+ (texcoords (texture-gl-tex-rect texture)))
+ (let ((shader (graphics-variable-ref sprite-shader))
+ (geometry (graphics-variable-ref sprite-geometry))
+ (mvp (graphics-variable-ref sprite-mvp-matrix)))
+ (with-geometry geometry
+ (let* ((x1 (rect-x rect))
+ (y1 (rect-y rect))
+ (x2 (+ x1 (rect-width rect)))
+ (y2 (+ y1 (rect-height rect)))
+ (s1 (rect-x texcoords))
+ (t1 (rect-y texcoords))
+ (s2 (+ (rect-x texcoords) (rect-width texcoords)))
+ (t2 (+ (rect-y texcoords) (rect-height texcoords))))
+ ;; Texture origin is at the top-left, so we need to flip the Y
+ ;; coordinate relative to the vertices.
+ (sprite-vertex-append! geometry
+ (x1 y1 s1 t2)
+ (x2 y1 s2 t2)
+ (x2 y2 s2 t1)
+ (x1 y2 s1 t1))
+ (geometry-index-append! geometry 0 3 2 0 2 1)))
+ (with-graphics-state ((blend-mode blend-mode)
+ (texture-0 texture))
+ (shader-apply shader
+ (geometry-vertex-array geometry)
+ #:tint tint
+ #:mvp (if matrix
+ (begin
+ (matrix4-mult! mvp matrix
+ (current-projection))
+ mvp)
+ (current-projection))))))
(define %null-vec2 (vec2 0.0 0.0))
(define %default-scale (vec2 1.0 1.0))
-(define draw-sprite
- (let ((matrix (make-null-matrix4)))
- (lambda* (texture
- position
- #:key
- (tint white)
- (origin %null-vec2)
- (scale %default-scale)
- (rotation 0.0)
- (blend-mode 'alpha)
- (rect (texture-gl-rect texture)))
- "Draw TEXTURE at POSITION.
+(define* (draw-sprite texture
+ position
+ #:key
+ (tint white)
+ (origin %null-vec2)
+ (scale %default-scale)
+ (rotation 0.0)
+ (blend-mode 'alpha)
+ (rect (texture-gl-rect texture)))
+ "Draw TEXTURE at POSITION.
Optionally, other transformations may be applied to the sprite.
ROTATION specifies the angle to rotate the sprite, in radians. SCALE
@@ -166,14 +166,15 @@ By default white is used, which does no tinting at all.
By default, alpha blending is used but can be changed by specifying
BLEND-MODE."
- (matrix4-2d-transform! matrix
- #:origin origin
- #:position position
- #:rotation rotation
- #:scale scale)
- (draw-sprite* texture rect matrix
- #:tint tint
- #:blend-mode blend-mode))))
+ (let ((matrix (graphics-variable-ref sprite-model-matrix)))
+ (matrix4-2d-transform! matrix
+ #:origin origin
+ #:position position
+ #:rotation rotation
+ #:scale scale)
+ (draw-sprite* texture rect matrix
+ #:tint tint
+ #:blend-mode blend-mode)))
;;;
@@ -188,6 +189,59 @@ BLEND-MODE."
(texture vec2)
(tint vec4))
+(define-graphics-variable sprite-batch-shader
+ (strings->shader
+ "
+#ifdef GLSL330
+layout (location = 0) in vec2 position;
+layout (location = 1) in vec2 tex;
+layout (location = 2) in vec4 tint;
+#elif defined(GLSL130)
+in vec2 position;
+in vec2 tex;
+in vec4 tint;
+#elif defined(GLSL120)
+attribute vec2 position;
+attribute vec2 tex;
+attribute vec4 tint;
+#endif
+#ifdef GLSL120
+varying vec2 fragTex;
+varying vec4 fragTint;
+#else
+out vec2 fragTex;
+out vec4 fragTint;
+#endif
+uniform mat4 mvp;
+
+void main(void) {
+ fragTex = tex;
+ fragTint = tint;
+ gl_Position = mvp * vec4(position.xy, 0.0, 1.0);
+}
+"
+ "
+#ifdef GLSL120
+varying vec2 fragTex;
+varying vec4 fragTint;
+#else
+in vec2 fragTex;
+in vec4 fragTint;
+#endif
+#ifdef GLSL330
+out vec4 fragColor;
+#endif
+uniform sampler2D colorTexture;
+
+void main (void) {
+#ifdef GLSL330
+ fragColor = texture(colorTexture, fragTex) * fragTint;
+#else
+ gl_FragColor = texture2D(colorTexture, fragTex) * fragTint;
+#endif
+}
+"))
+
(define-record-type <sprite-batch>
(%make-sprite-batch texture geometry size)
sprite-batch?
@@ -258,116 +312,59 @@ texture may be specified via the TEXTURE-REGION argument."
(+ vertex-offset 1))
(set-sprite-batch-size! batch (+ (sprite-batch-size batch) 1))))
-(define sprite-batch-add!
- (let ((matrix (make-null-matrix4)))
- (lambda* (batch
- position
- #:key
- (origin %null-vec2)
- (scale %default-scale)
- (rotation 0.0)
- (tint white)
- texture-region)
- "Add sprite to BATCH at POSITION. To render a subsection of the
+(define* (sprite-batch-add! batch
+ position
+ #:key
+ (origin %null-vec2)
+ (scale %default-scale)
+ (rotation 0.0)
+ (tint white)
+ texture-region)
+ "Add sprite to BATCH at POSITION. To render a subsection of the
batch's texture, a texture object whose parent is the batch texture
may be specified via the TEXTURE-REGION argument."
- (let ((rect (texture-gl-rect
- (or texture-region (sprite-batch-texture batch)))))
- (matrix4-2d-transform! matrix
- #:origin origin
- #:position position
- #:rotation rotation
- #:scale scale)
- (sprite-batch-add* batch rect matrix
- #:tint tint
- #:texture-region texture-region)))))
-
-
-(define batched-sprite-shader
- (delay
- (strings->shader
- "
-#ifdef GLSL330
-layout (location = 0) in vec2 position;
-layout (location = 1) in vec2 tex;
-layout (location = 2) in vec4 tint;
-#elif defined(GLSL130)
-in vec2 position;
-in vec2 tex;
-in vec4 tint;
-#elif defined(GLSL120)
-attribute vec2 position;
-attribute vec2 tex;
-attribute vec4 tint;
-#endif
-#ifdef GLSL120
-varying vec2 fragTex;
-varying vec4 fragTint;
-#else
-out vec2 fragTex;
-out vec4 fragTint;
-#endif
-uniform mat4 mvp;
-
-void main(void) {
- fragTex = tex;
- fragTint = tint;
- gl_Position = mvp * vec4(position.xy, 0.0, 1.0);
-}
-"
- "
-#ifdef GLSL120
-varying vec2 fragTex;
-varying vec4 fragTint;
-#else
-in vec2 fragTex;
-in vec4 fragTint;
-#endif
-#ifdef GLSL330
-out vec4 fragColor;
-#endif
-uniform sampler2D colorTexture;
-
-void main (void) {
-#ifdef GLSL330
- fragColor = texture(colorTexture, fragTex) * fragTint;
-#else
- gl_FragColor = texture2D(colorTexture, fragTex) * fragTint;
-#endif
-}
-")))
-
-(define draw-sprite-batch*
- (let ((mvp (make-null-matrix4)))
- (lambda* (batch matrix #:key (blend-mode 'alpha))
- "Render the contents of BATCH."
- (sprite-batch-flush! batch)
- (matrix4-mult! mvp matrix (current-projection))
- (with-blend-mode blend-mode
- (with-texture 0 (sprite-batch-texture batch)
- (let ((geometry (sprite-batch-geometry batch)))
- (gpu-apply* (force batched-sprite-shader)
- (geometry-vertex-array geometry)
- 0
- (geometry-index-count geometry)
- #:mvp mvp)))))))
+ (let ((matrix (graphics-variable-ref sprite-model-matrix))
+ (rect (texture-gl-rect
+ (or texture-region (sprite-batch-texture batch)))))
+ (matrix4-2d-transform! matrix
+ #:origin origin
+ #:position position
+ #:rotation rotation
+ #:scale scale)
+ (sprite-batch-add* batch rect matrix
+ #:tint tint
+ #:texture-region texture-region)))
+
+(define* (draw-sprite-batch* batch matrix #:key (blend-mode 'alpha))
+ "Render the contents of BATCH."
+ (let ((shader (graphics-variable-ref sprite-batch-shader))
+ (mvp (graphics-variable-ref sprite-mvp-matrix)))
+ (sprite-batch-flush! batch)
+ (matrix4-mult! mvp matrix (current-projection))
+ (with-graphics-state ((blend-mode blend-mode)
+ (texture-0 (sprite-batch-texture batch)))
+ (let ((geometry (sprite-batch-geometry batch)))
+ (shader-apply* shader
+ (geometry-vertex-array geometry)
+ 0
+ (geometry-index-count geometry)
+ #:mvp mvp)))))
-(define draw-sprite-batch
- (let ((matrix (make-null-matrix4)))
- (lambda* (batch
- #:key
- (position %null-vec2)
- (origin %null-vec2)
- (scale %default-scale)
- (rotation 0.0)
- (blend-mode 'alpha))
- "Render the contents of BATCH."
- (matrix4-2d-transform! matrix
- #:origin origin
- #:position position
- #:rotation rotation
- #:scale scale)
- (draw-sprite-batch* batch matrix #:blend-mode blend-mode))))
+(define* (draw-sprite-batch batch
+ #:key
+ (position %null-vec2)
+ (origin %null-vec2)
+ (scale %default-scale)
+ (rotation 0.0)
+ (blend-mode 'alpha))
+ "Render the contents of BATCH."
+ (let ((matrix (graphics-variable-ref sprite-model-matrix)))
+ (matrix4-2d-transform! matrix
+ #:origin origin
+ #:position position
+ #:rotation rotation
+ #:scale scale)
+ (draw-sprite-batch* batch matrix #:blend-mode blend-mode)))
;;;
diff --git a/chickadee/graphics/stencil.scm b/chickadee/graphics/stencil.scm
index ad15598..e19307b 100644
--- a/chickadee/graphics/stencil.scm
+++ b/chickadee/graphics/stencil.scm
@@ -1,5 +1,5 @@
;;; Chickadee Game Toolkit
-;;; Copyright © 2020 David Thompson <davet@gnu.org>
+;;; Copyright © 2020, 2021 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
@@ -18,8 +18,8 @@
(define-module (chickadee graphics stencil)
#:use-module (ice-9 match)
#:use-module (gl)
+ #:use-module (chickadee graphics engine)
#:use-module (chickadee graphics gl)
- #:use-module (chickadee graphics gpu)
#:use-module (srfi srfi-9)
#:export (make-stencil-test
stencil-test?
@@ -38,7 +38,7 @@
stencil-test-on-pass-front
stencil-test-on-pass-back
default-stencil-test
- apply-stencil-test))
+ current-stencil-test))
(define-record-type <stencil-test>
(%make-stencil-test mask-front mask-back function-front function-back
@@ -85,7 +85,7 @@
(define default-stencil-test (make-stencil-test))
-(define* (apply-stencil-test stencil)
+(define* (bind-stencil-test stencil)
(define (symbol->op sym)
(match sym
('zero (stencil-op zero))
@@ -135,3 +135,8 @@
(symbol->op (stencil-test-on-depth-fail-back stencil))
(symbol->op (stencil-test-on-pass-back stencil))))
(gl-disable (enable-cap stencil-test))))
+
+(define-graphics-state stencil-test
+ current-stencil-test
+ #:default default-stencil-test
+ #:bind bind-stencil-test)
diff --git a/chickadee/graphics/texture.scm b/chickadee/graphics/texture.scm
index db59585..9a8a924 100644
--- a/chickadee/graphics/texture.scm
+++ b/chickadee/graphics/texture.scm
@@ -1,5 +1,5 @@
;;; Chickadee Game Toolkit
-;;; Copyright © 2016 David Thompson <davet@gnu.org>
+;;; Copyright © 2016, 2021 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
@@ -25,11 +25,10 @@
#:use-module (gl)
#:use-module ((gl enums) #:prefix gl:)
#:use-module ((sdl2 surface) #:prefix sdl2:)
- #:use-module (oop goops)
#:use-module (chickadee math rect)
#:use-module (chickadee graphics color)
+ #:use-module (chickadee graphics engine)
#:use-module (chickadee graphics gl)
- #:use-module (chickadee graphics gpu)
#:export (make-texture
make-texture-region
load-image
@@ -48,7 +47,10 @@
texture-gl-rect
texture-gl-tex-rect
null-texture
- apply-texture
+ current-texture-0
+ current-texture-1
+ current-texture-2
+ current-texture-3
texture-atlas
list->texture-atlas
@@ -101,8 +103,6 @@
(%make-texture 0 #f 'linear 'linear 'repeat 'repeat 0 0 0 0
(make-rect 0.0 0.0 0.0 0.0) (make-rect 0.0 0.0 0.0 0.0)))
-(define <<texture>> (class-of null-texture))
-
(define (texture-null? texture)
"Return #t if TEXTURE is the null texture."
(eq? texture null-texture))
@@ -113,14 +113,36 @@
(define (free-texture texture)
(gl-delete-texture (texture-id texture)))
-(define-method (gpu-finalize (texture <<texture>>))
- (free-texture texture))
+(define (make-bind-texture n)
+ (lambda (texture)
+ (let ((texture-unit (+ (version-1-3 texture0) n)))
+ (set-gl-active-texture texture-unit)
+ (gl-bind-texture (texture-target texture-2d)
+ (texture-id texture)))))
+
+(define-graphics-finalizer texture-finalizer
+ #:predicate texture?
+ #:free free-texture)
+
+(define-graphics-state texture-0
+ current-texture-0
+ #:default null-texture
+ #:bind (make-bind-texture 0))
+
+(define-graphics-state texture-1
+ current-texture-1
+ #:default null-texture
+ #:bind (make-bind-texture 1))
+
+(define-graphics-state texture-2
+ current-texture-2
+ #:default null-texture
+ #:bind (make-bind-texture 2))
-(define (apply-texture n texture)
- (let ((texture-unit (+ (version-1-3 texture0) n)))
- (set-gl-active-texture texture-unit)
- (gl-bind-texture (texture-target texture-2d)
- (texture-id texture))))
+(define-graphics-state texture-3
+ current-texture-3
+ #:default null-texture
+ #:bind (make-bind-texture 3))
(define* (make-texture pixels width height #:key
flip?
@@ -147,37 +169,38 @@ clamp-to-edge. FORMAT specifies the pixel format. Currently only
('clamp-to-border (texture-wrap-mode clamp-to-border-sgis))
('clamp-to-edge (texture-wrap-mode clamp-to-edge-sgis))))
- (let ((texture (gpu-guard
- (%make-texture (gl-generate-texture) #f
- min-filter mag-filter wrap-s wrap-t
- 0 0 width height
- (make-rect 0.0 0.0 width height)
- (if flip?
- (make-rect 0.0 1.0 1.0 -1.0)
- (make-rect 0.0 0.0 1.0 1.0))))))
- (set-gpu-texture! (current-gpu) 0 texture)
- (gl-texture-parameter (texture-target texture-2d)
- (texture-parameter-name texture-min-filter)
- (match min-filter
- ('nearest (gl:texture-min-filter nearest))
- ('linear (gl:texture-min-filter linear))))
- (gl-texture-parameter (texture-target texture-2d)
- (texture-parameter-name texture-mag-filter)
- (match mag-filter
- ('nearest (gl:texture-mag-filter nearest))
- ('linear (gl:texture-mag-filter linear))))
- (gl-texture-parameter (texture-target texture-2d)
- (texture-parameter-name texture-wrap-s)
- (gl-wrap wrap-s))
- (gl-texture-parameter (texture-target texture-2d)
- (texture-parameter-name texture-wrap-t)
- (gl-wrap wrap-t))
- (gl-texture-image-2d (texture-target texture-2d)
- 0 (pixel-format rgba) width height 0
- (match format
- ('rgba (pixel-format rgba)))
- (color-pointer-type unsigned-byte)
- (or pixels %null-pointer))
+ (let ((texture (%make-texture (gl-generate-texture) #f
+ min-filter mag-filter wrap-s wrap-t
+ 0 0 width height
+ (make-rect 0.0 0.0 width height)
+ (if flip?
+ (make-rect 0.0 1.0 1.0 -1.0)
+ (make-rect 0.0 0.0 1.0 1.0)))))
+ (graphics-engine-guard! texture)
+ (with-graphics-state ((texture-0 texture))
+ (graphics-engine-commit!)
+ (gl-texture-parameter (texture-target texture-2d)
+ (texture-parameter-name texture-min-filter)
+ (match min-filter
+ ('nearest (gl:texture-min-filter nearest))
+ ('linear (gl:texture-min-filter linear))))
+ (gl-texture-parameter (texture-target texture-2d)
+ (texture-parameter-name texture-mag-filter)
+ (match mag-filter
+ ('nearest (gl:texture-mag-filter nearest))
+ ('linear (gl:texture-mag-filter linear))))
+ (gl-texture-parameter (texture-target texture-2d)
+ (texture-parameter-name texture-wrap-s)
+ (gl-wrap wrap-s))
+ (gl-texture-parameter (texture-target texture-2d)
+ (texture-parameter-name texture-wrap-t)
+ (gl-wrap wrap-t))
+ (gl-texture-image-2d (texture-target texture-2d)
+ 0 (pixel-format rgba) width height 0
+ (match format
+ ('rgba (pixel-format rgba)))
+ (color-pointer-type unsigned-byte)
+ (or pixels %null-pointer)))
texture))
(define (make-texture-region texture rect)
diff --git a/chickadee/graphics/tiled.scm b/chickadee/graphics/tiled.scm
index 5b3e9bf..2d2e88f 100644
--- a/chickadee/graphics/tiled.scm
+++ b/chickadee/graphics/tiled.scm
@@ -1,5 +1,5 @@
;;; Chickadee Game Toolkit
-;;; Copyright © 2018, 2020 David Thompson <davet@gnu.org>
+;;; Copyright © 2018, 2020, 2021 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
@@ -25,7 +25,6 @@
#:use-module (chickadee math matrix)
#:use-module (chickadee math rect)
#:use-module (chickadee math vector)
- #:use-module (chickadee graphics)
#:use-module (chickadee graphics color)
#:use-module (chickadee graphics sprite)
#:use-module (chickadee graphics texture)
diff --git a/chickadee/graphics/viewport.scm b/chickadee/graphics/viewport.scm
index 5fd2e9b..b60a585 100644
--- a/chickadee/graphics/viewport.scm
+++ b/chickadee/graphics/viewport.scm
@@ -1,5 +1,5 @@
;;; Chickadee Game Toolkit
-;;; Copyright © 2017 David Thompson <davet@gnu.org>
+;;; Copyright © 2017, 2021 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
@@ -27,8 +27,8 @@
#:use-module (gl)
#:use-module (chickadee utils)
#:use-module (chickadee graphics color)
+ #:use-module (chickadee graphics engine)
#:use-module (chickadee graphics gl)
- #:use-module (chickadee graphics gpu)
#:export (make-viewport
viewport?
viewport-x
@@ -38,8 +38,8 @@
viewport-clear-color
viewport-clear-flags
null-viewport
- apply-viewport
clear-viewport
+ current-viewport
%default-clear-flags
%default-clear-color))
@@ -93,8 +93,8 @@ CLEAR-FLAGS are 'color-buffer', 'depth-buffer', 'accum-buffer', and
('color-buffer 16384))
flags)))))
-(define (clear-viewport viewport)
- (gl-clear (clear-buffer-mask (viewport-clear-flags viewport))))
+(define (clear-viewport)
+ (gl-clear (clear-buffer-mask (viewport-clear-flags (current-viewport)))))
(define (apply-viewport viewport)
"Set the OpenGL state for VIEWPORT. Clip rendering to the viewport
@@ -109,3 +109,22 @@ area, set the clear color, and clear necessary buffers."
(gl-viewport x y w h)
(gl-scissor x y w h)
(gl-clear-color (color-r c) (color-g c) (color-b c) (color-a c)))))
+
+(define (bind-viewport viewport)
+ "Set the OpenGL state for VIEWPORT. Clip rendering to the viewport
+area, and set the clear color.."
+ (unless (eq? viewport null-viewport)
+ (let ((x (viewport-x viewport))
+ (y (viewport-y viewport))
+ (w (viewport-width viewport))
+ (h (viewport-height viewport))
+ (c (viewport-clear-color viewport)))
+ (gl-enable (enable-cap scissor-test))
+ (gl-viewport x y w h)
+ (gl-scissor x y w h)
+ (gl-clear-color (color-r c) (color-g c) (color-b c) (color-a c)))))
+
+(define-graphics-state viewport
+ current-viewport
+ #:default null-viewport
+ #:bind bind-viewport)
diff --git a/doc/api.texi b/doc/api.texi
index 86788ba..13ecc72 100644
--- a/doc/api.texi
+++ b/doc/api.texi
@@ -2926,32 +2926,32 @@ like a procedure for the GPU to apply. Shaders are passed arguments:
A vertex array containing the geometry to render (@pxref{Buffers}) and
zero or more keyword arguments that the shader understands. Similar
to how Scheme has @code{apply} for calling procedures, Chickadee
-provides @code{gpu-apply} for calling shaders.
+provides @code{shader-apply} for calling shaders.
Additionally, there is some dynamic state that effects how
-@code{gpu-apply} will behave. Things like the current viewport,
+@code{shader-apply} will behave. Things like the current viewport,
framebuffer, and blend mode are stored as dynamic state because it
would be tedious to have to have to specify them each time
-@code{gpu-apply} is called.
+@code{shader-apply} is called.
The following procedures and syntax can be found in the
@code{(chickadee graphics)} module.
-@deffn {Syntax} gpu-apply shader vertex-array @
+@deffn {Syntax} shader-apply shader vertex-array @
[#:uniform-key uniform-value @dots{}]
-@deffnx {Syntax} gpu-apply* shader vertex-array count @
+@deffnx {Syntax} shader-apply* shader vertex-array count @
[#:uniform-key uniform-value @dots{}]
Render @var{vertex-array} using @var{shader} with the uniform values
specified in the following keyword arguments.
-While @code{gpu-apply} will draw every vertex in @var{vertex-array},
-@code{gpu-apply*} will only draw @var{count} vertices.
+While @code{shader-apply} will draw every vertex in @var{vertex-array},
+@code{shader-apply*} will only draw @var{count} vertices.
@end deffn
-@deffn {Syntax} gpu-apply/instanced shader vertex-array @
+@deffn {Syntax} shader-apply/instanced shader vertex-array @
n [#:uniform-key uniform-value @dots{}]
-@deffnx {Syntax} gpu-apply/instanced shader vertex-array @
+@deffnx {Syntax} shader-apply/instanced shader vertex-array @
count n [#:uniform-key uniform-value @dots{}]
Render @var{vertex-array} @var{n} times using @var{shader} with the
@@ -2961,8 +2961,8 @@ Instanced rendering is very beneficial for rendering the same object
many times with only small differences for each one. For example, the
particle effects described in @ref{Particles} use instanced rendering.
-While @code{gpu-apply/instanced} will draw every vertex in
-@var{vertex-array}, @code{gpu-apply*} will only draw @var{count}
+While @code{shader-apply/instanced} will draw every vertex in
+@var{vertex-array}, @code{shader-apply*} will only draw @var{count}
vertices.
@end deffn
@@ -3118,7 +3118,7 @@ for each attribute.
With the vertex array created, the GPU is now fully aware of how to
interpret the data that it has been given in the original buffer.
Actually rendering this square is left as an exercise to the reader.
-See the @ref{Shaders} section and the @code{gpu-apply} procedure in
+See the @ref{Shaders} section and the @code{shader-apply} procedure in
@ref{Rendering Engine} for the remaining pieces of a successful draw
call. Additionally, consider reading the source code for sprites,
shapes, or particles to see GPU buffers in action.
@@ -3269,7 +3269,7 @@ Valid values for @var{component-type} are:
@end itemize
@var{divisor} is only needed for instanced rendering applications (see
-@code{gpu-apply/instanced} in @ref{Rendering Engine}) and represents
+@code{shader-apply/instanced} in @ref{Rendering Engine}) and represents
how many instances each vertex element applies to. A divisor of 0
means that a single element is used for every instance and is used for
the data being instanced. A divisor of 1 means that each element is
@@ -3427,10 +3427,10 @@ arguments), and some ``uniforms'' (keyword arguments).
@example
(define my-shader (load-shader "vert.glsl" "frag.glsl"))
(define vertices (make-vertex-array @dots{}))
-(gpu-apply my-shader vertices #:color red)
+(shader-apply my-shader vertices #:color red)
@end example
-@xref{Rendering Engine} for more details about the @code{gpu-apply}
+@xref{Rendering Engine} for more details about the @code{shader-apply}
procedure.
Shaders are incredibly powerful tools, and there's more information
diff --git a/examples/grid.scm b/examples/grid.scm
index 51a4a37..f552d1a 100644
--- a/examples/grid.scm
+++ b/examples/grid.scm
@@ -2,7 +2,6 @@
(chickadee math grid)
(chickadee math vector)
(chickadee math rect)
- (chickadee graphics)
(chickadee graphics color)
(chickadee graphics font)
(chickadee graphics path)
diff --git a/examples/model.scm b/examples/model.scm
index f7ef9f7..98a7deb 100644
--- a/examples/model.scm
+++ b/examples/model.scm
@@ -2,7 +2,7 @@
(chickadee math)
(chickadee math matrix)
(chickadee math vector)
- (chickadee graphics)
+ (chickadee graphics engine)
(chickadee graphics model)
(chickadee graphics font)
(ice-9 format))
@@ -27,8 +27,7 @@
(define (draw alpha)
(with-projection projection
- (with-depth-test #t
- (draw-model model model-matrix view-matrix)))
+ (draw-model model model-matrix view-matrix))
(draw-text text text-position))
(define (update dt)
diff --git a/examples/particles.scm b/examples/particles.scm
index abefd94..f7d096e 100644
--- a/examples/particles.scm
+++ b/examples/particles.scm
@@ -1,7 +1,6 @@
(use-modules (chickadee)
(chickadee math rect)
(chickadee math vector)
- (chickadee graphics)
(chickadee graphics color)
(chickadee graphics font)
(chickadee graphics particles)
diff --git a/examples/sprite-batch.scm b/examples/sprite-batch.scm
index 3aad219..b63179f 100644
--- a/examples/sprite-batch.scm
+++ b/examples/sprite-batch.scm
@@ -2,7 +2,6 @@
(chickadee math matrix)
(chickadee math rect)
(chickadee math vector)
- (chickadee graphics)
(chickadee graphics color)
(chickadee graphics font)
(chickadee graphics sprite)