;;; Chickadee Game Toolkit
;;; Copyright © 2020, 2021 David Thompson <dthompson2@worcester.edu>
;;;
;;; 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 stencil)
  #: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-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
            g:stencil-test
            current-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* (bind-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))))

(define-graphics-state g:stencil-test
  current-stencil-test
  #:default default-stencil-test
  #:bind bind-stencil-test)