1 ;; The first three lines of this file were inserted by DrScheme. They record metadata
2 ;; about the language level of this file in a form that our tools can easily process.
3 #reader(lib "htdp-beginner-reader.ss" "lang")((modname 18.1.7) (read-case-sensitive #t) (teachpacks ((lib "draw.ss" "teachpack" "htdp") (lib "arrow.ss" "teachpack" "htdp"))) (htdp-settings #(#t constructor repeating-decimal #f #t none #f ((lib "draw.ss" "teachpack" "htdp") (lib "arrow.ss" "teachpack" "htdp")))))
6 ;A circle is a structure
7 ;(make-circle p n s) where p is a posn,
8 ;n is a number, and s is a symbol.
10 (define-struct circle (center radius color))
12 ;A rectangle is a structure
13 ;(make-rectangle p m n s) where p is a posn,
14 ;m and n are numbers, and s is a symbol.
16 (define-struct rectangle (upper-left width height color))
22 ;A list-of-shapes is either
24 ;2. (cons s los) where s is a shape and
25 ;los is a list-of-shapes.
28 (make-circle (make-posn 50 50)
32 (make-rectangle (make-posn 30 20)
37 (make-rectangle (make-posn 65 20)
42 (make-rectangle (make-posn 40 75)
47 (make-rectangle (make-posn 45 35)
53 ;fun-for-losh : list-of-shapes -> ???
54 ;Consumes a list-of-shapes.
56 ;(define (fun-for-losh alosh)
58 ; [(empty? alosh) ...]
59 ; [(circle? (first alosh)) ... (first alosh) (fun-for-losh (rest alosh))]
60 ; [(rectangle? (first alosh)) ...(first alosh) (fun-for-losh (rest alosh))]
63 ;draw-losh : list-of-shapes -> boolean
64 ;Consumes alosh and draws the shapes on the canvas,
65 ;returning true. If drawing fails, it returns false.
67 (define (draw-losh alosh)
70 [(circle? (first alosh)) (and
71 (draw-a-circle (first alosh))
72 (draw-losh (rest alosh)))]
73 [(rectangle? (first alosh)) (and
74 (draw-a-rectangle (first alosh))
75 (draw-losh (rest alosh)))]
78 ;draw-a-circle : circle -> boolean?
79 ;Draws a circle given a-circle (struct circle).
81 (define (draw-a-circle a-circle)
82 (draw-solid-disk (circle-center a-circle)
83 (circle-radius a-circle)
84 (circle-color a-circle)))
86 ; draw-a-rectangle : rectangle -> boolean
87 ; Returns true after drawing, consumes a-rect.
89 (define (draw-a-rectangle a-rect)
90 (draw-solid-rect (rectangle-upper-left a-rect)
91 (rectangle-width a-rect)
92 (rectangle-height a-rect)
93 (rectangle-color a-rect)))
95 ;translate-losh : list-of-shapes number -> list-of-shapes
96 ;Given alosh, returns a list-of-shapes that have translated
97 ;delta pixels in the x direction. This function
98 ;does not affect the canvas.
100 (define (translate-losh alosh delta)
102 [(empty? alosh) empty]
103 [(circle? (first alosh))
106 (make-posn (+ (posn-x (circle-center (first alosh)))
108 (posn-y (circle-center (first alosh))))
109 (circle-radius (first alosh))
110 (circle-color (first alosh)))
111 (translate-losh (rest alosh) delta))]
112 [(rectangle? (first alosh))
115 (make-posn (+ (posn-x (rectangle-upper-left (first alosh)))
117 (posn-y (rectangle-upper-left (first alosh))))
118 (rectangle-width (first alosh))
119 (rectangle-height (first alosh))
120 (rectangle-color (first alosh)))
121 (translate-losh (rest alosh) delta))]
122 [else (error 'translate-losh "unexpected error")]))
124 ;clear-losh : list-of-shapes -> boolean
125 ;Clears shapes corresponding to entries in alosh
126 ;and returns true. Does so by calling clear-a-rectangle
129 (define (clear-losh alosh)
131 [(empty? alosh) true]
132 [(circle? (first alosh)) (and
133 (clear-a-circle (first alosh))
134 (clear-losh (rest alosh)))]
135 [(rectangle? (first alosh)) (and
136 (clear-a-rectangle (first alosh))
137 (clear-losh (rest alosh)))]
140 ; clear-a-circle : circle -> boolean
141 ; Clears a circle given a-circle, returns true if
142 ; evaluation completes successfully, false otherwise.
144 (define (clear-a-circle a-circle)
145 (clear-solid-disk (circle-center a-circle)
146 (circle-radius a-circle)))
148 ; clear-a-rectangle : rectangle -> boolean
149 ; Clears rectangle specified by a-rect and returns true
150 ; if evaluation suceeds, false otherwise.
152 (define (clear-a-rectangle a-rect)
153 (clear-solid-rect (rectangle-upper-left a-rect)
154 (rectangle-width a-rect)
155 (rectangle-height a-rect)))
159 ;A picture is a list-of-shapes?, I think.
161 ;draw-and-clear-picture : picture -> boolean
162 ;Draws alosh, sleeps for a while, then clears alosh.
163 ;!!!CHANGE!!! Now it clears, sleeps for a while,
166 (define (draw-and-clear-picture alosh)
170 ; (sleep-for-a-while 2)
173 ;move-picture : number picture -> picture
174 ;Draws a picture delta pixels to the right, sleeps for a while,
175 ;clears the picture, and then returns the translated picture.
177 (define (move-picture delta alosh)
179 [(draw-and-clear-picture (translate-losh alosh delta))
180 (translate-losh alosh delta)]
185 (control-left-right FACE 100 move-picture draw-losh)