summaryrefslogtreecommitdiff
path: root/examples/sprite-autobatch.scm
blob: bbae02a32f4f7e5ec5ac358e7dceaee8e18e0b30 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
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)