Haven't committed in days, oops!

1 files changed, 105 insertions, 0 deletions

diff --git a/bonnie-bee/background.scm b/bonnie-bee/background.scm
new file mode 100644
index 0000000..f374556
--- /dev/null
+++ b/bonnie-bee/background.scm
@@ -0,0 +1,105 @@
+(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))))