1 files changed, 61 insertions, 0 deletions
diff --git a/chickadee/graphics/depth.scm b/chickadee/graphics/depth.scm
new file mode 100644
index 0000000..8e622e4
--- /dev/null
+++ b/chickadee/graphics/depth.scm
@@ -0,0 +1,61 @@
+;;; 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 graphics depth)
+  #:use-module (ice-9 match)
+  #:use-module (gl)
+  #:use-module (chickadee graphics gl)
+  #:use-module (chickadee graphics gpu)
+  #:use-module (srfi srfi-9)
+  #:export (make-depth-test
+            depth-test?
+            depth-test-write?
+            depth-test-function
+            depth-test-near
+            depth-test-far
+            default-depth-test
+            apply-depth-test))
+
+(define-record-type <depth-test>
+  (%make-depth-test write? function near far)
+  depth-test?
+  (write? depth-test-write?)
+  (function depth-test-function)
+  (near depth-test-near)
+  (far depth-test-far))
+
+(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)
+  (if depth-test
+      (let ((glfunc (match (depth-test-function depth-test)
+                      ('always (depth-function always))
+                      ('never (depth-function never))
+                      ('equal (depth-function equal))
+                      ('not-equal (depth-function notequal))
+                      ('less-than (depth-function less))
+                      ('less-than-or-equal (depth-function lequal))
+                      ('greater-than (depth-function greater))
+                      ('greater-than-or-equal (depth-function gequal)))))
+        (gl-enable (enable-cap depth-test))
+        (gl-depth-func glfunc)
+        (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))))