render: Add stencil test support.

1 files changed, 137 insertions, 0 deletions

diff --git a/chickadee/render/stencil.scm b/chickadee/render/stencil.scm
new file mode 100644
index 0000000..4a20300
--- /dev/null
+++ b/chickadee/render/stencil.scm
@@ -0,0 +1,137 @@
+;;; Chickadee Game Toolkit
+;;; Copyright © 2020 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 render stencil)
+  #:use-module (ice-9 match)
+  #:use-module (gl)
+  #:use-module (chickadee render gl)
+  #:use-module (chickadee render gpu)
+  #:use-module (srfi srfi-9)
+  #:export (make-stencil-test
+            stencil-test?
+            stencil-test-mask-front
+            stencil-test-mask-back
+            stencil-test-function-front
+            stencil-test-function-back
+            stencil-test-function-mask-front
+            stencil-test-function-mask-back
+            stencil-test-reference-front
+            stencil-test-reference-back
+            stencil-test-on-fail-front
+            stencil-test-on-fail-back
+            stencil-test-on-depth-fail-front
+            stencil-test-on-depth-fail-back
+            stencil-test-on-pass-front
+            stencil-test-on-pass-back
+            default-stencil-test
+            apply-stencil-test))
+
+(define-record-type <stencil-test>
+  (%make-stencil-test mask-front mask-back function-front function-back
+                      function-mask-front function-mask-back
+                      reference-front reference-back
+                      on-fail-front on-fail-back
+                      on-depth-fail-front on-depth-fail-back
+                      on-pass-front on-pass-back)
+  stencil-test?
+  (mask-front stencil-test-mask-front)
+  (mask-back stencil-test-mask-back)
+  (function-front stencil-test-function-front)
+  (function-back stencil-test-function-back)
+  (function-mask-front stencil-test-function-mask-front)
+  (function-mask-back stencil-test-function-mask-back)
+  (reference-front stencil-test-reference-front)
+  (reference-back stencil-test-reference-back)
+  (on-fail-front stencil-test-on-fail-front)
+  (on-fail-back stencil-test-on-fail-back)
+  (on-depth-fail-front stencil-test-on-depth-fail-front)
+  (on-depth-fail-back stencil-test-on-depth-fail-back)
+  (on-pass-front stencil-test-on-pass-front)
+  (on-pass-back stencil-test-on-pass-back))
+
+(define* (make-stencil-test #:key (mask #xFF) (function 'always)
+                            (function-mask #xFF) (reference 0)
+                            (on-fail 'keep) (on-depth-fail 'keep) (on-pass 'keep)
+                            (mask-front mask) (mask-back mask)
+                            (function-front function) (function-back function)
+                            (function-mask-front function-mask)
+                            (function-mask-back function-mask)
+                            (reference-front reference)
+                            (reference-back reference)
+                            (on-fail-front on-fail) (on-fail-back on-fail)
+                            (on-depth-fail-front on-depth-fail)
+                            (on-depth-fail-back on-depth-fail)
+                            (on-pass-front on-pass) (on-pass-back on-pass))
+  (%make-stencil-test mask-front mask-back function-front function-back
+                      function-mask-front function-mask-back
+                      reference-front reference-back
+                      on-fail-front on-fail-back
+                      on-depth-fail-front on-depth-fail-back
+                      on-pass-front on-pass-back))
+
+(define %default-stencil-test (make-stencil-test))
+
+(define* (apply-stencil-test stencil)
+  (define (symbol->op sym)
+    (match sym
+      ('zero (stencil-op zero))
+      ('keep (stencil-op keep))
+      ('replace (stencil-op replace))
+      ('increment (stencil-op incr))
+      ('increment-wrap (version-1-4 incr-wrap))
+      ('decrement (stencil-op decr))
+      ('decrement-wrap (version-1-4 decr-wrap))
+      ('invert (stencil-op invert))))
+  (define (symbol->function sym)
+    (match sym
+      ('always (stencil-function always))
+      ('never (stencil-function never))
+      ('less-than (stencil-function less))
+      ('equal (stencil-function equal))
+      ('less-than-or-equal (stencil-function lequal))
+      ('greater-than (stencil-function greater))
+      ('greater-than-or-equal (stencil-function gequal))
+      ('not-equal (stencil-function notequal))))
+  (if stencil
+      (begin
+        (gl-enable (enable-cap stencil-test))
+        ;; Mask
+        (gl-stencil-mask-separate (cull-face-mode front)
+                                  (stencil-test-mask-front stencil))
+        (gl-stencil-mask-separate (cull-face-mode back)
+                                  (stencil-test-mask-back stencil))
+        ;; Function
+        (gl-stencil-func-separate (cull-face-mode front)
+                                  (symbol->function
+                                   (stencil-test-function-front stencil))
+                                  (stencil-test-reference-front stencil)
+                                  (stencil-test-function-mask-front stencil))
+        (gl-stencil-func-separate (cull-face-mode back)
+                                  (symbol->function
+                                   (stencil-test-function-back stencil))
+                                  (stencil-test-reference-back stencil)
+                                  (stencil-test-function-mask-back stencil))
+        ;; Operation
+        (gl-stencil-op-separate (cull-face-mode front)
+                                (symbol->op (stencil-test-on-fail-front stencil))
+                                (symbol->op (stencil-test-on-depth-fail-front stencil))
+                                (symbol->op (stencil-test-on-pass-front stencil)))
+        (gl-stencil-op-separate (cull-face-mode back)
+                                (symbol->op (stencil-test-on-fail-back stencil))
+                                (symbol->op (stencil-test-on-depth-fail-back stencil))
+                                (symbol->op (stencil-test-on-pass-back stencil))))
+      (gl-disable (enable-cap stencil-test))))