1 12687dd9 2023-08-04 jrmu ;; The first three lines of this file were inserted by DrScheme. They record metadata
  2 12687dd9 2023-08-04 jrmu ;; about the language level of this file in a form that our tools can easily process.
  3 12687dd9 2023-08-04 jrmu #reader(lib "htdp-beginner-reader.ss" "lang")((modname 10.3.1) (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")))))
  4 12687dd9 2023-08-04 jrmu ;Data Definitions
  5 12687dd9 2023-08-04 jrmu ;
  6 12687dd9 2023-08-04 jrmu ;A circle is a structure
  7 12687dd9 2023-08-04 jrmu ;(make-circle p n s) where p is a posn,
  8 12687dd9 2023-08-04 jrmu ;n is a number, and s is a symbol.
  9 12687dd9 2023-08-04 jrmu 
 10 12687dd9 2023-08-04 jrmu (define-struct circle (center radius color))
 11 12687dd9 2023-08-04 jrmu ;
 12 12687dd9 2023-08-04 jrmu ;A rectangle is a structure
 13 12687dd9 2023-08-04 jrmu ;(make-rectangle p m n s) where p is a posn,
 14 12687dd9 2023-08-04 jrmu ;m and n are numbers, and s is a symbol.
 15 12687dd9 2023-08-04 jrmu 
 16 12687dd9 2023-08-04 jrmu (define-struct rectangle (upper-left width height color))
 17 12687dd9 2023-08-04 jrmu 
 18 12687dd9 2023-08-04 jrmu ;A shape is either
 19 12687dd9 2023-08-04 jrmu ;1. a circle or
 20 12687dd9 2023-08-04 jrmu ;2. a rectangle.
 21 12687dd9 2023-08-04 jrmu ;
 22 12687dd9 2023-08-04 jrmu ;A list-of-shapes is either
 23 12687dd9 2023-08-04 jrmu ;1. an empty list or
 24 12687dd9 2023-08-04 jrmu ;2. (cons s los) where s is a shape and
 25 12687dd9 2023-08-04 jrmu ;los is a list-of-shapes.
 26 12687dd9 2023-08-04 jrmu 
 27 12687dd9 2023-08-04 jrmu (define FACE (cons
 28 12687dd9 2023-08-04 jrmu               (make-circle (make-posn 50 50)
 29 12687dd9 2023-08-04 jrmu                            40
 30 12687dd9 2023-08-04 jrmu                            'red)
 31 12687dd9 2023-08-04 jrmu               (cons
 32 12687dd9 2023-08-04 jrmu                (make-rectangle (make-posn 30 20)
 33 12687dd9 2023-08-04 jrmu                                5
 34 12687dd9 2023-08-04 jrmu                                5
 35 12687dd9 2023-08-04 jrmu                                'blue)
 36 12687dd9 2023-08-04 jrmu                (cons
 37 12687dd9 2023-08-04 jrmu                 (make-rectangle (make-posn 65 20)
 38 12687dd9 2023-08-04 jrmu                                 5
 39 12687dd9 2023-08-04 jrmu                                 5
 40 12687dd9 2023-08-04 jrmu                                 'blue)
 41 12687dd9 2023-08-04 jrmu                 (cons
 42 12687dd9 2023-08-04 jrmu                  (make-rectangle (make-posn 40 75)
 43 12687dd9 2023-08-04 jrmu                                  20
 44 12687dd9 2023-08-04 jrmu                                  10
 45 12687dd9 2023-08-04 jrmu                                  'red)
 46 12687dd9 2023-08-04 jrmu                  (cons
 47 12687dd9 2023-08-04 jrmu                   (make-rectangle (make-posn 45 35)
 48 12687dd9 2023-08-04 jrmu                                   10
 49 12687dd9 2023-08-04 jrmu                                   30
 50 12687dd9 2023-08-04 jrmu                                   'blue) empty))))))
 51 12687dd9 2023-08-04 jrmu 
 52 12687dd9 2023-08-04 jrmu ;Template
 53 12687dd9 2023-08-04 jrmu ;fun-for-losh : list-of-shapes -> ???
 54 12687dd9 2023-08-04 jrmu ;Consumes a list-of-shapes.
 55 12687dd9 2023-08-04 jrmu ;
 56 12687dd9 2023-08-04 jrmu ;(define (fun-for-losh alosh)
 57 12687dd9 2023-08-04 jrmu ;  (cond
 58 12687dd9 2023-08-04 jrmu ;    [(empty? alosh) ...]
 59 12687dd9 2023-08-04 jrmu ;    [(circle? (first alosh)) ... (first alosh) (fun-for-losh (rest alosh))]
 60 12687dd9 2023-08-04 jrmu ;    [(rectangle? (first alosh)) ...(first alosh) (fun-for-losh (rest alosh))]
 61 12687dd9 2023-08-04 jrmu ;    [else ...]))
 62 12687dd9 2023-08-04 jrmu 
 63 12687dd9 2023-08-04 jrmu ;draw-losh : list-of-shapes -> boolean
 64 12687dd9 2023-08-04 jrmu ;Consumes alosh and draws the shapes on the canvas,
 65 12687dd9 2023-08-04 jrmu ;returning true.  If drawing fails, it returns false.
 66 12687dd9 2023-08-04 jrmu 
 67 12687dd9 2023-08-04 jrmu (define (draw-losh alosh)
 68 12687dd9 2023-08-04 jrmu   (cond
 69 12687dd9 2023-08-04 jrmu     [(empty? alosh) true]
 70 12687dd9 2023-08-04 jrmu     [(circle? (first alosh)) (and
 71 12687dd9 2023-08-04 jrmu                               (draw-a-circle (first alosh))
 72 12687dd9 2023-08-04 jrmu                               (draw-losh (rest alosh)))]
 73 12687dd9 2023-08-04 jrmu     [(rectangle? (first alosh)) (and
 74 12687dd9 2023-08-04 jrmu                                  (draw-a-rectangle (first alosh))
 75 12687dd9 2023-08-04 jrmu                                  (draw-losh (rest alosh)))]
 76 12687dd9 2023-08-04 jrmu     [else false]))
 77 12687dd9 2023-08-04 jrmu 
 78 12687dd9 2023-08-04 jrmu ;draw-a-circle : circle -> boolean?
 79 12687dd9 2023-08-04 jrmu ;Draws a circle given a-circle (struct circle).
 80 12687dd9 2023-08-04 jrmu 
 81 12687dd9 2023-08-04 jrmu (define (draw-a-circle a-circle)
 82 12687dd9 2023-08-04 jrmu   (draw-solid-disk (circle-center a-circle)
 83 12687dd9 2023-08-04 jrmu                    (circle-radius a-circle)
 84 12687dd9 2023-08-04 jrmu                    (circle-color a-circle)))
 85 12687dd9 2023-08-04 jrmu 
 86 12687dd9 2023-08-04 jrmu ; draw-a-rectangle : rectangle -> boolean
 87 12687dd9 2023-08-04 jrmu ; Returns true after drawing, consumes a-rect.
 88 12687dd9 2023-08-04 jrmu 
 89 12687dd9 2023-08-04 jrmu (define (draw-a-rectangle a-rect)
 90 12687dd9 2023-08-04 jrmu   (draw-solid-rect (rectangle-upper-left a-rect)
 91 12687dd9 2023-08-04 jrmu                    (rectangle-width a-rect)
 92 12687dd9 2023-08-04 jrmu                    (rectangle-height a-rect)
 93 12687dd9 2023-08-04 jrmu                    (rectangle-color a-rect)))
 94 12687dd9 2023-08-04 jrmu 
 95 12687dd9 2023-08-04 jrmu ;translate-losh : list-of-shapes number -> list-of-shapes
 96 12687dd9 2023-08-04 jrmu ;Given alosh, returns a list-of-shapes that have translated
 97 12687dd9 2023-08-04 jrmu ;delta pixels in the x direction.  This function
 98 12687dd9 2023-08-04 jrmu ;does not affect the canvas.
 99 12687dd9 2023-08-04 jrmu 
100 12687dd9 2023-08-04 jrmu (define (translate-losh alosh delta)
101 12687dd9 2023-08-04 jrmu   (cond
102 12687dd9 2023-08-04 jrmu     [(empty? alosh) empty]
103 12687dd9 2023-08-04 jrmu     [(circle? (first alosh))
104 12687dd9 2023-08-04 jrmu      (cons
105 12687dd9 2023-08-04 jrmu       (make-circle
106 12687dd9 2023-08-04 jrmu        (make-posn (+ (posn-x (circle-center (first alosh)))
107 12687dd9 2023-08-04 jrmu                      delta)
108 12687dd9 2023-08-04 jrmu                   (posn-y (circle-center (first alosh))))
109 12687dd9 2023-08-04 jrmu        (circle-radius (first alosh))
110 12687dd9 2023-08-04 jrmu        (circle-color (first alosh)))
111 12687dd9 2023-08-04 jrmu       (translate-losh (rest alosh) delta))]
112 12687dd9 2023-08-04 jrmu     [(rectangle? (first alosh))
113 12687dd9 2023-08-04 jrmu      (cons
114 12687dd9 2023-08-04 jrmu       (make-rectangle
115 12687dd9 2023-08-04 jrmu        (make-posn (+ (posn-x (rectangle-upper-left (first alosh)))
116 12687dd9 2023-08-04 jrmu                      delta)
117 12687dd9 2023-08-04 jrmu                   (posn-y (rectangle-upper-left (first alosh))))
118 12687dd9 2023-08-04 jrmu        (rectangle-width (first alosh))
119 12687dd9 2023-08-04 jrmu        (rectangle-height (first alosh))
120 12687dd9 2023-08-04 jrmu        (rectangle-color (first alosh)))
121 12687dd9 2023-08-04 jrmu       (translate-losh (rest alosh) delta))]
122 12687dd9 2023-08-04 jrmu     [else (error 'translate-losh "unexpected error")]))
123 12687dd9 2023-08-04 jrmu 
124 12687dd9 2023-08-04 jrmu ;clear-losh : list-of-shapes -> boolean
125 12687dd9 2023-08-04 jrmu ;Clears shapes corresponding to entries in alosh
126 12687dd9 2023-08-04 jrmu ;and returns true.  Does so by calling clear-a-rectangle
127 12687dd9 2023-08-04 jrmu ;and clear-a-circle.
128 12687dd9 2023-08-04 jrmu 
129 12687dd9 2023-08-04 jrmu (define (clear-losh alosh)
130 12687dd9 2023-08-04 jrmu   (cond
131 12687dd9 2023-08-04 jrmu     [(empty? alosh) true]
132 12687dd9 2023-08-04 jrmu     [(circle? (first alosh)) (and
133 12687dd9 2023-08-04 jrmu                               (clear-a-circle (first alosh))
134 12687dd9 2023-08-04 jrmu                               (clear-losh (rest alosh)))]
135 12687dd9 2023-08-04 jrmu     [(rectangle? (first alosh)) (and
136 12687dd9 2023-08-04 jrmu                                  (clear-a-rectangle (first alosh))
137 12687dd9 2023-08-04 jrmu                                  (clear-losh (rest alosh)))]
138 12687dd9 2023-08-04 jrmu     [else false]))
139 12687dd9 2023-08-04 jrmu 
140 12687dd9 2023-08-04 jrmu ; clear-a-circle : circle -> boolean
141 12687dd9 2023-08-04 jrmu ; Clears a circle given a-circle, returns true if
142 12687dd9 2023-08-04 jrmu ; evaluation completes successfully, false otherwise.
143 12687dd9 2023-08-04 jrmu 
144 12687dd9 2023-08-04 jrmu (define (clear-a-circle a-circle)
145 12687dd9 2023-08-04 jrmu   (clear-solid-disk (circle-center a-circle)
146 12687dd9 2023-08-04 jrmu                     (circle-radius a-circle)))
147 12687dd9 2023-08-04 jrmu 
148 12687dd9 2023-08-04 jrmu ; clear-a-rectangle : rectangle -> boolean
149 12687dd9 2023-08-04 jrmu ; Clears rectangle specified by a-rect and returns true
150 12687dd9 2023-08-04 jrmu ; if evaluation suceeds, false otherwise.
151 12687dd9 2023-08-04 jrmu 
152 12687dd9 2023-08-04 jrmu (define (clear-a-rectangle a-rect)
153 12687dd9 2023-08-04 jrmu   (clear-solid-rect (rectangle-upper-left a-rect)
154 12687dd9 2023-08-04 jrmu                     (rectangle-width a-rect)
155 12687dd9 2023-08-04 jrmu                     (rectangle-height a-rect)))
156 12687dd9 2023-08-04 jrmu 
157 12687dd9 2023-08-04 jrmu ;Data Definition
158 12687dd9 2023-08-04 jrmu ;
159 12687dd9 2023-08-04 jrmu ;A picture is a list-of-shapes?, I think.
160 12687dd9 2023-08-04 jrmu ;
161 12687dd9 2023-08-04 jrmu ;draw-and-clear-picture : picture -> boolean
162 12687dd9 2023-08-04 jrmu ;Draws alosh, sleeps for a while, then clears alosh.
163 12687dd9 2023-08-04 jrmu ;!!!CHANGE!!! Now it clears, sleeps for a while,
164 12687dd9 2023-08-04 jrmu ;then draws alosh.
165 12687dd9 2023-08-04 jrmu 
166 12687dd9 2023-08-04 jrmu (define (draw-and-clear-picture alosh)
167 12687dd9 2023-08-04 jrmu   (and
168 12687dd9 2023-08-04 jrmu 
169 12687dd9 2023-08-04 jrmu    (draw-losh alosh)
170 12687dd9 2023-08-04 jrmu ;   (sleep-for-a-while 2)
171 12687dd9 2023-08-04 jrmu    (clear-losh alosh)))
172 12687dd9 2023-08-04 jrmu ;
173 12687dd9 2023-08-04 jrmu ;move-picture : number picture -> picture
174 12687dd9 2023-08-04 jrmu ;Draws a picture delta pixels to the right, sleeps for a while,
175 12687dd9 2023-08-04 jrmu ;clears the picture, and then returns the translated picture.
176 12687dd9 2023-08-04 jrmu 
177 12687dd9 2023-08-04 jrmu (define (move-picture delta alosh)
178 12687dd9 2023-08-04 jrmu   (cond
179 12687dd9 2023-08-04 jrmu    [(draw-and-clear-picture (translate-losh alosh delta))
180 12687dd9 2023-08-04 jrmu     (translate-losh alosh delta)]
181 12687dd9 2023-08-04 jrmu    [else false]))
182 12687dd9 2023-08-04 jrmu 
183 12687dd9 2023-08-04 jrmu (start 500 100)
184 12687dd9 2023-08-04 jrmu 
185 12687dd9 2023-08-04 jrmu (control-left-right FACE 100 move-picture draw-losh)