; at: http://www.ccs.neu.edu/home/matthias/HtDP/Extended/igames.html ;; 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)) ;; draw-a-square : square -> boolean (define (draw-a-square s) (draw-solid-rect (make-posn (posn-x (square-nw s)) (posn-y (square-nw s))) (square-length s) (square-length s) (square-color s))) ;; clear-a-square : square -> boolean (define (clear-a-square s) (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 number -> square (define (translate-square s delta) (make-square (make-posn (+ delta (posn-x (square-nw s))) (posn-y (square-nw s))) (square-length s) (square-color s))) ;; draw-and-clear-square : square -> boolean (define (draw-and-clear-square s) (and (draw-a-square s) (sleep-for-a-while 3) (clear-a-square s))) ;; move-square : square number -> boolean (define (move-square s delta) (and (draw-and-clear-square s) (draw-a-square (translate-square s delta)))) ;; 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)) ;; draw-a-circle : circle -> boolean (define (draw-a-circle c) (draw-solid-disk (make-posn (posn-x (circle-center c)) (posn-y (circle-center c))) (circle-radius c) (circle-color c))) ;; clear-a-circle : circle -> boolean (define (clear-a-circle c) (clear-solid-disk (make-posn (posn-x (circle-center c)) (posn-y (circle-center c))) (circle-radius c) (circle-color c))) ;; translate-circle : circle number -> circle (define (translate-circle c delta) (make-circle (make-posn (+ delta (posn-x (circle-center c))) (posn-y (circle-center c))) (circle-radius c) (circle-color c))) ;; draw-and-clear-circle : circle -> boolean (define (draw-and-clear-circle c) (and (draw-a-circle c) (sleep-for-a-while 3) (clear-a-circle c))) ;; move-circle : circle number -> boolean (define (move-circle c delta) (and (draw-and-clear-circle c) (draw-a-circle (translate-circle c delta)))) ;; 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)) ;; draw-a-rectangle : square -> boolean (define (draw-a-rectangle r) (draw-solid-rect (make-posn (posn-x (rectangle-nw r)) (posn-y (rectangle-nw r))) (rectangle-width r) (rectangle-height r) (rectangle-color r))) ;; clear-a-rectangle : square -> boolean (define (clear-a-rectangle r) (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 number -> rectangle (define (translate-rectangle r delta) (make-rectangle (make-posn (+ delta (posn-x (rectangle-nw r))) (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 (draw-a-rectangle r) (sleep-for-a-while 3) (clear-a-rectangle r))) ;; move-rectangle : rectangle number -> boolean (define (move-rectangle r delta) (and (draw-and-clear-rectangle r) (draw-a-rectangle (translate-rectangle r delta)))) ;; draw-a-shape : shape -> boolean (define (draw-a-shape a-shape) (cond [ (square? a-shape) (draw-a-square a-shape)] [ (circle? a-shape) (draw-a-circle a-shape)] [ (rectangle? a-shape) (draw-a-rectangle a-shape)])) ;; translate-shape : shape number -> shape (define (translate-shape a-shape delta) (cond [ (square? a-shape) (translate-square a-shape delta)] [ (circle? a-shape) (translate-circle a-shape delta)] [ (rectangle? a-shape) (translate-rectangle a-shape delta)])) ;; clear-a-shape : shape -> boolean (define (clear-a-shape a-shape) (cond [ (square? a-shape) (clear-a-square a-shape)] [ (circle? a-shape) (clear-a-circle a-shape)] [ (rectangle? a-shape) (clear-a-rectangle a-shape)])) ;; 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 number -> boolean (define (move-shape a-shape delta) (cond [ (square? a-shape) (move-square a-shape delta)] [ (circle? a-shape) (move-circle a-shape delta)] [ (rectangle? a-shape) (move-rectangle a-shape 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 (draw-a-shape (first alosh)) (draw-losh (rest alosh)))])) ;; translate-losh : list-of-shapes -> list-of-shapes (define (translate-losh alosh delta) (cond [ (empty? alosh) empty] [ (cons? alosh) (cons (translate-shape (first alosh) delta) (translate-losh (rest alosh) delta))])) ;; clear-losh : list-of-shapes -> boolean (define (clear-losh alosh) (cond [ (empty? alosh) true] [ (cons? alosh) (and (clear-a-shape (first alosh)) (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 number -> boolean (define (move-picture alosh delta) (cond [ (empty? alosh) empty] [ (cons? alosh) (and (draw-and-clear-picture alosh) (draw-losh (translate-losh alosh delta)))])) ;; random-n-m : integer integer -> integer ;; Assume: n < m (define (random-n-m n m) (+ (random (- m n)) n)) ;; stars : number number number -> boolean (define (stars n x y) (cond [ (zero? n) true] [ (= 1 n) (draw-solid-disk (make-posn (random x) (random y)) (random-n-m 1 2) 'white)] [ (< 1 n) (and (draw-a-shape (make-circle (make-posn (random x) (random y)) (random-n-m 1 2) 'white)) (stars (sub1 n) x y))])) ;; up-or-down : KeyEvent -> boolean (define (up-or-down ke) (or (symbol=? ke 'up) (symbol=? ke 'down))) ;; move-how-far? : KeyEvent -> number (define (move-how-far? ke) (cond [ (boolean? ke) 0] [ (char? ke) 0] [ else (cond [ (symbol=? 'left ke) -10] [ (symbol=? 'right ke) +10] [ else 0])])) ;; an AUP is a shape ;; (make-aup p l w c) ;; where p is a posn, l is a number, w is a number ;; and c is a symbol (define-struct aup (nw len wid col)) ;; create-aup : number -> AUP (define (create-aup n) (make-aup (make-posn n 296) 22 4 'blue)) ;; move-aup : AUP KeyEvent -> AUP (define (move-aup aup ke) (cond [ (symbol? ke) (cond [ (symbol=? 'left ke) (make-aup (make-posn (- (posn-x (aup-nw aup)) 10) (posn-y (aup-nw aup))) (aup-len aup) (aup-wid aup) (aup-col aup))] [ (symbol=? 'right ke) (make-aup (make-posn (+ (posn-x (aup-nw aup)) 10) (posn-y (aup-nw aup))) (aup-len aup) (aup-wid aup) (aup-col aup))] [ (or (symbol=? 'up ke) (symbol=? 'down ke)) aup])] [ else aup])) (move-aup (create-aup 139) 'left) ;; draw-aup : aup -> true (define (draw-aup aup) (draw-solid-rect (aup-nw aup) (aup-len aup) (aup-wid aup) (aup-col aup))) ;; clear-aup : aup -> true (define (clear-aup aup) (clear-solid-rect (aup-nw aup) (aup-len aup) (aup-wid aup) (aup-col aup))) ;; move-n-times : N aup -> boolean (define (move-n-times n an-aup) (cond [ (zero? n) true] [ else (and (draw-aup an-aup) (sleep-for-a-while .05) (clear-aup an-aup) (move-n-times (sub1 n) (move-aup an-aup (get-key-event))))])) ;; a UFO is a shape ;; (make-ufo p l w c) ;; where p is a posn, l is a number, w is a number ;; and c is a symbol (define-struct ufo (nw len wid col)) ;; create-ufo : number -> boolean (define (create-ufo n) (make-ufo (make-posn n 0) 20 2 'green)) ;; draw-ufo : ufo -> boolean (define (draw-ufo ufo) (draw-solid-rect (ufo-nw ufo) (ufo-len ufo) (ufo-wid ufo) (ufo-col ufo))) ;; clear-ufo : ufo -> boolean (define (clear-ufo ufo) (draw-solid-rect (ufo-nw ufo) (ufo-len ufo) (ufo-wid ufo) 'black)) ;; random-range : number -> number (define (random-range n) (- (random (* 2 n)) n)) ;; at-left? : UFO -> boolean (define (at-left? ufo) (<= (posn-x (ufo-nw ufo)) 0)) ;; at-right? : UFO -> boolean (define (at-right? ufo) (>= (posn-x (ufo-nw ufo)) 280)) ;; move-back : UFO -> UFO (define (move-back ufo) (cond [ (at-right? ufo) (make-ufo (make-posn 280 (posn-y (ufo-nw ufo))) (ufo-len ufo) (ufo-wid ufo) (ufo-col ufo))] [ (at-left? ufo) (make-ufo (make-posn 0 (posn-y (ufo-nw ufo))) (ufo-len ufo) (ufo-wid ufo) (ufo-col ufo))] [ else ufo])) ;; move-ufo : ufo number -> ufo (define (move-ufo ufo n) (move-back (make-ufo (make-posn (+ (posn-x (ufo-nw ufo)) (random-range n)) (+ (posn-y (ufo-nw ufo)) 2)) (ufo-len ufo) (ufo-wid ufo) (ufo-col ufo)))) ;; at-bottom? : ufo -> boolean (define (at-bottom? ufo) (cond [ (>= (posn-y (ufo-nw ufo)) 294) true] [ else false])) (define-struct shot (posn l w col)) ;; a shot is a stucture ;;(make-shot start l w col) ;; where start is a posn (the position of the AUP) ;; l is a number, w is a number, and col is a symbol ;; create-shot : posn -> shot (define (create-shot a-posn) (make-shot (make-posn (- (posn-x a-posn) 20) (+ (posn-y a-posn) 6)) 2 5 'red)) ;; move-shot : shot -> shot (define (move-shot a-shot) (make-shot (make-posn (posn-x (shot-posn a-shot)) (- 5 (posn-y (shot-posn a-shot)))) (shot-l a-shot) (shot-w a-shot) (shot-col a-shot))) ;; draw-shot : shot -> boolean (define (draw-shot a-shot) (draw-solid-rect (shot-posn a-shot) (shot-l a-shot) (shot-w a-shot) (shot-col a-shot))) ;; clear-shot : shot -> boolean (define (clear-shot a-shot) (clear-solid-rect (shot-posn a-shot) (shot-l a-shot) (shot-w a-shot) (shot-col a-shot))) ;; announcement : boolean string -> string (define (announcement result name) (cond [ result (print (string-append name " has defeated the UFO!"))] [ else (print (string-append "The UFO has defeated " name "!"))])) ;; A Shot/f is one of the following ;; --- a shot ; ;; --- false ;; draw-scene : AUP UFO Shot/f -> boolean (define (draw-scene ufo aup a-shot) (cond [ (shot? a-shot) (and (draw-aup aup) (draw-ufo ufo) (draw-shot a-shot))] [ else (and (draw-aup aup) (draw-ufo ufo))])) ;; clear-scene : AUP UFO Shot/f -> boolean (define (clear-scene ufo aup a-shot) (cond [ (shot? a-shot) (and (clear-aup aup) (clear-ufo ufo) (clear-shot a-shot))] [ else (and (clear-aup aup) (clear-ufo ufo))])) ;; landed-on-aup? : AUP UFO -> boolean (define (landed-on-aup? aup ufo) (and (at-bottom? ufo) (and (<= (posn-x (ufo-nw ufo)) (+ (posn-x (aup-nw aup)) 19)) (>= (posn-x (ufo-nw ufo)) (- (posn-x (aup-nw aup)) 21))))) ;; hit-shot? : shot UFO -> boolean (define (hit-shot? shot ufo) (and (and (>= (posn-x (shot-posn shot)) (posn-x (ufo-nw ufo))) (<= (posn-x (shot-posn shot)) (+ (posn-x (ufo-nw ufo)) 18))) (and (>= (posn-y (shot-posn shot)) (posn-y (ufo-nw ufo))) (<= (posn-y (shot-posn shot)) (+ (posn-y (ufo-nw ufo)) 2))))) ;; fly-until-down : UFO AUP number Shot/f -> Boolean ;; if the UFO is caught, produce true (define (fly-until-down ufo an-aup n a-shot) (cond [ (at-bottom? ufo) (landed-on-aup? an-aup ufo)] [ (and (not (boolean? a-shot)) (hit-shot? a-shot ufo)) (draw-scene ufo an-aup a-shot)] [ else (and (draw-scene ufo an-aup a-shot) (sleep-for-a-while .05) (clear-scene ufo an-aup a-shot) (manage (get-key-event) (move-ufo ufo n) an-aup n (move-shot/f a-shot)))])) ;; manage : KeyEvent UFO AUP Shot/f -> boolean (define (manage ke ufo an-aup n a-shot) (cond [ (boolean? ke) (fly-until-down ufo an-aup n a-shot)] [ (char? ke) (fly-until-down ufo an-aup n a-shot)] [ (symbol=? ke 'up) (cond [ (boolean? a-shot) (fly-until-down ufo an-aup n (create-shot (aup-nw an-aup)))] [ else (fly-until-down ufo an-aup n a-shot)])] [ else (fly-until-down ufo (move-aup an-aup ke) n a-shot)])) ;; move-shot/f : shot/f -> shot/f (define (move-shot/f a-shot) (cond [ (boolean? a-shot) a-shot] [ else (move-shot a-shot)])) ;; draw-background : number -> boolean (define (draw-background n) (and (draw-solid-rect (make-posn 0 0) 300 296 'black) (draw-solid-rect (make-posn 25 230) 2 66 'white) (draw-solid-rect (make-posn 15 286) 23 10 'white) (draw-solid-rect (make-posn 20 276) 12 10 'white) (draw-solid-rect (make-posn 25 227) 2 3 'red) (stars n 300 300))) ;; help : string -> string (define (help name) (print (string-append name ", Welcome to UFOs! the product of the brilliant mind of Connor Ferguson. You have asked for help running this game. To start a new game type (main ') and click Execute at the top of the window. The levels you can play at are: 'wimpy, 'easy, 'medium, 'hard, and 'deathmatch. Please type the level exactly as it appears here, with the apostrophe and no space. Thanks for playing!"))) ;; main : string symbol -> string (define (main name level) (cond [ (symbol=? level 'wimpy) (print "You lazy idiot! You're better than that!")] [ (symbol=? level 'easy) (announcement (fly-until-down (create-ufo 140) (create-aup 139) 10 false) name)] [ (symbol=? level 'medium) (announcement (fly-until-down (create-ufo 140) (create-aup 139) 15 false) name)] [ (symbol=? level 'hard) (announcement (fly-until-down (create-ufo 140) (create-aup 139) 20 false) name)] [ (symbol=? level 'ridiculous) (announcement (fly-until-down (create-ufo 140) (create-aup 139) 30 false) name)] [ (symbol=? level 'deathmatch) (announcement (fly-until-down (create-ufo 140) (create-aup 139 false) 40) name)])) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ; ; ; ;; ;; ;;;;; ;;; ;;;; ;; ; ;; ;; ;;;;; ;;;;; ;;;;;; ;; ; ;; ;; ;; ;; ;; ;; ; ;; ; ;; ;; ;; ;; ;; ;;; ;; ; ;; ;; ;;;;; ;; ;; ;;;; ;; ; ;; ;; ;; ;; ;; ;;; ;; ; ;; ;; ;; ;; ;; ; ;; ; ;;; ;;; ;; ;;;;; ;;;;;; ;; ; ;;;;; ;; ;;; ;;;; ;; ; ; ; (start 300 300) (draw-background 125) (main "Connor" 'easy)