Simple world using big bang with DrRacket (click and rain drops appear at position of cursor)

1:  (require 2htdp/image)  
2:  (require 2htdp/universe)  
3:    
4:    
5:    
6:  ;; =================  
7:  ;; Constants:  
8:    
9:  (define WIDTH 300)  
10:  (define HEIGHT 300)  
11:    
12:  (define SPEED 1)  
13:    
14:  (define DROP (ellipse 4 8 "solid" "blue"))  
15:    
16:  (define MTS (rectangle WIDTH HEIGHT "solid" "light blue"))  
17:    
18:  ;; =================  
19:  ;; Data definitions:  
20:    
21:  (define-struct drop (x y))  
22:  ;; Drop is (make-drop Integer Integer)  
23:  ;; interp. A raindrop on the screen, with x and y coordinates.  
24:    
25:  (define D1 (make-drop 10 30))  
26:    
27:  #;  
28:  (define (fn-for-drop d)  
29:   (... (drop-x d)   
30:      (drop-y d)))  
31:    
32:  ;; Template Rules used:  
33:  ;; - compound: 2 fields  
34:    
35:    
36:  ;; ListOfDrop is one of:  
37:  ;; - empty  
38:  ;; - (cons Drop ListOfDrop)  
39:  ;; interp. a list of drops  
40:    
41:  (define LOD1 empty)  
42:  (define LOD2 (cons (make-drop 10 20) (cons (make-drop 3 6) empty)))  
43:    
44:  #;  
45:  (define (fn-for-lod lod)  
46:   (cond [(empty? lod) (...)]  
47:      [else  
48:       (... (fn-for-drop (first lod))  
49:         (fn-for-lod (rest lod)))]))  
50:    
51:  ;; Template Rules used:  
52:  ;; - one-of: 2 cases  
53:  ;; - atomic distinct: empty  
54:  ;; - compound: (cons Drop ListOfDrop)  
55:  ;; - reference: (first lod) is Drop  
56:  ;; - self reference: (rest lod) is ListOfDrop  
57:    
58:  ;; =================  
59:  ;; Functions:  
60:    
61:  ;; ListOfDrop -> ListOfDrop  
62:  ;; start rain program by evaluating (main empty)  
63:  (define (main lod)  
64:   (big-bang lod  
65:        (on-mouse handle-mouse)  ; ListOfDrop Integer Integer MouseEvent -> ListOfDrop  
66:        (on-tick next-drops)   ; ListOfDrop -> ListOfDrop  
67:        (to-draw render-drops))) ; ListOfDrop -> Image  
68:    
69:    
70:  ;; ListOfDrop Integer Integer MouseEvent -> ListOfDrop  
71:  ;; if mevt is "button-down" add a new drop at that position  
72:  ;; !!!  
73:  ;(define (handle-mouse lod x y mevt) empty) ; stub  
74:    
75:  (define (handle-mouse lod x y mevt)  
76:   (if (mouse=? mevt "button-down")  
77:     (cons (make-drop x y) lod)  
78:     lod))  
79:    
80:  ;; ListOfDrop -> ListOfDrop  
81:  ;; produce filtered and ticked list of drops  
82:  ;; !!!  
83:  ;(define (next-drops lod) empty) ; stub  
84:    
85:  (define (next-drops lod)  
86:   (cond [(empty? lod) lod]  
87:      [else  
88:       (cons (make-drop (drop-x (first lod)) (+ (drop-y (first lod)) SPEED))  
89:       (next-drops (rest lod)))]))  
90:    
91:    
92:  ;; ListOfDrop -> Image  
93:  ;; Render the drops onto MTS  
94:  ;; !!!  
95:  ;(define (render-drops lod) MTS) ; stub  
96:    
97:  (define (render-drops lod)  
98:   (cond [(empty? lod) MTS]  
99:      [else  
100:       (if (< (drop-y (first lod)) HEIGHT)  
101:         (place-image DROP (drop-x (first lod)) (drop-y (first lod))  
102:               (render-drops (rest lod)))  
103:         (render-drops (rest lod)))]))  
104:    
105:  ;(define (place-drop lod)  
106:  ; (cond [(empty? lod) lod]  
107:  ;    [else  
108:  ;     (... (fn-for-drop (first lod))  
109:  ;       (place-drop (rest lod)))]))  
110:    
111:  (define (place-drop d)  
112:   (if (< (drop-y d) HEIGHT)  
113:     (place-image DROP (drop-x d) (drop-y d) MTS)  
114:     (...)))  
115:       
116:    
117:  (main empty)  
118:    
119: