;;; 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.

;;; Commentary
;;
;; Polygon face rendering configuration.
;;
;;; Code:

(define-module (chickadee graphics polygon)
  #:use-module (chickadee graphics engine)
  #:use-module (chickadee graphics gl)
  #:use-module (gl)
  #:use-module (ice-9 match)
  #:use-module (srfi srfi-9)
  #:export (make-polygon-mode
            polygon-mode?
            polygon-mode-front
            polygon-mode-back
            fill-polygon-mode
            line-polygon-mode
            point-polygon-mode
            g:polygon-mode
            current-polygon-mode

            cull-face-mode?
            cull-face-mode-front?
            cull-face-mode-back?
            no-cull-face-mode
            back-cull-face-mode
            front-cull-face-mode
            front-and-back-cull-face-mode
            g:cull-face-mode
            current-cull-face-mode))

(define-record-type <polygon-mode>
  (make-polygon-mode front back)
  polygon-mode?
  (front polygon-mode-front)
  (back polygon-mode-back))

(define fill-polygon-mode (make-polygon-mode 'fill 'fill))
(define line-polygon-mode (make-polygon-mode 'line 'line))
(define point-polygon-mode (make-polygon-mode 'point 'point))

(define (bind-polygon-mode mode)
  (define (glmode sym)
    (match sym
      ('fill (polygon-mode fill))
      ('line (polygon-mode line))
      ('point (polygon-mode point))))
  (let ((front (polygon-mode-front mode))
        (back (polygon-mode-back mode)))
    (if (eq? front back)
        (gl-polygon-mode (cull-face-mode front-and-back) (glmode front))
        (begin
          (gl-polygon-mode (cull-face-mode front) (glmode front))
          (gl-polygon-mode (cull-face-mode back) (glmode back))))))

(define-graphics-state g:polygon-mode
  current-polygon-mode
  #:default fill-polygon-mode
  #:bind bind-polygon-mode)

(define-record-type <cull-face-mode>
  (make-cull-face-mode front? back?)
  cull-face-mode?
  (front? cull-face-mode-front?)
  (back? cull-face-mode-back?))

(define no-cull-face-mode (make-cull-face-mode #f #f))
(define back-cull-face-mode (make-cull-face-mode #f #t))
(define front-cull-face-mode (make-cull-face-mode #t #f))
(define front-and-back-cull-face-mode (make-cull-face-mode #t #t))

(define (bind-cull-face-mode mode)
  (let ((front? (cull-face-mode-front? mode))
        (back? (cull-face-mode-back? mode)))
    (cond
     ((and front? back?)
      (gl-enable (enable-cap cull-face))
      (gl-cull-face (cull-face-mode front-and-back)))
     (front?
      (gl-enable (enable-cap cull-face))
      (gl-cull-face (cull-face-mode front)))
     (back?
      (gl-enable (enable-cap cull-face))
      (gl-cull-face (cull-face-mode back)))
     (else
      (gl-disable (enable-cap cull-face))))))

(define-graphics-state g:cull-face-mode
  current-cull-face-mode
  #:default back-cull-face-mode
  #:bind bind-cull-face-mode)