;; The first three lines of this file were inserted by DrScheme. They record metadata
;; about the language level of this file in a form that our tools can easily process.
#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")))))
;Data Definitions
;
;A circle is a structure
;(make-circle p n s) where p is a posn,
;n is a number, and s is a symbol.

(define-struct circle (center radius color))
;
;A rectangle is a structure
;(make-rectangle p m n s) where p is a posn,
;m and n are numbers, and s is a symbol.

(define-struct rectangle (upper-left width height color))

;A shape is either
;1. a circle or
;2. a rectangle.
;
;A list-of-shapes is either
;1. an empty list or
;2. (cons s los) where s is a shape and
;los is a list-of-shapes.


(define FACE (cons
              (make-circle (make-posn 50 50)
                           40
                           'red)
              (cons
               (make-rectangle (make-posn 30 20)
                               5
                               5
                               'blue)
               (cons
                (make-rectangle (make-posn 65 20)
                                5
                                5
                                'blue)
                (cons
                 (make-rectangle (make-posn 40 75)
                                 20
                                 10
                                 'red)
                 (cons
                  (make-rectangle (make-posn 45 35)
                                  10
                                  30
                                  'blue) empty))))))

(define (move-picture delta alosh)
  (local (;draw-losh : list-of-shapes -> boolean
          ;Consumes alosh and draws the shapes on the canvas,
          ;returning true.  If drawing fails, it returns false.
          
          (define (draw-losh alosh)
            (cond
              [(empty? alosh) true]
              [(circle? (first alosh)) (and
                                        (draw-a-circle (first alosh))
                                        (draw-losh (rest alosh)))]
              [(rectangle? (first alosh)) (and
                                           (draw-a-rectangle (first alosh))
                                           (draw-losh (rest alosh)))]
              [else false]))
          
          ;draw-a-circle : circle -> boolean?
          ;Draws a circle given a-circle (struct circle).
          
          (define (draw-a-circle a-circle)
            (draw-solid-disk (circle-center a-circle)
                             (circle-radius a-circle)
                             (circle-color a-circle)))
          
          ; draw-a-rectangle : rectangle -> boolean
          ; Returns true after drawing, consumes a-rect.
          
          (define (draw-a-rectangle a-rect)
            (draw-solid-rect (rectangle-upper-left a-rect)
                             (rectangle-width a-rect)
                             (rectangle-height a-rect)
                             (rectangle-color a-rect)))
          
          ;translate-losh : list-of-shapes number -> list-of-shapes
          ;Given alosh, returns a list-of-shapes that have translated
          ;delta pixels in the x direction.  This function
          ;does not affect the canvas.
          
          (define (translate-losh alosh delta)
            (cond
              [(empty? alosh) empty]
              [(circle? (first alosh))
               (cons
                (make-circle
                 (make-posn (+ (posn-x (circle-center (first alosh)))
                               delta)
                            (posn-y (circle-center (first alosh))))
                 (circle-radius (first alosh))
                 (circle-color (first alosh)))
                (translate-losh (rest alosh) delta))]
              [(rectangle? (first alosh))
               (cons
                (make-rectangle
                 (make-posn (+ (posn-x (rectangle-upper-left (first alosh)))
                               delta)
                            (posn-y (rectangle-upper-left (first alosh))))
                 (rectangle-width (first alosh))
                 (rectangle-height (first alosh))
                 (rectangle-color (first alosh)))
                (translate-losh (rest alosh) delta))]
              [else (error 'translate-losh "unexpected error")]))
          
          ;clear-losh : list-of-shapes -> boolean
          ;Clears shapes corresponding to entries in alosh
          ;and returns true.  Does so by calling clear-a-rectangle
          ;and clear-a-circle.
          
          (define (clear-losh alosh)
            (cond
              [(empty? alosh) true]
              [(circle? (first alosh)) (and
                                        (clear-a-circle (first alosh))
                                        (clear-losh (rest alosh)))]
              [(rectangle? (first alosh)) (and
                                           (clear-a-rectangle (first alosh))
                                           (clear-losh (rest alosh)))]
              [else false]))
          
          ; clear-a-circle : circle -> boolean
          ; Clears a circle given a-circle, returns true if
          ; evaluation completes successfully, false otherwise.
          
          (define (clear-a-circle a-circle)
            (clear-solid-disk (circle-center a-circle)
                              (circle-radius a-circle)))
          
          ; clear-a-rectangle : rectangle -> boolean
          ; Clears rectangle specified by a-rect and returns true
          ; if evaluation suceeds, false otherwise.
          
          (define (clear-a-rectangle a-rect)
            (clear-solid-rect (rectangle-upper-left a-rect)
                              (rectangle-width a-rect)
                              (rectangle-height a-rect)))
          
          ;Data Definition
          ;
          ;A picture is a list-of-shapes?, I think.
          ;
          ;draw-and-clear-picture : picture -> boolean
          ;Draws alosh, sleeps for a while, then clears alosh.
          ;!!!CHANGE!!! Now it clears, sleeps for a while,
          ;then draws alosh.
          
          (define (draw-and-clear-picture alosh)
            (and
             
             (draw-losh alosh)
             (sleep-for-a-while 0.1)
             (clear-losh alosh)))
          ;
          ;move-picture : number picture -> picture
          ;Draws a picture delta pixels to the right, sleeps for a while,
          ;clears the picture, and then returns the translated picture.
          
          (define (move-picture delta alosh)
            (cond
              [(draw-and-clear-picture (translate-losh alosh delta))
               (translate-losh alosh delta)]
              [else false])))
    (move-picture delta alosh)))

(start 500 500)
(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)))))))))))))))))))))))))))))))))))))))))