;;; Chickadee Game Toolkit
;;; Copyright © 2016, 2019, 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.

(define-module (chickadee graphics 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 graphics blend)
  #:use-module (chickadee graphics color)
  #:use-module (chickadee graphics engine)
  #:use-module (chickadee graphics shader)
  #:use-module (chickadee graphics texture)
  #:use-module (chickadee graphics buffer)
  #:export (draw-sprite*
            draw-sprite

            make-sprite-batch
            sprite-batch?
            sprite-batch-texture
            set-sprite-batch-texture!
            sprite-batch-clear!
            sprite-batch-add*
            sprite-batch-add!
            draw-sprite-batch*
            draw-sprite-batch

            with-batched-sprites
            draw-nine-patch*
            draw-nine-patch))

(define-geometry-type <sprite-vertex>
  sprite-vertex-ref
  sprite-vertex-set!
  sprite-vertex-append!
  (position vec2)
  (texture vec2))

(define-graphics-variable sprite-geometry
  (make-geometry <sprite-vertex> 4 #:index-capacity 6))
(define-graphics-variable sprite-model-matrix (make-null-matrix4))
(define-graphics-variable sprite-mvp-matrix (make-null-matrix4))
(define-graphics-variable sprite-shader
  (strings->shader
   "
#ifdef GLSL330
layout (location = 0) in vec2 position;
layout (location = 1) in vec2 tex;
#elif defined(GLSL130)
in vec2 position;
in vec2 tex;
#elif defined(GLSL120)
attribute vec2 position;
attribute vec2 tex;
#endif
#ifdef GLSL120
varying vec2 fragTex;
#else
out vec2 fragTex;
#endif
uniform mat4 mvp;

void main(void) {
    fragTex = tex;
    gl_Position = mvp * vec4(position.xy, 0.0, 1.0);
}
"
   "
#ifdef GLSL120
varying vec2 fragTex;
#else
in vec2 fragTex;
#endif
#ifdef GLSL330
out vec4 fragColor;
#endif
uniform sampler2D colorTexture;
uniform vec4 tint;

void main (void) {
#ifdef GLSL330
    fragColor = texture(colorTexture, fragTex) * tint;
#else
    gl_FragColor = texture2D(colorTexture, fragTex) * tint;
#endif
}
"))

(define* (draw-sprite* texture
                       rect
                       matrix
                       #:key
                       (tint white)
                       (blend-mode blend:alpha)
                       (texcoords (texture-gl-tex-rect texture)))
  (let ((shader (graphics-variable-ref sprite-shader))
        (geometry (graphics-variable-ref sprite-geometry))
        (mvp (graphics-variable-ref sprite-mvp-matrix)))
    (with-geometry geometry
      (let* ((x1 (rect-x rect))
             (y1 (rect-y rect))
             (x2 (+ x1 (rect-width rect)))
             (y2 (+ y1 (rect-height rect)))
             (s1 (rect-x texcoords))
             (t1 (rect-y texcoords))
             (s2 (+ (rect-x texcoords) (rect-width texcoords)))
             (t2 (+ (rect-y texcoords) (rect-height texcoords))))
        (sprite-vertex-append! geometry
                               (x1 y1 s1 t1)
                               (x2 y1 s2 t1)
                               (x2 y2 s2 t2)
                               (x1 y2 s1 t2))
        (geometry-index-append! geometry 0 3 2 0 2 1)))
    (with-graphics-state ((g:blend-mode blend-mode)
                          (g:texture-0 texture))
      (shader-apply shader
                    (geometry-vertex-array geometry)
                    #:tint tint
                    #:mvp (if matrix
                              (begin
                                (matrix4-mult! mvp matrix
                                               (current-projection))
                                mvp)
                              (current-projection))))))

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

(define* (draw-sprite texture
                      position
                      #:key
                      (blend-mode blend:alpha)
                      (origin %null-vec2)
                      (rect (texture-gl-rect texture))
                      (rotation 0.0)
                      (scale %default-scale)
                      (shear %default-shear)
                      (tint white))
  "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."
  (let ((matrix (graphics-variable-ref sprite-model-matrix)))
    (matrix4-2d-transform! matrix
                           #:origin origin
                           #:position position
                           #:rotation rotation
                           #:scale scale
                           #:shear shear)
    (draw-sprite* texture rect matrix
                  #:tint tint
                  #:blend-mode blend-mode)))


;;;
;;; Sprite Batches
;;;

(define-geometry-type <batched-sprite-vertex>
  batched-sprite-ref
  batched-sprite-set!
  batched-sprite-append!
  (position vec2)
  (texture vec2)
  (tint vec4))

(define-graphics-variable sprite-batch-shader
  (strings->shader
   "
#ifdef GLSL330
layout (location = 0) in vec2 position;
layout (location = 1) in vec2 tex;
layout (location = 2) in vec4 tint;
#elif defined(GLSL130)
in vec2 position;
in vec2 tex;
in vec4 tint;
#elif defined(GLSL120)
attribute vec2 position;
attribute vec2 tex;
attribute vec4 tint;
#endif
#ifdef GLSL120
varying vec2 fragTex;
varying vec4 fragTint;
#else
out vec2 fragTex;
out vec4 fragTint;
#endif
uniform mat4 mvp;

void main(void) {
    fragTex = tex;
    fragTint = tint;
    gl_Position = mvp * vec4(position.xy, 0.0, 1.0);
}
"
   "
#ifdef GLSL120
varying vec2 fragTex;
varying vec4 fragTint;
#else
in vec2 fragTex;
in vec4 fragTint;
#endif
#ifdef GLSL330
out vec4 fragColor;
#endif
uniform sampler2D colorTexture;

void main (void) {
#ifdef GLSL330
    fragColor = texture(colorTexture, fragTex) * fragTint;
#else
    gl_FragColor = texture2D(colorTexture, fragTex) * fragTint;
#endif
}
"))

(define-record-type <sprite-batch>
  (%make-sprite-batch texture geometry size)
  sprite-batch?
  (texture sprite-batch-texture set-sprite-batch-texture!)
  (geometry sprite-batch-geometry)
  (size sprite-batch-size set-sprite-batch-size!))

(define* (make-sprite-batch texture #:key (capacity 256))
  "Make a sprite batch that can hold CAPACITY sprites before needing
to resize."
  (%make-sprite-batch texture
                      (make-geometry <batched-sprite-vertex> (* capacity 4)
                                     #:index-capacity (* capacity 6))
                      0))

(define (sprite-batch-clear! batch)
  "Reset BATCH to size 0."
  (set-sprite-batch-size! batch 0)
  (geometry-begin! (sprite-batch-geometry batch)))

(define (sprite-batch-flush! batch)
  "Submit the contents of BATCH to the GPU."
  (geometry-end! (sprite-batch-geometry batch)))

(define* (sprite-batch-add* batch rect matrix
                            #:key
                            (tint white)
                            texture-region)
  "Add RECT, transformed by MATRIX, to BATCH.  To render a subsection
of the batch's texture, a texture object whose parent is the batch
texture may be specified via the TEXTURE-REGION argument."
  (let* ((geometry (sprite-batch-geometry batch))
         (vertex-offset (geometry-vertex-count geometry <batched-sprite-vertex>))
         (minx (rect-x rect))
         (miny (rect-y rect))
         (maxx (+ minx (rect-width rect)))
         (maxy (+ miny (rect-height rect)))
         (x1 (matrix4-transform-x matrix minx miny))
         (y1 (matrix4-transform-y matrix minx miny))
         (x2 (matrix4-transform-x matrix maxx miny))
         (y2 (matrix4-transform-y matrix maxx miny))
         (x3 (matrix4-transform-x matrix maxx maxy))
         (y3 (matrix4-transform-y matrix maxx maxy))
         (x4 (matrix4-transform-x matrix minx maxy))
         (y4 (matrix4-transform-y matrix minx maxy))
         (texcoords (texture-gl-tex-rect
                     (or texture-region
                         (sprite-batch-texture batch))))
         (s1 (rect-x texcoords))
         (t1 (rect-y texcoords))
         (s2 (+ (rect-x texcoords) (rect-width texcoords)))
         (t2 (+ (rect-y texcoords) (rect-height texcoords)))
         (r (color-r tint))
         (g (color-g tint))
         (b (color-b tint))
         (a (color-a tint)))
    (batched-sprite-append! geometry
                            (x1 y1 s1 t1 r g b a)
                            (x2 y2 s2 t1 r g b a)
                            (x3 y3 s2 t2 r g b a)
                            (x4 y4 s1 t2 r g b a))
    (geometry-index-append! geometry
                            vertex-offset
                            (+ vertex-offset 3)
                            (+ vertex-offset 2)
                            vertex-offset
                            (+ vertex-offset 2)
                            (+ vertex-offset 1))
    (set-sprite-batch-size! batch (+ (sprite-batch-size batch) 1))))

(define* (sprite-batch-add! batch
                            position
                            #:key
                            (origin %null-vec2)
                            (rotation 0.0)
                            (scale %default-scale)
                            (shear %null-vec2)
                            texture-region
                            (tint white))
  "Add sprite to BATCH at POSITION.  To render a subsection of the
batch's texture, a texture object whose parent is the batch texture
may be specified via the TEXTURE-REGION argument."
  (let ((matrix (graphics-variable-ref sprite-model-matrix))
        (rect (texture-gl-rect
               (or texture-region (sprite-batch-texture batch)))))
    (matrix4-2d-transform! matrix
                           #:origin origin
                           #:position position
                           #:rotation rotation
                           #:scale scale
                           #:shear shear)
    (sprite-batch-add* batch rect matrix
                       #:tint tint
                       #:texture-region texture-region)))

(define* (draw-sprite-batch* batch matrix #:key (blend-mode blend:alpha))
  "Render the contents of BATCH."
  (let ((shader (graphics-variable-ref sprite-batch-shader))
        (mvp (graphics-variable-ref sprite-mvp-matrix)))
    (sprite-batch-flush! batch)
    (matrix4-mult! mvp matrix (current-projection))
    (with-graphics-state ((g:blend-mode blend-mode)
                          (g:texture-0 (sprite-batch-texture batch)))
      (let ((geometry (sprite-batch-geometry batch)))
        (shader-apply* shader
                       (geometry-vertex-array geometry)
                       0
                       (geometry-index-count geometry)
                       #:mvp mvp)))))

(define* (draw-sprite-batch batch
                            #:key
                            (position %null-vec2)
                            (origin %null-vec2)
                            (scale %default-scale)
                            (rotation 0.0)
                            (blend-mode blend:alpha))
  "Render the contents of BATCH."
  (let ((matrix (graphics-variable-ref sprite-model-matrix)))
    (matrix4-2d-transform! matrix
                           #:origin origin
                           #:position position
                           #:rotation rotation
                           #:scale scale)
    (draw-sprite-batch* batch matrix #:blend-mode blend-mode)))