;;; Chickadee Game Toolkit
;;; Copyright © 2016 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:
;;
;; Vertex buffers and vertex arrays.
;;
;;; Code:

(define-module (chickadee render vertex-buffer)
  #:use-module (ice-9 format)
  #:use-module (ice-9 match)
  #:use-module (oop goops)
  #:use-module (rnrs bytevectors)
  #:use-module (srfi srfi-4)
  #:use-module (srfi srfi-9)
  #:use-module (srfi srfi-9 gnu)
  #:use-module (gl)
  #:use-module (system foreign)
  #:use-module (chickadee render gl)
  #:use-module (chickadee render gpu)
  #:export (make-vertex-buffer
            make-streaming-vertex-buffer
            vertex-buffer?
            index-buffer?
            vertex-buffer-type
            vertex-buffer-usage
            vertex-buffer-data
            null-vertex-buffer
            map-vertex-buffer!
            unmap-vertex-buffer!
            with-mapped-vertex-buffer
            *vertex-buffer-state*

            make-vertex-array
            vertex-array?
            vertex-array-index-buffer
            vertex-array-attribute-buffers
            null-vertex-array
            *vertex-array-state*

            render-vertices))

;;;
;;; Vertex Buffers
;;;

(define-record-type <vertex-buffer>
  (%make-vertex-buffer id type usage data)
  vertex-buffer?
  (id vertex-buffer-id)
  (type vertex-buffer-type)
  (usage vertex-buffer-usage)
  (data vertex-buffer-data set-vertex-buffer-data!))

(set-record-type-printer! <vertex-buffer>
  (lambda (vb port)
    (format port
            "#<vertex-buffer type: ~a usage: ~a>"
            (vertex-buffer-type vb)
            (vertex-buffer-usage vb))))

(define (index-buffer? vb)
  "Return #t if VB is of type 'index'."
  (eq? (vertex-buffer-type vb) 'index))

(define null-vertex-buffer (%make-vertex-buffer 0 #f 'static #f))

(define <<vertex-buffer>> (class-of null-vertex-buffer))

(define (free-vertex-buffer vb)
  (gl-delete-buffers 1 (u32vector (vertex-buffer-id vb))))

(define-method (gpu-finalize (vb <<vertex-buffer>>))
  (free-vertex-buffer vb))

(define (vertex-buffer-length vb)
  (bytevector-length (vertex-buffer-data vb)))

(define (type-size type)
  (match type
    ((or 'float 'index) 1)
    ('vec2 2)
    ('vec3 3)
    ('vec4 4)))

(define (vertex-buffer-attribute-size vb)
  (type-size (vertex-buffer-type vb)))

(define (apply-vertex-buffer vb)
  (gl-bind-buffer (vertex-buffer-target-gl vb)
                  (vertex-buffer-id vb)))

(define *vertex-buffer-state*
  (make-gpu-state apply-vertex-buffer null-vertex-buffer))

(define (vertex-buffer-target-gl vb)
  (if (index-buffer? vb)
      (arb-vertex-buffer-object element-array-buffer-arb)
      (arb-vertex-buffer-object array-buffer-arb)))

(define (vertex-buffer-usage-gl vb)
  (match (vertex-buffer-usage vb)
    ('static (arb-vertex-buffer-object static-draw-arb))
    ('stream (arb-vertex-buffer-object stream-draw-arb))))

(define (generate-vertex-buffer-gl)
  (let ((bv (u32vector 1)))
    (gl-gen-buffers 1 (bytevector->pointer bv))
    (u32vector-ref bv 0)))

(define (make-vertex-buffer type usage bv)
  "Upload BV, a bytevector of TYPE elements, to the GPU as a vertex
buffer.

USAGE provides a hint to the GPU as to how the vertex buffer will be
used:

- static: The vertex buffer will not be updated after creation.
- stream: The vertex buffer will be dynamically updated frequently."
  ;; Weird bugs will occur when creating a new vertex buffer while a
  ;; vertex array is bound.
  (gpu-state-set! *vertex-array-state* null-vertex-array)
  (let ((vb (gpu-guard
             (%make-vertex-buffer (generate-vertex-buffer-gl)
                                  type
                                  usage
                                  bv))))
    (gpu-state-set! *vertex-buffer-state* vb)
    (gl-buffer-data (vertex-buffer-target-gl vb)
                    (bytevector-length bv)
                    (bytevector->pointer bv)
                    (vertex-buffer-usage-gl vb))
    (gpu-state-set! *vertex-buffer-state* null-vertex-buffer)
    vb))

(define (make-streaming-vertex-buffer type length)
  "Return a new vertex buffer of LENGTH elements suitable for
streaming data to the GPU every frame.  TYPE is a symbol specifying
the element type, either 'float', 'index', 'vec2', 'vec3', or 'vec4'."
  (make-vertex-buffer type 'stream
                      ;; TODO: Don't assume all numbers are 32-bit.
                      (make-bytevector (* (type-size type) length 4))))

(define (map-vertex-buffer! vb)
  "Map the memory space for VB from the GPU to the CPU, allowing the
vertex buffer to be updated with new vertex data.  The
'unmap-vertex-buffer!' procedure must be called to submit the new
vertex buffer data back to the GPU."
  (let ((target (vertex-buffer-target-gl vb))
        (length (vertex-buffer-length vb))
        (usage (vertex-buffer-usage-gl vb)))
    (gpu-state-set! *vertex-buffer-state* vb)
    ;; Orphan the buffer to avoid implicit synchronization.
    ;; See: https://www.opengl.org/wiki/Buffer_Object_Streaming#Buffer_re-specification
    (gl-buffer-data target length %null-pointer usage)
    (let ((ptr (gl-map-buffer target (version-1-5 read-write))))
      (set-vertex-buffer-data! vb (pointer->bytevector ptr length)))))

(define (unmap-vertex-buffer! vb)
  "Return the mapped vertex buffer data for VB to the GPU."
  (gpu-state-set! *vertex-buffer-state* vb)
  (gl-unmap-buffer (vertex-buffer-target-gl vb)))

(define-syntax-rule (with-mapped-vertex-buffer vb body ...)
  (dynamic-wind
    (lambda ()
      (map-vertex-buffer! vb))
    (lambda () body ...)
    (lambda ()
      (unmap-vertex-buffer! vb))))


;;;
;;; Vertex Arrays
;;;

(define-record-type <vertex-array>
  (%make-vertex-array id index-buffer attribute-buffers)
  vertex-array?
  (id vertex-array-id)
  (index-buffer vertex-array-index-buffer)
  (attribute-buffers vertex-array-attribute-buffers))

(set-record-type-printer! <vertex-array>
  (lambda (va port)
    (format port
            "#<vertex-array index-buffer: ~a attribute-buffers: ~a>"
            (vertex-array-index-buffer va)
            (vertex-array-attribute-buffers va))))

(define null-vertex-array (%make-vertex-array 0 #f '()))

(define <<vertex-array>> (class-of null-vertex-array))

(define (generate-vertex-array)
  (let ((bv (u32vector 1)))
    (gl-gen-vertex-arrays 1 (bytevector->pointer bv))
    (u32vector-ref bv 0)))

(define (free-vertex-array va)
  (gl-delete-vertex-arrays 1 (u32vector (vertex-array-id va))))

(define-method (gpu-finalize (va <<vertex-array>>))
  (free-vertex-array va))

(define (apply-vertex-array va)
  (gl-bind-vertex-array (vertex-array-id va)))

(define *vertex-array-state*
  (make-gpu-state apply-vertex-array null-vertex-array))

(define (make-vertex-array index-buffer . attribute-buffers)
  (let ((va (gpu-guard
             (%make-vertex-array (generate-vertex-array)
                                 index-buffer
                                 attribute-buffers))))
    (gpu-state-set! *vertex-array-state* va)
    ;; Configure all attribute buffers starting from attribute
    ;; location 0.
    (let loop ((attrs attribute-buffers)
               (index 0))
      (match attrs
        (() #f)
        ((attr . rest)
         (gl-enable-vertex-attrib-array index)
         (gpu-state-set! *vertex-buffer-state* attr)
         (gl-vertex-attrib-pointer index
                                   (vertex-buffer-attribute-size attr)
                                   (data-type float)
                                   #f
                                   0
                                   %null-pointer)
         (loop rest (1+ index)))))
    (gpu-state-set! *vertex-buffer-state* index-buffer)
    (gpu-state-set! *vertex-array-state* null-vertex-array)
    va))

(define* (render-vertices #:optional count)
  (gl-draw-elements (begin-mode triangles)
                    (or count
                        (u32vector-length
                         (vertex-buffer-data
                          (vertex-array-index-buffer
                           (gpu-state-ref *vertex-array-state*)))))
                    (data-type unsigned-int)
                    %null-pointer))