Many animated sprites

racket/syndicate-gl/examples/many.rkt

@@ -0,0 +1,70 @@
+#lang syndicate/actor
+;; Multiple animated sprites.
+;;
+;; 2016-12-12 With the current implementations of (a) Syndicate's
+;; dataspaces and (b) Syndicate's 2D sprite support, my reasonably new
+;; 2.6GHz laptop can animate 20 logos at 256x256 pixels at about 20
+;; frames per second on a single core.
+;;
+;; For comparison, Kay recounts in "The Early History of Smalltalk"
+;; (1993) that "by the Fall of '73 [Steve Purcell] could demo 80
+;; ping-pong balls and 10 flying horses running at 10 frames per
+;; second in 2 1/2 D" in an early Smalltalk (?) on a NOVA.
+
+(require 2htdp/image)
+(require images/logos)
+(require "../2d.rkt")
+
+(define speed-limit 40)
+(define sprite-count 20)
+
+(define (spawn-background)
+  (actor
+   (during (inbound (window $width $height))
+           (assert (outbound
+                    (scene (seal `((push-matrix (scale ,width ,height)
+                                                (texture ,(rectangle 1 1 "solid" "white")))))
+                           (seal `())))))))
+
+(define i:logo (plt-logo))
+
+(define (spawn-logo)
+  (actor (field [x 100] [y 100])
+         (field [dx (* (- (random) 0.5) speed-limit)]
+                [dy (* (- (random) 0.5) speed-limit)])
+         (define/query-value w #f (inbound ($ w (window _ _))) w)
+         (assert (outbound (simple-sprite 0
+                                          (x)
+                                          (y)
+                                          (image-width i:logo)
+                                          (image-height i:logo)
+                                          i:logo)))
+         (define (bounce f df limit)
+           (define v (f))
+           (define limit* (- limit (image-width i:logo)))
+           (cond [(< v 0) (f 0) (df (abs (df)))]
+                 [(> v limit*) (f limit*) (df (- (abs (df))))]
+                 [else (void)]))
+         (on (message (inbound (frame-event _ _ _ _)))
+             (when (w) ;; don't animate until we know the window bounds
+               (x (+ (x) (dx)))
+               (y (+ (y) (dy)))
+               (bounce x dx (window-width (w)))
+               (bounce y dy (window-height (w)))))))
+
+(spawn-background)
+(for [(i sprite-count)]
+  (spawn-logo))
+
+(actor (on (message (inbound (frame-event $counter $timestamp _ _)))
+           (when (and (zero? (modulo counter 100)) (positive? timestamp))
+             (log-info "~v frames, ~v ms ==> ~v Hz"
+                       counter
+                       timestamp
+                       (/ counter (/ timestamp 1000.0))))))
+
+(actor* (assert! (outbound 'fullscreen))
+        (until (message (inbound (key-event #\q #t _))))
+        (assert! (outbound 'stop)))
+
+(module+ main (current-ground-dataspace (2d-dataspace)))