WIP graphics engine rewrite.

6 files changed, 245 insertions, 16 deletions

diff --git a/examples/9-patch.scm b/examples/9-patch.scm
index 518ef89..1fa5b85 100644
--- a/examples/9-patch.scm
+++ b/examples/9-patch.scm
@@ -2,24 +2,25 @@
              (chickadee math rect)
              (chickadee math vector)
              (chickadee graphics 9-patch)
+             (chickadee graphics sprite)
              (chickadee graphics text)
              (chickadee graphics texture))
 
-(define image #f)
-(define region1 #f)
-(define region2 #f)
+(define texture #f)
+(define sprite1 #f)
+(define sprite2 #f)
 (define area1 (make-rect 192.0 192.0 256.0 96.0))
 (define area2 (make-rect 192.0 50.0 256.0 96.0))
 (define text-position (vec2 204.0 266.0))
 
 (define (load)
-  (set! image (load-image "images/dialog-box.png"))
-  (set! region1 (make-texture-region image (make-rect 0.0 0.0 78.0 39.0)))
-  (set! region2 (make-texture-region image (make-rect 78.0 0.0 41.0 18.0))))
+  (set! texture (texture-view (load-image "images/dialog-box.png")))
+  (set! sprite1 (make-sprite texture (make-rect 0.0 0.0 78.0 39.0)))
+  (set! sprite2 (make-sprite texture (make-rect 78.0 0.0 41.0 18.0))))
 
 (define (draw alpha)
-  (draw-9-patch region1 area1 #:margin 7.0)
-  (draw-9-patch region2 area2 #:margin 4.0)
+  (draw-9-patch sprite1 area1 #:margin 7.0)
+  (draw-9-patch sprite2 area2 #:margin 4.0)
   (draw-text "This is the 9-patch test." text-position))
 
 (run-game #:load load #:draw draw)
diff --git a/examples/particles.scm b/examples/particles.scm
index cab390b..c046fa8 100644
--- a/examples/particles.scm
+++ b/examples/particles.scm
@@ -17,7 +17,7 @@
 (define sprite-texture #f)
 (define start-time 0.0)
 (define avg-frame-time 0)
-(define stats-text "")
+(define stats-text "particles: 0  fps: 0.0")
 
 (define (center-x w)
   (- (/ window-width 2.0) (/ w 2.0)))
@@ -27,10 +27,10 @@
 
 (define (load)
   (set! *random-state* (random-state-from-platform))
-  (set! particle-texture (load-image "images/explosion.png"))
+  (set! particle-texture (texture-view (load-image "images/explosion.png")))
   (set! sprite-texture (load-image "images/chickadee.png"))
-  (set! particles (make-particles 2000
-                                  #:texture particle-texture
+  (set! particles (make-particles 512
+                                  #:texture-view particle-texture
                                   #:end-color (make-color 1.0 1.0 1.0 0.8)
                                   #:end-color (make-color 1.0 1.0 1.0 0.0)
                                   #:speed-range (vec2 1.0 5.0)
@@ -72,9 +72,13 @@
     (set-rect-y! area y)
     (set-vec2! sprite-position (- x 64.0) (- y 64.0))))
 
+(define (key-press key modifiers repeat?)
+  (when (eq? key 'q) (abort-game)))
+
 (run-game #:load load
           #:draw draw
           #:update update
+          #:key-press key-press
           #:mouse-move mouse-move
           #:window-width window-width
           #:window-height window-height)
diff --git a/examples/path.scm b/examples/path.scm
index 44cabdb..8f155e1 100644
--- a/examples/path.scm
+++ b/examples/path.scm
@@ -4,13 +4,13 @@
              (chickadee graphics text)
              (chickadee math)
              (chickadee math vector)
-             (chickadee scripting))
+             (chickadee scripting)
+             (ice-9 format))
 
 (set! *random-state* (random-state-from-platform))
 
 (define (stats-message)
-  (format #f "fps: ~1,2f"
-          (/ 1.0 avg-frame-time)))
+  (format #f "fps: ~1,2f" (/ 1.0 avg-frame-time)))
 (define start-time 0.0)
 (define avg-frame-time 0.0)
 (define stats-text (stats-message))
diff --git a/examples/sprite-autobatch.scm b/examples/sprite-autobatch.scm
new file mode 100644
index 0000000..bbae02a
--- /dev/null
+++ b/examples/sprite-autobatch.scm
@@ -0,0 +1,78 @@
+(use-modules (chickadee)
+             (chickadee math matrix)
+             (chickadee math rect)
+             (chickadee math vector)
+             (chickadee graphics sprite)
+             (chickadee graphics texture)
+
+             (chickadee graphics)
+             (chickadee graphics color)
+             (chickadee scripting)
+             (ice-9 match)
+             (statprof))
+
+(define start-time 0.0)
+(define avg-frame-time 16.0)
+(define texture #f)
+(define view #f)
+(define rect #f)
+(define matrix (make-identity-matrix4))
+
+(define (load)
+  (set! texture (load-image "images/shot.png"))
+  (set! view (make-texture-view texture))
+  (set! rect (make-rect 0.0 0.0
+                        (texture-width texture)
+                        (texture-height texture)))
+  (script
+   (forever
+    (sleep 60)
+    (pk 'fps (/ 1.0 avg-frame-time)))))
+
+(define (frand x)
+  (* (random:uniform) x))
+(define sprites
+  (map (lambda (i)
+         (vec2 (- (frand 640.0) 8.0)
+               (- (frand 480.0) 8.0)))
+       (iota 30000)))
+
+(define (draw alpha)
+  (let loop ((sprites sprites))
+    (match sprites
+      (() (values))
+      ((p . rest)
+       (set-rect-x! rect (vec2-x p))
+       (set-rect-y! rect (vec2-y p))
+       (draw-sprite* view rect matrix)
+       (loop rest))))
+  (let ((current-time (elapsed-time)))
+    (set! avg-frame-time
+          (+ (* (- current-time start-time) 0.1)
+             (* avg-frame-time 0.9)))
+    (set! start-time current-time)))
+
+(define (update dt)
+  (update-agenda 1))
+
+(define (key-press key modifiers repeat)
+  (when (eq? key 'q) (abort-game)))
+
+(define (print-gc-stats)
+  (let ((stats (gc-stats)))
+    (pk 'gc
+        (assq-ref stats 'gc-times)
+        (exact->inexact
+         (/ (get-internal-real-time)
+            internal-time-units-per-second))
+        (exact->inexact
+         (/ (assq-ref stats 'gc-time-taken)
+            1000000000)))))
+
+(add-hook! after-gc-hook print-gc-stats)
+
+(define (start)
+  (run-game #:load load #:draw draw #:update update #:key-press key-press))
+
+;; (statprof start)
+(start)
diff --git a/examples/sprite-batch.scm b/examples/sprite-batch.scm
index e62d1e4..f310092 100644
--- a/examples/sprite-batch.scm
+++ b/examples/sprite-batch.scm
@@ -64,4 +64,4 @@
   (update-agenda 1))
 
 (run-game #:load load #:draw draw #:update update
-          #:window-title "sprite batch stress test")
+          #:window-title "sprite batch example")
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)