;;; Chickadee Game Toolkit ;;; Copyright © 2020, 2021 David Thompson ;;; ;;; 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 ;;; . (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 (srfi srfi-9) #:export (make-depth-test depth-test? depth-test-write? depth-test-function depth-test-near depth-test-far basic-depth-test g:depth-test current-depth-test)) (define-record-type (%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 basic-depth-test (make-depth-test)) (define (bind-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)))) (define-graphics-state g:depth-test current-depth-test #:default #f #:bind bind-depth-test)