(define-module (bonnie-bee background)
  #:use-module (bonnie-bee assets)
  #:use-module (bonnie-bee common)
  #:use-module (chickadee graphics buffer)
  #:use-module (chickadee graphics engine)
  #:use-module (chickadee graphics shader)
  #:use-module (chickadee graphics texture)
  #:use-module (chickadee math)
  #:use-module (chickadee math matrix)
  #:use-module (chickadee math vector)
  #:use-module (chickadee scripting)
  #:use-module (chickadee utils)
  #:use-module (oop goops)
  #:use-module (starling node)
  #:use-module (starling node-2d)
  #:export (<background>
            scroll-y))

(define (make-background-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;
#else
#define fragColor gl_FragColor
#endif
uniform sampler2D image;
uniform float scrollY;

void main (void) {
    vec2 uv = vec2(fragTex.x, fragTex.y + scrollY);
    fragColor = texture(image, uv);
}
"))

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

(define (make-background-geometry)
  (let* ((g (make-geometry <background-vertex> 4 #:index-capacity 6))
         (x1 0.0)
         (y1 0.0)
         (x2 (exact->inexact %game-width))
         (y2 (exact->inexact %game-height))
         (s1 0.0)
         (t1 0.0)
         (s2 1.0)
         (t2 1.0))
    (with-geometry g
      (background-vertex-append! g
                                 (x1 y1 s1 t1)
                                 (x2 y1 s2 t1)
                                 (x2 y2 s2 t2)
                                 (x1 y2 s1 t2))
      (geometry-index-append! g 0 3 2 0 2 1))
    g))

(define-class <background> (<node-2d>)
  (scroll-y #:accessor scroll-y #:init-value 0.0)
  (texture #:accessor texture #:init-keyword #:texture #:asset? #t)
  (shader #:getter shader #:init-thunk make-background-shader)
  (geometry #:getter geometry #:init-thunk make-background-geometry)
  (mvp-matrix #:getter mvp-matrix #:init-thunk make-identity-matrix4))

(define-method (render (background <background>) alpha)
  (let ((mvp (mvp-matrix background))
        (t (texture background)))
    (matrix4-mult! mvp (world-matrix background) (current-projection))
    (with-graphics-state ((g:texture-0 t))
      (shader-apply (shader background)
                    (geometry-vertex-array (geometry background))
                    #:scroll-y (/ (scroll-y background) (texture-height t))
                    #:mvp mvp))))