85 lines
3.1 KiB
Racket
85 lines
3.1 KiB
Racket
#lang imperative-syndicate
|
|
;; Multiple animated sprites.
|
|
;;
|
|
;; 2018-05-01 With the new "imperative" implementation of Syndicate,
|
|
;; the same 2.6GHz laptop mentioned below can animate 135 logos in a
|
|
;; 640x480 window at 60 fps on a single core, with a bit of headroom
|
|
;; to spare.
|
|
;;
|
|
;; 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/activate imperative-syndicate/drivers/gl-2d)
|
|
|
|
(define speed-limit 40)
|
|
(define sprite-count 135)
|
|
|
|
(define (spawn-background)
|
|
(spawn
|
|
(during (window $width $height)
|
|
(assert-scene `((push-matrix (scale ,width ,height)
|
|
(texture ,(rectangle 1 1 "solid" "white"))))
|
|
`()))))
|
|
|
|
(define i:logo (plt-logo))
|
|
(define i:logo-width (image-width i:logo))
|
|
(define i:logo-height (image-height i:logo))
|
|
|
|
(define (spawn-logo)
|
|
(spawn (field [x 100] [y 100])
|
|
(field [dx (* (- (random) 0.5) speed-limit)]
|
|
[dy (* (- (random) 0.5) speed-limit)])
|
|
(define/query-value w #f ($ w (window _ _)) w)
|
|
(assert (simple-sprite 0
|
|
(x)
|
|
(y)
|
|
i:logo-width
|
|
i:logo-height
|
|
i:logo))
|
|
(define (bounce f df limit)
|
|
(define v (f))
|
|
(define limit* (- limit i:logo-width))
|
|
(cond [(< v 0) (f 0) (df (abs (df)))]
|
|
[(> v limit*) (f limit*) (df (- (abs (df))))]
|
|
[else (void)]))
|
|
(on (message (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))
|
|
|
|
(spawn (define start-time #f)
|
|
(log-info "Sprite count: ~a" sprite-count)
|
|
(on (message (frame-event $counter $timestamp _ _))
|
|
(if (eq? start-time #f)
|
|
(set! start-time (current-inexact-milliseconds))
|
|
(let ((delta (- (current-inexact-milliseconds) start-time)))
|
|
(when (and (zero? (modulo counter 100)) (positive? delta))
|
|
(log-info "~v frames, ~v ms ==> ~v Hz"
|
|
counter
|
|
delta
|
|
(/ counter (/ delta 1000.0))))))))
|
|
|
|
(spawn-gl-2d-driver)
|
|
|
|
(spawn (field [fullscreen? #f])
|
|
(on (message (key-event #\f #t _)) (fullscreen? (not (fullscreen?))))
|
|
(assert #:when (fullscreen?) (gl-control 'fullscreen))
|
|
|
|
(on (message (key-event #\q #t _))
|
|
(send! (gl-control 'stop))))
|