;;; Chickadee Game Toolkit ;;; Copyright © 2020, 2021 David Thompson ;;; ;;; Licensed under the Apache License, Version 2.0 (the "License"); ;;; you may not use this file except in compliance with the License. ;;; You may obtain a copy of the License at ;;; ;;; http://www.apache.org/licenses/LICENSE-2.0 ;;; ;;; Unless required by applicable law or agreed to in writing, software ;;; distributed under the License is distributed on an "AS IS" BASIS, ;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ;;; See the License for the specific language governing permissions and ;;; limitations under the License. (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)