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

(define-module (chickadee render sprite)
  #:use-module (rnrs bytevectors)
  #:use-module (srfi srfi-4)
  #:use-module (srfi srfi-9)
  #:use-module (srfi srfi-11)
  #:use-module (chickadee math matrix)
  #:use-module (chickadee math rect)
  #:use-module (chickadee math vector)
  #:use-module (chickadee render)
  #:use-module (chickadee render color)
  #:use-module (chickadee render shader)
  #:use-module (chickadee render texture)
  #:use-module (chickadee render buffer)
  #:export (draw-sprite*
            draw-sprite
            with-batched-sprites
            draw-nine-patch*
            draw-nine-patch))

(define unbatched-sprite-shader
  (delay
    (strings->shader
     "
#version 130

in vec2 position;
in vec2 tex;
out vec2 fragTex;
uniform mat4 mvp;

void main(void) {
    fragTex = tex;
    gl_Position = mvp * vec4(position.xy, 0.0, 1.0);
}
"
     "
#version 130

in vec2 fragTex;
uniform sampler2D colorTexture;
uniform vec4 tint;

void main (void) {
    gl_FragColor = texture2D(colorTexture, fragTex) * tint;
}
")))

(define draw-sprite-unbatched
  (let* ((stride 16)            ; 4 f32s, 2 for vertex, 2 for texcoord
         (buffer (delay
                   (make-buffer #f
                                #:name "unbatched sprite buffer"
                                #:length (* stride 4)
                                #:stride stride
                                #:usage 'stream)))
         (pos (delay
                (make-typed-buffer #:name "unbatched sprite vertices"
                                   #:buffer (force buffer)
                                   #:type 'vec2
                                   #:component-type 'float
                                   #:length 4)))
         (tex (delay
                (make-typed-buffer #:name "unbatched sprite texcoords"
                                   #:buffer (force buffer)
                                   #:type 'vec2
                                   #:component-type 'float
                                   #:length 4
                                   #:offset 8)))
         (indices
          (delay
            (make-typed-buffer #:name "unbatched sprite indices"
                               #:type 'scalar
                               #:component-type 'unsigned-int
                               #:buffer (make-buffer (u32vector 0 3 2 0 2 1)
                                                     #:target 'index))))
         (vertex-array
          (delay
            (make-vertex-array #:indices (force indices)
                               #:attributes
                               `((0 . ,(force pos))
                                 (1 . ,(force tex))))))
         (mvp (make-null-matrix4)))
    (lambda (texture region world-matrix blend-mode texture-region tint)
      (with-mapped-typed-buffer (force pos)
        (let* ((x1 (rect-x region))
               (y1 (rect-y region))
               (x2 (+ x1 (rect-width region)))
               (y2 (+ y1 (rect-height region)))
               (s1 (rect-x texture-region))
               (t1 (rect-y texture-region))
               (s2 (+ (rect-x texture-region) (rect-width texture-region)))
               (t2 (+ (rect-y texture-region) (rect-height texture-region)))
               (bv (typed-buffer-data (force pos))))
          ;; Texture origin is at the top-left, so we need to flip the Y
          ;; coordinate relative to the vertices.
          (f32vector-set! bv 0 x1)
          (f32vector-set! bv 1 y1)
          (f32vector-set! bv 2 s1)
          (f32vector-set! bv 3 t2)
          (f32vector-set! bv 4 x2)
          (f32vector-set! bv 5 y1)
          (f32vector-set! bv 6 s2)
          (f32vector-set! bv 7 t2)
          (f32vector-set! bv 8 x2)
          (f32vector-set! bv 9 y2)
          (f32vector-set! bv 10 s2)
          (f32vector-set! bv 11 t1)
          (f32vector-set! bv 12 x1)
          (f32vector-set! bv 13 y2)
          (f32vector-set! bv 14 s1)
          (f32vector-set! bv 15 t1)))
      (with-blend-mode blend-mode
        (with-texture 0 texture
          (gpu-apply (force unbatched-sprite-shader) (force vertex-array)
                     #:tint tint
                     #:mvp (if world-matrix
                               (begin
                                 (matrix4-mult! mvp world-matrix
                                                (current-projection))
                                 mvp)
                               (current-projection))))))))


;;;
;;; Sprite Batch
;;;

(define-record-type <sprite-batch>
  (%make-sprite-batch texture blend-mode size capacity index-buffer
                      position-buffer texture-buffer vertex-array)
  sprite-batch?
  (texture sprite-batch-texture set-sprite-batch-texture!)
  (blend-mode sprite-batch-blend-mode set-sprite-batch-blend-mode!)
  (size sprite-batch-size set-sprite-batch-size!)
  (capacity sprite-batch-capacity set-sprite-batch-capacity!)
  (index-buffer sprite-batch-index-buffer set-sprite-batch-index-buffer!)
  (position-buffer sprite-batch-position-buffer set-sprite-batch-position-buffer!)
  (texture-buffer sprite-batch-texture-buffer set-sprite-batch-texture-buffer!)
  (vertex-array sprite-batch-vertex-array set-sprite-batch-vertex-array!))

(define (init-sprite-batch batch capacity)
  (let* ((index (make-streaming-typed-buffer 'scalar
                                             'unsigned-int
                                             (* capacity 6)
                                             #:target 'index))
         (stride 32) ; 8 f32s, 2 for vertex, 2 for texcoord, 4 for tint color
         (buffer (make-buffer #f
                              #:name "sprite batch buffer"
                              #:length (* capacity stride 4)
                              #:stride stride
                              #:usage 'stream))
         (pos (make-typed-buffer #:name "sprite batches vertices"
                                 #:buffer buffer
                                 #:type 'vec2
                                 #:component-type 'float
                                 #:length (* capacity 4)))
         (tex (make-typed-buffer #:name "batched-sprite-vertices"
                                 #:buffer buffer
                                 #:type 'vec2
                                 #:component-type 'float
                                 #:length (* capacity 4)
                                 #:offset 8))
         (tint (make-typed-buffer #:name "batched-sprite-tint"
                                  #:buffer buffer
                                  #:type 'vec4
                                  #:component-type 'float
                                  #:length (* capacity 4)
                                  #:offset 16))
         (va (make-vertex-array #:indices index
                                #:attributes `((0 . ,pos)
                                               (1 . ,tex)
                                               (2 . ,tint)))))
    (set-sprite-batch-capacity! batch capacity)
    (set-sprite-batch-index-buffer! batch index)
    (set-sprite-batch-position-buffer! batch pos)
    (set-sprite-batch-texture-buffer! batch tex)
    (set-sprite-batch-vertex-array! batch va)))

(define (make-sprite-batch capacity)
  "Make a sprite batch that can hold CAPACITY sprites."
  (let ((batch (%make-sprite-batch #f #f 0 0 #f #f #f #f)))
    (init-sprite-batch batch capacity)
    batch))

(define (sprite-batch-full? batch)
  (= (sprite-batch-capacity batch) (sprite-batch-size batch)))

(define (double-sprite-batch-size! batch)
  (let* ((old-index (sprite-batch-index-buffer batch))
         (old-verts (sprite-batch-position-buffer batch))
         (old-index-data (typed-buffer-data old-index))
         (old-vertex-data (typed-buffer-data old-verts)))
    (unmap-typed-buffer! old-index)
    (unmap-typed-buffer! old-verts)
    (init-sprite-batch batch (* (sprite-batch-capacity batch) 2))
    (sprite-batch-begin! batch)
    (let ((new-index (sprite-batch-index-buffer batch))
          (new-verts (sprite-batch-position-buffer batch)))
      (define (copy from to)
        (bytevector-copy! from 0
                          (typed-buffer-data to) 0
                          (bytevector-length from)))
      (copy old-index-data new-index)
      (copy old-vertex-data new-verts))))

(define (sprite-batch-reset! batch)
  "Reset BATCH to size 0."
  (set-sprite-batch-texture! batch #f)
  (set-sprite-batch-blend-mode! batch #f)
  (set-sprite-batch-size! batch 0))

(define (sprite-batch-begin! batch)
  (map-typed-buffer! (sprite-batch-index-buffer batch))
  (map-typed-buffer! (sprite-batch-position-buffer batch)))

(define batched-sprite-shader
  (delay
    (strings->shader
     "
#version 130

in vec2 position;
in vec2 tex;
in vec4 tint;
out vec2 fragTex;
out vec4 fragTint;
uniform mat4 mvp;

void main(void) {
    fragTex = tex;
    fragTint = tint;
    gl_Position = mvp * vec4(position.xy, 0.0, 1.0);
}
"
     "
#version 130

in vec2 fragTex;
in vec4 fragTint;
uniform sampler2D colorTexture;

void main (void) {
    gl_FragColor = texture2D(colorTexture, fragTex) * fragTint;
}
")))

(define (sprite-batch-flush! batch)
  "Render the contents of BATCH and clear the cache."
  (unless (zero? (sprite-batch-size batch))
    (with-blend-mode (sprite-batch-blend-mode batch)
      (with-texture 0 (sprite-batch-texture batch)
        (unmap-typed-buffer! (sprite-batch-index-buffer batch))
        (unmap-typed-buffer! (sprite-batch-position-buffer batch))
        (gpu-apply* (force batched-sprite-shader)
                    (sprite-batch-vertex-array batch)
                    (* (sprite-batch-size batch) 6)
                    #:mvp (current-projection))
        (sprite-batch-reset! batch)))))

(define (sprite-batch-add! batch texture region world-matrix blend-mode
                           texture-region tint)
  ;; Expand the buffers when necessary.
  (when (sprite-batch-full? batch)
    (double-sprite-batch-size! batch))
  ;; Flush the batch if any GL state needs changing.
  (unless (and (eq? (sprite-batch-texture batch) texture)
               (eq? (sprite-batch-blend-mode batch) blend-mode))
    (sprite-batch-flush! batch)
    (sprite-batch-begin! batch)
    (set-sprite-batch-texture! batch texture)
    (set-sprite-batch-blend-mode! batch blend-mode))
  (let ((size (sprite-batch-size batch)))
    (let* ((indices (typed-buffer-data (sprite-batch-index-buffer batch)))
           (vertices (typed-buffer-data (sprite-batch-position-buffer batch)))
           (index-offset (* size 6))
           (offset (* size 32))
           (minx (rect-x region))
           (miny (rect-y region))
           (maxx (+ minx (rect-width region)))
           (maxy (+ miny (rect-height region)))
           (x1 (transform-x world-matrix minx miny))
           (y1 (transform-y world-matrix minx miny))
           (x2 (transform-x world-matrix maxx miny))
           (y2 (transform-y world-matrix maxx miny))
           (x3 (transform-x world-matrix maxx maxy))
           (y3 (transform-y world-matrix maxx maxy))
           (x4 (transform-x world-matrix minx maxy))
           (y4 (transform-y world-matrix minx maxy))
           (s1 (rect-x texture-region))
           (t1 (rect-y texture-region))
           (s2 (+ (rect-x texture-region) (rect-width texture-region)))
           (t2 (+ (rect-y texture-region) (rect-height texture-region))))
      ;; Add indices.
      (let ((index-vertex-offset (* size 4)))
        (u32vector-set! indices index-offset index-vertex-offset)
        (u32vector-set! indices (+ index-offset 1) (+ index-vertex-offset 3))
        (u32vector-set! indices (+ index-offset 2) (+ index-vertex-offset 2))
        (u32vector-set! indices (+ index-offset 3) index-vertex-offset)
        (u32vector-set! indices (+ index-offset 4) (+ index-vertex-offset 2))
        (u32vector-set! indices (+ index-offset 5) (+ index-vertex-offset 1)))
      ;; Add vertices.
      ;; Bottom-left
      (f32vector-set! vertices offset x1)
      (f32vector-set! vertices (+ offset 1) y1)
      ;; Bottom-right
      (f32vector-set! vertices (+ offset 8) x2)
      (f32vector-set! vertices (+ offset 9) y2)
      ;; Top-right
      (f32vector-set! vertices (+ offset 16) x3)
      (f32vector-set! vertices (+ offset 17) y3)
      ;; Top-left
      (f32vector-set! vertices (+ offset 24) x4)
      (f32vector-set! vertices (+ offset 25) y4)
      ;; Add texture coordinates.
      ;; Bottom-left
      (f32vector-set! vertices (+ offset 2) s1)
      (f32vector-set! vertices (+ offset 3) t2)
      ;; Bottom-right
      (f32vector-set! vertices (+ offset 10) s2)
      (f32vector-set! vertices (+ offset 11) t2)
      ;; Top-right
      (f32vector-set! vertices (+ offset 18) s2)
      (f32vector-set! vertices (+ offset 19) t1)
      ;; Top-left
      (f32vector-set! vertices (+ offset 26) s1)
      (f32vector-set! vertices (+ offset 27) t1)
      ;; Add tint.
      (let ((bv ((@@ (chickadee render color) unwrap-color) tint))
            (byte-offset (* offset 4)))
        (bytevector-copy! bv 0 vertices (+ byte-offset 16) 16)
        (bytevector-copy! bv 0 vertices (+ byte-offset 48) 16)
        (bytevector-copy! bv 0 vertices (+ byte-offset 80) 16)
        (bytevector-copy! bv 0 vertices (+ byte-offset 112) 16))
      (set-sprite-batch-size! batch (1+ size)))))

(define *batch?* #f)
(define %batch (delay (make-sprite-batch 256)))

(define (draw-sprite-batched texture region world-matrix blend-mode
                             texture-region tint)
  (sprite-batch-add! (force %batch) texture region world-matrix blend-mode
                     texture-region tint))

(define-syntax-rule (with-batched-sprites body ...)
  "Use batched rendering for all draw-sprite calls within BODY."
  (if *batch?*
      (begin body ...)
      (dynamic-wind
        (lambda ()
          (set! *batch?* #t))
        (lambda ()
          (sprite-batch-reset! (force %batch))
          body ...
          (sprite-batch-flush! (force %batch)))
        (lambda ()
          (set! *batch?* #f)))))

(define* (draw-sprite* texture rect matrix #:key
                       (tint white)
                       (blend-mode 'alpha)
                       (texcoords (texture-gl-tex-rect texture)))
  (if *batch?*
      (draw-sprite-batched texture rect matrix blend-mode
                           texcoords tint)
      (draw-sprite-unbatched texture rect matrix blend-mode
                             texcoords tint)))

(define %null-vec2 (vec2 0.0 0.0))
(define %default-scale (vec2 1.0 1.0))

(define draw-sprite
  (let ((matrix (make-null-matrix4)))
    (lambda* (texture
              position
              #:key
              (tint white)
              (origin %null-vec2)
              (scale %default-scale)
              (rotation 0.0)
              (blend-mode 'alpha)
              (rect (texture-gl-rect texture)))
      "Draw TEXTURE at POSITION.

Optionally, other transformations may be applied to the sprite.
ROTATION specifies the angle to rotate the sprite, in radians.  SCALE
specifies the scaling factor as a 2D vector.  All transformations are
applied relative to ORIGIN, a 2D vector.

TINT specifies the color to multiply against all the sprite's pixels.
By default white is used, which does no tinting at all.

By default, alpha blending is used but can be changed by specifying
BLEND-MODE."
      (matrix4-2d-transform! matrix
                             #:origin origin
                             #:position position
                             #:rotation rotation
                             #:scale scale)
      (draw-sprite* texture rect matrix
                    #:tint tint
                    #:blend-mode blend-mode))))


;;;
;;; Nine Patches
;;;

(define draw-nine-patch*
  (let ((%rect (make-rect 0.0 0.0 0.0 0.0))
        (texcoords (make-rect 0.0 0.0 0.0 0.0)))
    (lambda* (texture
              rect
              matrix
              #:key
              (margin 0.0)
              (top-margin margin)
              (bottom-margin margin)
              (left-margin margin)
              (right-margin margin)
              (blend-mode 'alpha)
              (tint white))
      (let* ((x (rect-x rect))
             (y (rect-y rect))
             (w (rect-width rect))
             (h (rect-height rect))
             (border-x1 x)
             (border-y1 y)
             (border-x2 (+ x w))
             (border-y2 (+ y h))
             (fill-x1 (+ border-x1 left-margin))
             (fill-y1 (+ border-y1 bottom-margin))
             (fill-x2 (- border-x2 right-margin))
             (fill-y2 (- border-y2 top-margin))
             (prect (texture-gl-rect texture))
             (trect (texture-gl-tex-rect texture))
             (tw (rect-width prect))
             (th (rect-height prect))
             (border-s1 (rect-x trect))
             (border-t1 (rect-y trect))
             (border-s2 (+ (rect-x trect) (rect-width trect)))
             (border-t2 (+ (rect-y trect) (rect-height trect)))
             (fill-s1 (+ border-s1 (/ left-margin tw)))
             (fill-t1 (+ border-t1 (/ top-margin th)))
             (fill-s2 (- border-s2 (/ right-margin tw)))
             (fill-t2 (- border-t2 (/ bottom-margin th))))
        (define (draw-piece x1 y1 x2 y2 s1 t1 s2 t2)
          (set-rect-x! %rect x1)
          (set-rect-y! %rect y1)
          (set-rect-width! %rect (- x2 x1))
          (set-rect-height! %rect (- y2 y1))
          (set-rect-x! texcoords s1)
          (set-rect-y! texcoords t1)
          (set-rect-width! texcoords (- s2 s1))
          (set-rect-height! texcoords (- t2 t1))
          (draw-sprite* texture %rect matrix
                        #:texcoords texcoords
                        #:blend-mode blend-mode
                        #:tint tint))
        (with-batched-sprites
         ;; bottom-left
         (draw-piece border-x1 border-y1 fill-x1 fill-y1
                     border-s1 fill-t2 fill-s1 border-t2)
         ;; bottom-center
         (draw-piece fill-x1 border-y1 fill-x2 fill-y1
                     fill-s1 fill-t2 fill-s2 border-t2)
         ;; bottom-right
         (draw-piece fill-x2 border-y1 border-x2 fill-y1
                     fill-s2 fill-t2 border-s2 border-t2)
         ;; center-left
         (draw-piece border-x1 fill-y1 fill-x1 fill-y2
                     border-s1 fill-t2 fill-s1 fill-t1)
         ;; center
         (draw-piece fill-x1 fill-y1 fill-x2 fill-y2
                     fill-s1 fill-t2 fill-s2 fill-t1)
         ;; center-right
         (draw-piece fill-x2 fill-y1 border-x2 fill-y2
                     fill-s2 fill-t2 border-s2 fill-t1)
         ;; top-left
         (draw-piece border-x1 fill-y2 fill-x1 border-y2
                     border-s1 border-t1 fill-s1 fill-t1)
         ;; top-center
         (draw-piece fill-x1 fill-y2 fill-x2 border-y2
                     fill-s1 border-t1 fill-s2 fill-t1)
         ;; top-right
         (draw-piece fill-x2 fill-y2 border-x2 border-y2
                     fill-s2 border-t1 border-s2 fill-t1))))))

(define draw-nine-patch
  (let ((position (vec2 0.0 0.0))
        (%rect (make-rect 0.0 0.0 0.0 0.0))
        (matrix (make-null-matrix4)))
    (lambda* (texture
              rect
              #:key
              (margin 0.0)
              (top-margin margin) (bottom-margin margin)
              (left-margin margin) (right-margin margin)
              (origin %null-vec2)
              (rotation 0.0)
              (scale %default-scale)
              (blend-mode 'alpha)
              (tint white))
      "Draw a \"nine patch\" sprite.  A nine patch sprite renders
TEXTURE on the rectangular area RECT whose stretchable areas are
defined by the given margin measurements.  The corners are never
stretched, the left and right edges may be stretched vertically, the
top and bottom edges may be stretched horizontally, and the center may
be stretched in both directions.  This rendering technique is
particularly well suited for resizable windows and buttons in
graphical user interfaces.

MARGIN specifies the margin size for all sides of the nine patch.  To
make margins of differing sizes, the TOP-MARGIN, BOTTOM-MARGIN,
LEFT-MARGIN, and RIGHT-MARGIN arguments may be used."
      (set-rect-x! %rect 0.0)
      (set-rect-y! %rect 0.0)
      (set-rect-width! %rect (rect-width rect))
      (set-rect-height! %rect (rect-height rect))
      (set-vec2-x! position (rect-x rect))
      (set-vec2-y! position (rect-y rect))
      (matrix4-2d-transform! matrix
                             #:origin origin
                             #:position position
                             #:rotation rotation
                             #:scale scale)
      (draw-nine-patch* texture %rect matrix
                        #:top-margin top-margin
                        #:bottom-margin bottom-margin
                        #:left-margin left-margin
                        #:right-margin right-margin
                        #:blend-mode blend-mode
                        #:tint tint))))