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-intermediate-reader.ss" "lang")((modname 18.1.7) (read-case-sensitive #t) (teachpacks ((lib "draw.ss" "teachpack" "htdp"))) (htdp-settings #(#t constructor repeating-decimal #f #t none #f ((lib "draw.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 
 28 12687dd9 2023-08-04 jrmu (define FACE (cons
 29 12687dd9 2023-08-04 jrmu               (make-circle (make-posn 50 50)
 30 12687dd9 2023-08-04 jrmu                            40
 31 12687dd9 2023-08-04 jrmu                            'red)
 32 12687dd9 2023-08-04 jrmu               (cons
 33 12687dd9 2023-08-04 jrmu                (make-rectangle (make-posn 30 20)
 34 12687dd9 2023-08-04 jrmu                                5
 35 12687dd9 2023-08-04 jrmu                                5
 36 12687dd9 2023-08-04 jrmu                                'blue)
 37 12687dd9 2023-08-04 jrmu                (cons
 38 12687dd9 2023-08-04 jrmu                 (make-rectangle (make-posn 65 20)
 39 12687dd9 2023-08-04 jrmu                                 5
 40 12687dd9 2023-08-04 jrmu                                 5
 41 12687dd9 2023-08-04 jrmu                                 'blue)
 42 12687dd9 2023-08-04 jrmu                 (cons
 43 12687dd9 2023-08-04 jrmu                  (make-rectangle (make-posn 40 75)
 44 12687dd9 2023-08-04 jrmu                                  20
 45 12687dd9 2023-08-04 jrmu                                  10
 46 12687dd9 2023-08-04 jrmu                                  'red)
 47 12687dd9 2023-08-04 jrmu                  (cons
 48 12687dd9 2023-08-04 jrmu                   (make-rectangle (make-posn 45 35)
 49 12687dd9 2023-08-04 jrmu                                   10
 50 12687dd9 2023-08-04 jrmu                                   30
 51 12687dd9 2023-08-04 jrmu                                   'blue) empty))))))
 52 12687dd9 2023-08-04 jrmu 
 53 12687dd9 2023-08-04 jrmu (define (move-picture delta alosh)
 54 12687dd9 2023-08-04 jrmu   (local (;draw-losh : list-of-shapes -> boolean
 55 12687dd9 2023-08-04 jrmu           ;Consumes alosh and draws the shapes on the canvas,
 56 12687dd9 2023-08-04 jrmu           ;returning true.  If drawing fails, it returns false.
 57 12687dd9 2023-08-04 jrmu           
 58 12687dd9 2023-08-04 jrmu           (define (draw-losh alosh)
 59 12687dd9 2023-08-04 jrmu             (cond
 60 12687dd9 2023-08-04 jrmu               [(empty? alosh) true]
 61 12687dd9 2023-08-04 jrmu               [(circle? (first alosh)) (and
 62 12687dd9 2023-08-04 jrmu                                         (draw-a-circle (first alosh))
 63 12687dd9 2023-08-04 jrmu                                         (draw-losh (rest alosh)))]
 64 12687dd9 2023-08-04 jrmu               [(rectangle? (first alosh)) (and
 65 12687dd9 2023-08-04 jrmu                                            (draw-a-rectangle (first alosh))
 66 12687dd9 2023-08-04 jrmu                                            (draw-losh (rest alosh)))]
 67 12687dd9 2023-08-04 jrmu               [else false]))
 68 12687dd9 2023-08-04 jrmu           
 69 12687dd9 2023-08-04 jrmu           ;draw-a-circle : circle -> boolean?
 70 12687dd9 2023-08-04 jrmu           ;Draws a circle given a-circle (struct circle).
 71 12687dd9 2023-08-04 jrmu           
 72 12687dd9 2023-08-04 jrmu           (define (draw-a-circle a-circle)
 73 12687dd9 2023-08-04 jrmu             (draw-solid-disk (circle-center a-circle)
 74 12687dd9 2023-08-04 jrmu                              (circle-radius a-circle)
 75 12687dd9 2023-08-04 jrmu                              (circle-color a-circle)))
 76 12687dd9 2023-08-04 jrmu           
 77 12687dd9 2023-08-04 jrmu           ; draw-a-rectangle : rectangle -> boolean
 78 12687dd9 2023-08-04 jrmu           ; Returns true after drawing, consumes a-rect.
 79 12687dd9 2023-08-04 jrmu           
 80 12687dd9 2023-08-04 jrmu           (define (draw-a-rectangle a-rect)
 81 12687dd9 2023-08-04 jrmu             (draw-solid-rect (rectangle-upper-left a-rect)
 82 12687dd9 2023-08-04 jrmu                              (rectangle-width a-rect)
 83 12687dd9 2023-08-04 jrmu                              (rectangle-height a-rect)
 84 12687dd9 2023-08-04 jrmu                              (rectangle-color a-rect)))
 85 12687dd9 2023-08-04 jrmu           
 86 12687dd9 2023-08-04 jrmu           ;translate-losh : list-of-shapes number -> list-of-shapes
 87 12687dd9 2023-08-04 jrmu           ;Given alosh, returns a list-of-shapes that have translated
 88 12687dd9 2023-08-04 jrmu           ;delta pixels in the x direction.  This function
 89 12687dd9 2023-08-04 jrmu           ;does not affect the canvas.
 90 12687dd9 2023-08-04 jrmu           
 91 12687dd9 2023-08-04 jrmu           (define (translate-losh alosh delta)
 92 12687dd9 2023-08-04 jrmu             (cond
 93 12687dd9 2023-08-04 jrmu               [(empty? alosh) empty]
 94 12687dd9 2023-08-04 jrmu               [(circle? (first alosh))
 95 12687dd9 2023-08-04 jrmu                (cons
 96 12687dd9 2023-08-04 jrmu                 (make-circle
 97 12687dd9 2023-08-04 jrmu                  (make-posn (+ (posn-x (circle-center (first alosh)))
 98 12687dd9 2023-08-04 jrmu                                delta)
 99 12687dd9 2023-08-04 jrmu                             (posn-y (circle-center (first alosh))))
100 12687dd9 2023-08-04 jrmu                  (circle-radius (first alosh))
101 12687dd9 2023-08-04 jrmu                  (circle-color (first alosh)))
102 12687dd9 2023-08-04 jrmu                 (translate-losh (rest alosh) delta))]
103 12687dd9 2023-08-04 jrmu               [(rectangle? (first alosh))
104 12687dd9 2023-08-04 jrmu                (cons
105 12687dd9 2023-08-04 jrmu                 (make-rectangle
106 12687dd9 2023-08-04 jrmu                  (make-posn (+ (posn-x (rectangle-upper-left (first alosh)))
107 12687dd9 2023-08-04 jrmu                                delta)
108 12687dd9 2023-08-04 jrmu                             (posn-y (rectangle-upper-left (first alosh))))
109 12687dd9 2023-08-04 jrmu                  (rectangle-width (first alosh))
110 12687dd9 2023-08-04 jrmu                  (rectangle-height (first alosh))
111 12687dd9 2023-08-04 jrmu                  (rectangle-color (first alosh)))
112 12687dd9 2023-08-04 jrmu                 (translate-losh (rest alosh) delta))]
113 12687dd9 2023-08-04 jrmu               [else (error 'translate-losh "unexpected error")]))
114 12687dd9 2023-08-04 jrmu           
115 12687dd9 2023-08-04 jrmu           ;clear-losh : list-of-shapes -> boolean
116 12687dd9 2023-08-04 jrmu           ;Clears shapes corresponding to entries in alosh
117 12687dd9 2023-08-04 jrmu           ;and returns true.  Does so by calling clear-a-rectangle
118 12687dd9 2023-08-04 jrmu           ;and clear-a-circle.
119 12687dd9 2023-08-04 jrmu           
120 12687dd9 2023-08-04 jrmu           (define (clear-losh alosh)
121 12687dd9 2023-08-04 jrmu             (cond
122 12687dd9 2023-08-04 jrmu               [(empty? alosh) true]
123 12687dd9 2023-08-04 jrmu               [(circle? (first alosh)) (and
124 12687dd9 2023-08-04 jrmu                                         (clear-a-circle (first alosh))
125 12687dd9 2023-08-04 jrmu                                         (clear-losh (rest alosh)))]
126 12687dd9 2023-08-04 jrmu               [(rectangle? (first alosh)) (and
127 12687dd9 2023-08-04 jrmu                                            (clear-a-rectangle (first alosh))
128 12687dd9 2023-08-04 jrmu                                            (clear-losh (rest alosh)))]
129 12687dd9 2023-08-04 jrmu               [else false]))
130 12687dd9 2023-08-04 jrmu           
131 12687dd9 2023-08-04 jrmu           ; clear-a-circle : circle -> boolean
132 12687dd9 2023-08-04 jrmu           ; Clears a circle given a-circle, returns true if
133 12687dd9 2023-08-04 jrmu           ; evaluation completes successfully, false otherwise.
134 12687dd9 2023-08-04 jrmu           
135 12687dd9 2023-08-04 jrmu           (define (clear-a-circle a-circle)
136 12687dd9 2023-08-04 jrmu             (clear-solid-disk (circle-center a-circle)
137 12687dd9 2023-08-04 jrmu                               (circle-radius a-circle)))
138 12687dd9 2023-08-04 jrmu           
139 12687dd9 2023-08-04 jrmu           ; clear-a-rectangle : rectangle -> boolean
140 12687dd9 2023-08-04 jrmu           ; Clears rectangle specified by a-rect and returns true
141 12687dd9 2023-08-04 jrmu           ; if evaluation suceeds, false otherwise.
142 12687dd9 2023-08-04 jrmu           
143 12687dd9 2023-08-04 jrmu           (define (clear-a-rectangle a-rect)
144 12687dd9 2023-08-04 jrmu             (clear-solid-rect (rectangle-upper-left a-rect)
145 12687dd9 2023-08-04 jrmu                               (rectangle-width a-rect)
146 12687dd9 2023-08-04 jrmu                               (rectangle-height a-rect)))
147 12687dd9 2023-08-04 jrmu           
148 12687dd9 2023-08-04 jrmu           ;Data Definition
149 12687dd9 2023-08-04 jrmu           ;
150 12687dd9 2023-08-04 jrmu           ;A picture is a list-of-shapes?, I think.
151 12687dd9 2023-08-04 jrmu           ;
152 12687dd9 2023-08-04 jrmu           ;draw-and-clear-picture : picture -> boolean
153 12687dd9 2023-08-04 jrmu           ;Draws alosh, sleeps for a while, then clears alosh.
154 12687dd9 2023-08-04 jrmu           ;!!!CHANGE!!! Now it clears, sleeps for a while,
155 12687dd9 2023-08-04 jrmu           ;then draws alosh.
156 12687dd9 2023-08-04 jrmu           
157 12687dd9 2023-08-04 jrmu           (define (draw-and-clear-picture alosh)
158 12687dd9 2023-08-04 jrmu             (and
159 12687dd9 2023-08-04 jrmu              
160 12687dd9 2023-08-04 jrmu              (draw-losh alosh)
161 12687dd9 2023-08-04 jrmu              (sleep-for-a-while 0.1)
162 12687dd9 2023-08-04 jrmu              (clear-losh alosh)))
163 12687dd9 2023-08-04 jrmu           ;
164 12687dd9 2023-08-04 jrmu           ;move-picture : number picture -> picture
165 12687dd9 2023-08-04 jrmu           ;Draws a picture delta pixels to the right, sleeps for a while,
166 12687dd9 2023-08-04 jrmu           ;clears the picture, and then returns the translated picture.
167 12687dd9 2023-08-04 jrmu           
168 12687dd9 2023-08-04 jrmu           (define (move-picture delta alosh)
169 12687dd9 2023-08-04 jrmu             (cond
170 12687dd9 2023-08-04 jrmu               [(draw-and-clear-picture (translate-losh alosh delta))
171 12687dd9 2023-08-04 jrmu                (translate-losh alosh delta)]
172 12687dd9 2023-08-04 jrmu               [else false])))
173 12687dd9 2023-08-04 jrmu     (move-picture delta alosh)))
174 12687dd9 2023-08-04 jrmu 
175 12687dd9 2023-08-04 jrmu (start 500 500)
176 12687dd9 2023-08-04 jrmu (move-picture 5 (move-picture 5 (move-picture 5 (move-picture 5 (move-picture 5 (move-picture 5 (move-picture 5 (move-picture 5 (move-picture 5 (move-picture 5 (move-picture 5 (move-picture 5 (move-picture 5 (move-picture 5 (move-picture 5 (move-picture 5 (move-picture 5 (move-picture 5 (move-picture 5 (move-picture 5 (move-picture 5 (move-picture 5 (move-picture 5 (move-picture 5 (move-picture 5 (move-picture 5 (move-picture 5 (move-picture 5 (move-picture 5 (move-picture 5 (move-picture 5 (move-picture 5 (move-picture 5 (move-picture 5 (move-picture 5 (move-picture 5 (move-picture 5 (move-picture 5 (move-picture 5 (move-picture 5 (move-picture 5 FACE)))))))))))))))))))))))))))))))))))))))))