;;; Chickadee Game Toolkit
;;; Copyright © 2017 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:
;;
;; 3D scene graph with physically based rendering.
;;
;;; Code:

(define-module (chickadee render scene)
  #:use-module (chickadee config)
  #:use-module (chickadee math matrix)
  #:use-module (chickadee math quaternion)
  #:use-module (chickadee math vector)
  #:use-module (chickadee render)
  #:use-module (chickadee render color)
  #:use-module (chickadee render buffer)
  #:use-module (chickadee render texture)
  #:use-module (chickadee render shader)
  #:use-module (srfi srfi-9)
  #:use-module (srfi srfi-9 gnu)
  #:export (make-metallic-roughness
            default-metallic-roughness
            metallic-roughness?
            metallic-roughness-base-color
            metallic-roughness-base-color-texture
            metallic-roughness-metallic-factor
            metallic-roughness-roughness-factor
            metallic-roughness-texture
            make-material
            default-material
            material?
            material-name
            material-metallic-roughness
            material-normal-texture
            material-occlusion-texture
            material-emissive-texture
            material-emissive-factor
            material-alpha-mode
            material-alpha-cutoff
            material-double-sided?
            pbr-shader
            make-primitive
            primitive?
            primitive-vertex-array
            primitive-material
            primitive-targets
            make-mesh
            mesh?
            mesh-name
            mesh-primitives
            mesh-weights
            make-scene-node
            scene-node?
            scene-node-name
            scene-node-children
            scene-node-camera
            scene-node-skin
            scene-node-matrix
            scene-node-mesh
            scene-node-rotation
            scene-node-scale
            scene-node-translation
            scene-node-weights
            make-scene
            scene?
            scene-name
            scene-nodes
            draw-scene))

(define-record-type <metallic-roughness>
  (%make-metallic-roughness base-color base-color-texture metallic-factor
                            roughness-factor texture)
  metallic-roughness?
  (base-color metallic-roughness-base-color)
  (base-color-texture metallic-roughness-base-color-texture)
  (metallic-factor metallic-roughness-metallic-factor)
  (roughness-factor metallic-roughness-roughness-factor)
  (texture metallic-roughness-texture))

(define* (make-metallic-roughness #:key
                                  (base-color white)
                                  base-color-texture
                                  (metallic-factor 1.0)
                                  (roughness-factor 1.0)
                                  texture)
  (%make-metallic-roughness base-color base-color-texture metallic-factor
                            roughness-factor texture))

(define default-metallic-roughness (make-metallic-roughness))

(define-record-type <material>
  (%make-material name metallic-roughness normal-texture occlusion-texture
                  emissive-texture emissive-factor alpha-mode alpha-cutoff
                  double-sided?)
  material?
  (name material-name)
  (metallic-roughness material-metallic-roughness)
  (normal-texture material-normal-texture)
  (occlusion-texture material-occlusion-texture)
  (emissive-texture material-emissive-texture)
  (emissive-factor material-emissive-factor)
  (alpha-mode material-alpha-mode)
  (alpha-cutoff material-alpha-cutoff)
  (double-sided? material-double-sided?))

(define* (make-material #:key
                        (name "anonymous")
                        (metallic-roughness default-metallic-roughness)
                        normal-texture
                        occlusion-texture
                        emissive-texture
                        (emissive-factor (vec3 0.0 0.0 0.0))
                        (alpha-mode 'opaque)
                        (alpha-cutoff 0.5)
                        double-sided?)
  (%make-material name metallic-roughness normal-texture occlusion-texture
                  emissive-texture emissive-factor alpha-mode alpha-cutoff
                  double-sided?))

(define default-material (make-material))

(define pbr-shader
  (let ((shader
         (delay
           (load-shader (scope-datadir "shaders/pbr/pbr-vert.glsl")
                        (scope-datadir "shaders/pbr/pbr-frag.glsl")))))
    (lambda ()
      (force shader))))

(define-record-type <primitive>
  (%make-primitive vertex-array material targets)
  primitive?
  (vertex-array primitive-vertex-array)
  (material primitive-material)
  (targets primitive-targets))

(define* (make-primitive #:key
                         vertex-array
                         (material default-material)
                         targets)
  (%make-primitive vertex-array material targets))

(define-record-type <mesh>
  (%make-mesh name primitives weights)
  mesh?
  (name mesh-name)
  (primitives mesh-primitives)
  (weights mesh-weights))

(define* (make-mesh #:key
                    (name "anonymous")
                    primitives
                    weights)
  (%make-mesh name primitives weights))

(define-record-type <scene-node>
  (%make-scene-node name children camera skin matrix mesh
                    rotation scale translation weights)
  node?
  (name scene-node-name)
  (children scene-node-children)
  (camera scene-node-camera)
  (skin scene-node-skin)
  (matrix scene-node-matrix)
  (mesh scene-node-mesh)
  (rotation scene-node-rotation)
  (scale scene-node-scale)
  (translation scene-node-translation)
  (weights scene-node-weights))

(define* (make-scene-node #:key
                          (name "anonymous")
                          (children #())
                          camera
                          skin
                          (matrix (make-identity-matrix4))
                          mesh
                          (rotation (quaternion 0.0 0.0 0.0 1.0))
                          (scale (vec3 1.0 1.0 1.0))
                          (translation (vec3 0.0 0.0 0.0))
                          weights)
  (%make-scene-node name children camera skin matrix mesh
                    rotation scale translation weights))

(define-record-type <scene>
  (%make-scene name nodes)
  scene?
  (name scene-name)
  (nodes scene-nodes))

(define* (make-scene #:key (name "anonymous") (nodes '()))
  (%make-scene name nodes))

(define modelview
  (make-matrix4 1.0 0.0 0.0 0.0
                0.0 1.0 0.0 0.0
                0.0 0.0 1.0 0.0
                0.0 0.0 1.0 1.0)
  ;;(make-identity-matrix4)
  )

(define (draw-primitive primitive matrix)
  ;; TODO: Use material.
  ;; TODO: Actually use physically based rendering.
  (gpu-apply (pbr-shader)
             (primitive-vertex-array primitive)
             #:mvp (matrix4* modelview (current-projection))
             ))

(define (draw-mesh mesh matrix)
  (for-each (lambda (primitive)
              (draw-primitive primitive matrix))
            (mesh-primitives mesh)))

(define (draw-scene-node node matrix)
  ;; TODO: Apply transformation matrix.
  (let ((world-matrix (matrix4* matrix (scene-node-matrix node))))
    (when (scene-node-mesh node)
      (draw-mesh (scene-node-mesh node) world-matrix))
    (for-each (lambda (node)
                (draw-scene-node node world-matrix))
              (scene-node-children node))))

(define (draw-scene scene)
  (for-each (lambda (scene)
              (draw-scene-node scene (make-identity-matrix4)))
            (scene-nodes scene)))