particles.rkt

#lang racket/gui

(require (planet williams/animated-canvas/animated-canvas)
         racket/unsafe/ops
         profile)

(define W 800)
(define H 800)

(define all-colors (take (send the-color-database get-names) 20))

(define no-pen (new pen% [style 'transparent]))
(define brush (new brush%))
(send brush set-color (car (shuffle all-colors)))

(define-struct particle (x y dx dy b) #:mutable)

(define (move p) 
  (match-define (particle x y dx dy b) p)
  (define new-x (unsafe-fx+ x dx))
  (define new-y (unsafe-fx+ y dy))
  (set-particle-x! p new-x)
  (set-particle-y! p new-y)
  (when 
      (or (> 0 new-x) 
          (< W new-x)) (set-particle-dx! p (unsafe-fx- 0 dx)))
  (when 
      (or (> 0 new-y) 
          (< H new-y)) (set-particle-dy! p (unsafe-fx- 0 dy))))

(define state
  (build-list 1000
              (lambda (_) 
                (particle
                 (random W) (random H) 
                 (- (random 10) 5) (- (random 10) 5)
                 (car (shuffle all-colors))
                 ))))

(define (tick-world world) (map move world))

(define (draw-world canvas world)
  (let [(dc (send canvas get-dc))]
    (for ([p world])
      (send dc set-brush (particle-b p) 'solid)
      (send dc draw-ellipse (particle-x p) (particle-y p) 4 4))))


; Gui ------------------------------

(define frame
  (instantiate frame% ("Animated Canvas Demo")))

(define canvas 
  (instantiate animated-canvas% (frame)
    (style '(border))
    (min-width W) (min-height H)))
 
(define dc (send canvas get-dc))
(send dc set-pen no-pen)
(send dc set-background (make-object color% 70 70 70))

(send frame show #t)

(profile-thunk (lambda ()
                 (tick-world state)
                 (draw-world canvas state)
                 (send canvas swap-bitmaps)
                 )
               
               #:repeat 1000
               )

profile.txt

Profiling results
-----------------
  Total cpu time observed: 41072ms (out of 41393ms)
  Number of samples taken: 753 (once every 55ms)
  (Hiding functions with self<1.0% and local<2.0%: 3 of 19 hidden)

==============================================================================================
                                Caller
 Idx    Total       Self      Name+src                                                  Local%
        ms(pct)     ms(pct)     Callee
==============================================================================================
 [1] 15954(38.8%)    0(0.0%)  [running body] /Users/adam/canvas.rkt:##f
                                profile-thunk14 [2]                                     100.0%
----------------------------------------------------------------------------------------------
                                [running body] [1]                                      100.0%
 [2] 15954(38.8%)    0(0.0%)  profile-thunk14 ...e/pkgs/profile-lib/main.rkt:9:0
                                for-loop [3]                                             99.2%
----------------------------------------------------------------------------------------------
                                profile-thunk14 [2]                                     100.0%
 [3] 15826(38.5%)    0(0.0%)  for-loop .../share/pkgs/profile-lib/main.rkt:31:16
                                temp13 [4]                                               96.6%
                                yield [5]                                                 2.7%
----------------------------------------------------------------------------------------------
                                for-loop [3]                                             99.2%
 [4] 15424(37.6%)  158(0.4%)  temp13 /Users/adam/canvas.rkt:65:15
                                for-loop [6]                                             98.6%
----------------------------------------------------------------------------------------------
                                for-loop [3]                                            100.0%
 [5]   424(1.0%)    54(0.1%)  yield ...ib/mred/private/wx/common/queue.rkt:476:2
                                ??? [7]                                                  87.4%
----------------------------------------------------------------------------------------------
                                temp13 [4]                                              100.0%
 [6] 15213(37.0%) 6187(15.1%) for-loop /Users/adam/canvas.rkt:44:4
                                find-or-create-brush method in brush-list% [8]           44.0%
                                next [14]                                                 3.5%
                                do-set-brush! method in dc% [9]                           3.5%
                                ??? [10]                                                  3.0%
                                draw-ellipse method in dc% [11]                           2.7%
                                ??? [12]                                                  2.6%
----------------------------------------------------------------------------------------------
                                yield [5]                                               100.0%
 [7]   371(0.9%)     0(0.0%)  ??? ...-lib/mred/private/wx/common/queue.rkt:451:6
                                do-on-paint method in ...mon/canvas-mixin.rkt:118:2 [13]100.0%
----------------------------------------------------------------------------------------------
                                for-loop [6]                                            100.0%
 [8]  6694(16.3%) 4839(11.8%) find-or-create-brush method in brush-list% ...10:2
                                check-arg [16]                                           24.0%
                                next [14]                                                 3.7%
----------------------------------------------------------------------------------------------
                                for-loop [6]                                            100.0%
 [9]   530(1.3%)   530(1.3%)  do-set-brush! method in dc% ...rivate/dc.rkt:607:4
----------------------------------------------------------------------------------------------
                                for-loop [6]                                            100.0%
[10]   451(1.1%)   214(0.5%)  ??? ...ects/racket/contract/private/prop.rkt:261:6
                                ??? [15]                                                 52.4%
----------------------------------------------------------------------------------------------
                                for-loop [6]                                            100.0%
[11]   408(1.0%)   354(0.9%)  draw-ellipse method in dc% ...rivate/dc.rkt:1041:4
                                check-arg [16]                                           13.2%
----------------------------------------------------------------------------------------------
                                for-loop [6]                                            100.0%
[12]   402(1.0%)   402(1.0%)  ??? ...cts/racket/contract/private/prop.rkt:221:10
----------------------------------------------------------------------------------------------
                                ??? [7]                                                 100.0%
[13]   371(0.9%)   371(0.9%)  do-on-paint method in ...mon/canvas-mixin.rkt:118:2 ...
----------------------------------------------------------------------------------------------
                                find-or-create-brush method in brush-list% [8]           31.4%
                                for-loop [6]                                             68.6%
[14]   786(1.9%)   463(1.1%)  next (unknown source)
                                check-arg [16]                                           41.1%
----------------------------------------------------------------------------------------------
                                ??? [10]                                                100.0%
[15]   236(0.6%)   236(0.6%)  ??? ...cts/racket/contract/private/misc.rkt:152:19
----------------------------------------------------------------------------------------------
                                draw-ellipse method in dc% [11]                           2.7%
                                next [14]                                                16.3%
                                find-or-create-brush method in brush-list% [8]           81.0%
[16]  1986(4.8%)  1986(4.8%)  check-arg .../racket/draw/private/syntax.rkt:124:0
----------------------------------------------------------------------------------------------