-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathdrawing-routine.rkt
62 lines (48 loc) · 1.85 KB
/
drawing-routine.rkt
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
#lang racket
(require "declarations.rkt")
;(require "testcases.rkt")
(require racket/gui)
(provide draw-particles)
(define frame-size 750)
(define bitmap-size 750)
; Make a 500 x 500 frame
(define frame (new frame% [label "N-body movement simulation"]
[width frame-size]
[height frame-size]))
; Make the drawing area with a paint callback
(define canvas
(new canvas% [parent frame]
[paint-callback
(lambda (canvas dc) (paint dc))]))
; ... pens, brushes, and draw-face are the same as above ...
(define (paint dc) (send dc draw-bitmap face-bitmap 0 0))
; ... pens, brushes, and draw-face are the same as above ...
; Create a bitmap
(define face-bitmap (make-object bitmap% bitmap-size bitmap-size ))
; Create a drawing context for the bitmap
(define bm-dc (make-object bitmap-dc% face-bitmap))
; A bitmap's initial content is undefined; clear it before drawing
(send bm-dc clear)
; Make some pens and brushes
(define black-pen (make-object pen% "BLACK" 1 'solid))
(define yellow-brush (make-object brush% "YELLOW" 'solid))
(define red-pen (make-object pen% "RED" 2 'solid))
;;Change this to get object sizes to your liking
(define scale-radius 2)
; Show the frame
(send frame show #t)
; draw-particles :: [(Radius, Posn)] -> Action
(define (draw-particles l)
(begin
(send bm-dc clear)
(send bm-dc set-brush yellow-brush)
(send bm-dc set-pen red-pen)
(map (lambda (p) (let*
([posn (particle-posn p)]
[diameter (* 2 scale-radius (expt (particle-mass p) .3333))]
[x (- (vec-x posn) (/ diameter 2))]
[y (- (- bitmap-size (vec-y posn)) (/ diameter 2))]
)
(send bm-dc draw-ellipse x y diameter diameter))) l)
(send canvas refresh)
(sleep/yield 0.01)))