[plt-scheme] arrow.ss teachpack

Okay, I'm working on this lunar lander thing as a whole, so I am sending
also the code that processes shapes and lists of shapes, since that is used
in my lunar lander programs. Thanks a lot for the help.

-Connor

;; a shape is either
;; a square or
;; a circle or
;; a rectangle

;; a square is 
;; a structure with nw l c where
;; nw is a posn and l is a number and c is a symbol
;; Template:
;; fun-for-square : square -> ???
;(define (fun-for-square s)
;  (square-nw s) ... (square-length s) ... (square-color s) ...)
(define-struct square (nw length color))

;; process-square : square symbol -> boolean
(define (process-square s op)
  (cond
    [ (symbol=? op 'draw) (draw-solid-rect (make-posn (posn-x (square-nw s))
                                                      (posn-y (square-nw
s)))
                                           (square-length s)
                                           (square-length s)
                                           (square-color s))]
    [ (symbol=? op 'clear) (clear-solid-rect (make-posn (posn-x (square-nw
s))
                                                        (posn-y (square-nw
s)))
                                             (square-length s)
                                             (square-length s)
                                             (square-color s))]))

;; translate-square : square symbol number -> square
(define (translate-square s dir delta)
  (cond
    [ (symbol=? dir 'hor) (make-square (make-posn (+ delta (posn-x
(square-nw s)))
                                                (posn-y (square-nw s)))
                                     (square-length s)
                                     (square-color s))]
    [ (symbol=? dir 'ver) (make-square (make-posn (posn-x (square-nw s))
                                                  (+ delta (posn-y
(square-nw s))))
                                       (square-length s)
                                       (square-color s))]))
  
;; draw-and-clear-square : square -> boolean
(define (draw-and-clear-square s)
  (and (process-square s 'draw) (sleep-for-a-while 3) (process-square s
'clear)))

;; move-square : square symbol number -> boolean
(define (move-square s dir delta)
  (and (draw-and-clear-square s) (process-square (translate-square s dir
delta) 'draw)))


;; a circle is
;; a structure with cr r c where
;; cr is a posn and r is a number and c is a symbol

;; fun-for-circle : circle -> ???
;(define (fun-for-circle c)
;  (circle-center c) ... (circle-radius c) ... (circle-color c) ...)
(define-struct circle (center radius color))

;; process-circle : circle symbol -> boolean
(define (process-circle c op)
  (cond
    [ (symbol=? op 'draw) (draw-solid-disk (make-posn
                                            (posn-x (circle-center c))
                                            (posn-y (circle-center c)))
                                           (circle-radius c)
                                           (circle-color c))]
    [ (symbol=? op 'clear) (clear-solid-disk (make-posn
                                            (posn-x (circle-center c))
                                            (posn-y (circle-center c)))
                                           (circle-radius c)
                                           (circle-color c))]))

;; translate-circle : circle symbol number -> circle
(define (translate-circle c dir delta)
  (cond
    [ (symbol=? dir 'hor) (make-circle (make-posn (+ delta (posn-x
(circle-center c)))
                                                (posn-y (circle-center c)))
                                     (circle-radius c)
                                     (circle-color c))]
    [ (symbol=? dir 'ver) (make-circle (make-posn (posn-x (circle-center c))
                                                  (+ delta (posn-y
(circle-center c))))
                                       (circle-radius c)
                                       (circle-color c))]))
  

;; draw-and-clear-circle : circle -> boolean
(define (draw-and-clear-circle c)
  (and (process-circle c 'draw) (sleep-for-a-while 3) (process-circle 'clear
c)))

;; move-circle : circle symbol number -> boolean
(define (move-circle c dir delta)
  (and (draw-and-clear-circle c) (process-circle (translate-circle c dir
delta) 'draw)))

;; a rectangle is
;; a structure with nw w h c where
;; nw is a posn and w is a number and h is a number and c is a symbol

;; fun-for-rectangle : rectangle -> ???
;(define (fun-for-rectangle r)
;  (rectangle-nw r) ... (rectangle-width r) ... (rectangle-height r) ...
(rectangle-color r) ...)
(define-struct rectangle (nw width height color))

;; process-rectangle : rectangle symbol -> boolean
(define (process-rectangle r op)
  (cond
    [ (symbol=? op 'draw) (draw-solid-rect (make-posn (posn-x (rectangle-nw
r))
                                                      (posn-y (rectangle-nw
r)))
                                           (rectangle-width r)
                                           (rectangle-height r)
                                           (rectangle-color r))]
    [ (symbol=? op 'clear) (clear-solid-rect (make-posn (posn-x
(rectangle-nw r))
                                                        (posn-y
(rectangle-nw r)))
                                             (rectangle-width r)
                                             (rectangle-height r)
                                             (rectangle-color r))]))

;; translate-rectangle : rectangle symbol number -> rectangle
(define (translate-rectangle r dir delta)
  (cond
    [ (symbol=? dir 'hor) (make-rectangle (make-posn (+ delta (posn-x
(rectangle-nw r)))
                                                (posn-y (rectangle-nw r)))
                                     (rectangle-width r)
                                     (rectangle-height r)
                                     (rectangle-color r))]
    [ (symbol=? dir 'ver) (make-rectangle (make-posn (posn-x (rectangle-nw
r))
                                                     (+ delta (posn-y
(rectangle-nw r))))
                                          (rectangle-width r)
                                          (rectangle-height r)
                                          (rectangle-color r))]))
  
;; draw-and-clear-rectangle : rectangle -> boolean
(define (draw-and-clear-rectangle r)
  (and (process-rectangle r 'draw) (sleep-for-a-while 3) (process-rectangle
r 'clear))) 

;; move-rectangle : rectangle symbol number -> boolean
(define (move-rectangle r dir delta)
  (and (draw-and-clear-rectangle r) (process-rectangle (translate-rectangle
r dir delta) 'draw)))

;; process-shape : shape symbol
(define (process-shape a-shape op)
  (cond
    [ (square? a-shape) (process-square a-shape op)]
    [ (circle? a-shape) (process-circle a-shape op)]
    [ (rectangle? a-shape) (process-rectangle a-shape op)]))

;; translate-shape : shape symbol number -> shape
(define (translate-shape a-shape dir delta)
  (cond
    [ (square? a-shape) (translate-square a-shape dir delta)]
    [ (circle? a-shape) (translate-circle a-shape dir delta)]
    [ (rectangle? a-shape) (translate-rectangle a-shape dir delta)]))



;; draw-and-clear-shape : shape -> boolean
(define (draw-and-clear-shape a-shape)
  (cond
    [ (square? a-shape) (draw-and-clear-square a-shape)]
    [ (circle? a-shape) (draw-and-clear-circle a-shape)]
    [ (rectangle? a-shape) (draw-and-clear-rectangle a-shape)]))
;; move-shape : shape symbol number -> boolean
(define (move-shape a-shape dir delta)
  (cond
    [ (square? a-shape) (move-square a-shape dir delta)]
    [ (circle? a-shape) (move-circle a-shape dir delta)]
    [ (rectangle? a-shape) (move-rectangle a-shape dir delta)]))

;; alosh is either
;; empty, or
;; (cons shape alosh)

;; Template
;; fun-for-losh : list-of-shapes -> ???
;;(define (fun-for-losh alosh)
;;  (cond
;;    [ (empty? alosh) ...]
;;    [ else ... (first alosh) ... (fun-for-losh (rest alosh))]))
;; draw-losh : list-of-shapes -> boolean
(define (draw-losh alosh)
  (cond
    [ (empty? alosh) true]
    [ (cons? alosh) (and (process-shape (first alosh) 'draw) (draw-losh
(rest alosh)))]))
;; translate-losh : list-of-shapes symbol number -> list-of-shapes
(define (translate-losh alosh dir delta)
  (cond
    [ (empty? alosh) empty]
    [ (cons? alosh) (cons (translate-shape (first alosh) dir delta)
                         (translate-losh (rest alosh) dir delta))]))
;; clear-losh : list-of-shapes -> boolean
(define (clear-losh alosh)
  (cond
    [ (empty? alosh) true]
    [ (cons? alosh) (and (process-shape (first alosh) 'clear) (clear-losh
(rest alosh)))]))
;; draw-and-clear-picture : list-of-shapes -> boolean
(define (draw-and-clear-picture alosh)
  (cond
    [ (empty? alosh) true]
    [ (cons? alosh) (and (draw-losh alosh)
                         (sleep-for-a-while 1)
                         (clear-losh alosh))]))
;; move-picture : list-of-shapes symbol number -> boolean
(define (move-picture alosh dir delta)
  (cond
    [ (empty? alosh) empty]
    [ (cons? alosh) (and (draw-and-clear-picture alosh)
                         (draw-losh (translate-losh alosh dir delta)))]))
(define LUNAR (cons (make-circle (make-posn 50 30) 25 'black)
                    (cons (make-rectangle (make-posn 25 30) 2 50 'black)
                          (cons (make-rectangle (make-posn 73 30) 2 50
'black)
                                (cons (make-square (make-posn 33 12) 35
'red) empty)))))
;; ud-lander : number -> boolean
(define (ud-lander delta)
  (move-picture LUNAR 'ver delta))
;; lr-lander : number -> boolean
(define (lr-lander delta)
  (move-picture LUNAR 'hor delta))
(start 300 300)
(draw-losh LUNAR)
(control-up-down LUNAR 10 ud-lander draw-losh)


on 2/28/04 11:12 AM, Matthias Felleisen at matthias at ccs.neu.edu wrote:

> Can you send me the code? I will see what I can do.
> 
> -- Matthias
> 
> 
> On Feb 28, 2004, at 12:04 AM, Connor Ferguson wrote:
> 
>> For list-related administrative tasks:
>> http://list.cs.brown.edu/mailman/listinfo/plt-scheme
>> 
>> I have been using the arrow.ss teachpack to do the Lunar Lander
>> exercise in
>> Section 21.4 of HTDP. I evaluated exactly what was written in the book
>> to
>> control the lander up and down and it was giving me all kinds of error
>> messages, which seemed to contradict the information in the Help Desk
>> of
>> DrScheme on arrow.ss. Can anyone give me some insight on this? I am
>> using
>> the language Intermediate Student with lambda.
>> 
>> -Connor
> 
>