1 files changed, 78 insertions, 0 deletions
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)