;;; Chickadee Game Toolkit
;;; Copyright © 2020, 2021 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/>.

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