WIP graphics engine rewrite.

1 files changed, 146 insertions, 0 deletions

diff --git a/examples/triangle.scm b/examples/triangle.scm
new file mode 100644
index 0000000..9249677
--- /dev/null
+++ b/examples/triangle.scm
@@ -0,0 +1,146 @@
+(use-modules (chickadee)
+             (chickadee data bytestruct)
+             (chickadee math vector)
+             (chickadee graphics)
+             (chickadee graphics buffer)
+             (chickadee graphics color)
+             (chickadee graphics pipeline)
+             (chickadee graphics shader)
+             (chickadee graphics texture)
+             (chickadee graphics viewport)
+             (rnrs base))
+
+(define window-width 800)
+(define window-height 600)
+(define index-buffer #f)
+(define vertex-buffers #f)
+(define uniforms #f)
+(define texture #f)
+(define view #f)
+(define sampler #f)
+(define shader #f)
+(define pipeline #f)
+(define pass #f)
+(define bindings #f)
+
+(define-bytestruct <uniforms>
+  (struct (time f32)))
+
+(define (load)
+  (set! index-buffer
+        (bytevector->buffer (u32vector 0 1 2)
+                            #:name "Triangle indices"))
+  (set! vertex-buffers
+        (vector
+         (bytevector->buffer (f32vector -1.0 -1.0   0.0 0.0   1.0 0.0 0.0 1.0
+                                        +1.0 -1.0   1.0 0.0   0.0 1.0 0.0 1.0
+                                        +0.0 +1.0   0.5 1.0   0.0 0.0 1.0 1.0)
+                             #:name "Triangle position, texture, color")))
+  (set! uniforms (make-buffer 4 #:name "Uniform buffer" #:usage '(uniform)))
+  (set! texture (load-image "images/wall.png" #:name "Wall texture"))
+  (set! view (make-texture-view texture #:name "Wall texture view"))
+  (set! sampler (make-sampler #:name "Nearest neighbor sampler"
+                              #:address-mode-u 'repeat
+                              #:address-mode-v 'repeat))
+  (set! shader (make-shader
+                (lambda (lang)
+                  (if (eq? lang 'glsl)
+                      (values "
+#ifdef GLSL330
+layout (location = 0) in vec2 position;
+layout (location = 1) in vec2 tex;
+layout (location = 2) in vec4 color;
+#elif defined(GLSL130)
+in vec2 position;
+in vec2 tex;
+in vec4 color;
+#elif defined(GLSL120)
+attribute vec2 position;
+attribute vec2 tex;
+attribute vec4 color;
+#endif
+#ifdef GLSL120
+varying vec2 fragTex;
+varying vec4 fragColor;
+#else
+out vec2 fragTex;
+out vec4 fragColor;
+#endif
+
+layout (std140) uniform Time
+{
+    float time;
+};
+
+void main(void) {
+    fragTex = vec2(tex.x, tex.y) + mod(time / 3.0, 1.0);
+    fragColor = color;
+    gl_Position = vec4(position, 0.0, 1.0);
+}
+"
+                              "
+#ifdef GLSL120
+varying vec2 fragTex;
+varying vec4 fragColor;
+#else
+in vec2 fragTex;
+in vec4 fragColor;
+#endif
+#ifdef GLSL330
+out vec4 outFragColor;
+#else
+#define outFragColor gl_FragColor
+#define texture texture2D
+#endif
+
+uniform sampler2D sampler;
+
+void main (void) {
+    outFragColor = texture(sampler, fragTex) + fragColor;
+}
+")
+                      (error "unsupported shader language" lang)))
+                #:name "Triangle shader"))
+  (set! pipeline
+        (make-render-pipeline
+         #:name "Triangle"
+         #:shader shader
+         #:vertex-layout
+         (vector (make-vertex-buffer-layout
+                  #:stride (* 4 8)
+                  #:attributes (vector
+                                (make-vertex-attribute
+                                 #:format 'float32x2)
+                                (make-vertex-attribute
+                                 #:format 'float32x2
+                                 #:offset (* 2 4))
+                                (make-vertex-attribute
+                                 #:format 'float32x4
+                                 #:offset (* 4 4)))))
+         #:binding-layout (vector (make-texture-layout)
+                                  (make-sampler-layout)
+                                  (make-buffer-layout))))
+  (set! bindings (vector view sampler uniforms)))
+
+(define (draw* alpha)
+  (let ((bv (map-buffer uniforms 'write 0 4)))
+    (bytestruct-pack! <uniforms> (((time) (mod (elapsed-time) 1000.0))) bv 0)
+    (unmap-buffer uniforms))
+  (draw 3
+        #:pipeline pipeline
+        #:index-buffer index-buffer
+        #:vertex-buffers vertex-buffers
+        #:bindings bindings))
+
+(define (key-press key modifiers repeat)
+  (when (eq? key 'q) (abort-game)))
+
+;; (add-hook! after-gc-hook (lambda () (pk (gc-stats))))
+
+(run-game #:load load
+          #:draw draw*
+          #:key-press key-press
+          #:window-width window-width
+          #:window-height window-height
+          #:window-fullscreen? #f
+          #:window-resizable? #t)