From ChekMate Security Group
;; SpaceInvaders.scm
;; 6.0
;; Copyright (C) 2006 Joshua D. Abraham (jabra@ccs.neu.edu)
;;
;; This program is released under the terms of the GNU General Public License
;; (GPL), which is distributed with this software in the file "COPYING".
;; The GPL specifies the terms under which users may copy and use this software.
;;
;; Name: (c) Josh Abraham
;; (c) Dong Zou
;; Date: March 25, 2004
;; Purpose: fully implemented space invaders game
;;
;; NOTE
;; You will need to add the following teach-packs to drscheme
;; gui
;; draw
;; Space Invader V6.0 has three levels
;; 1st level 4 ufos
;; 2nd level 12 ufos
;; 3rd level 24 ufos
;; each ufo is 5 points
;; player have 3 lives
;; player can only shot 8 shoots at once
"--------UFO-------"
(define aup-lives 3)
(define shot-speed 10)
(define shot-limit 8)
(define ufo-shot-speed 5)
(define aup-speed 10)
(define x-change-by 3)
(define y-change-by 3)
(define chance-of-fire 100);; chance of fire for ufo is 1 out of (chance-of-fire)
;; width>=300 height>=300
(define width 300)
(define height 300)
(define bottom (- height 5))
(start width height)
;;------------------------------------------------------------------------------
;; A UFO is:
;; (make-posn number number)
;; Examples for UFO
(define ufo0 (make-posn 55 3))
(define ufo1 (make-posn 55 255))
(define ufo2 (make-posn 75 225))
(define ufo3 (make-posn 55 200))
(define ufo4 (make-posn 75 125))
;;------------------------------------------------------------------------------
;; list of ufo(short:loufo) is one of:
;; - empty
;; - (cons ufo loufo)
;; example
(define start-loufo (list (make-posn (/ width 2) 0) (make-posn (/ width 2)
-10) (make-posn (/ width 2) -20) (make-posn (/ width 2) -30)))
(define ufos-level1 (list (make-posn (/ width 2) 10) (make-posn (/ width 2)
100) (make-posn (/ width 2) 200)
(make-posn (/ width 2) 300)))
(define ufos-level2 (list (make-posn (/ width 2) -50) (make-posn (/ width
2) -100) (make-posn (/ width 2) -150)
(make-posn (/ width 2) -200) (make-posn (/ width
2) -250) (make-posn (/ width 2) -300)
(make-posn (/ width 2) -350) (make-posn (/ width
2) -400) (make-posn (/ width 2) -450)
(make-posn (/ width 2) -500) (make-posn (/ width
2) -550) (make-posn (/ width 2) -600)))
(define ufos-level3 (list (make-posn (/ width 2) -50) (make-posn (/ width
2) -100) (make-posn (/ width 2) -150)
(make-posn (/ width 2) -200) (make-posn (/ width
2) -250) (make-posn (/ width 2) -300)
(make-posn (/ width 2) -350) (make-posn (/ width
2) -400) (make-posn (/ width 2) -450)
(make-posn (/ width 2) -500) (make-posn (/ width
2) -550) (make-posn (/ width 2) -600)
(make-posn (/ width 2) -650) (make-posn (/ width
2) -700) (make-posn (/ width 2) -750)
(make-posn (/ width 2) -800) (make-posn (/ width
2) -850) (make-posn (/ width 2) -900)
(make-posn (/ width 2) -950) (make-posn (/ width
2) -1000) (make-posn (/ width 2) -1050)
(make-posn (/ width 2) -1100) (make-posn (/ width
2) -1150) (make-posn (/ width 2) -1200)))
#| fire testing use
(define start-loufo3 (list (make-posn (/ width 2) 0) (make-posn (/ width
2) 10) (make-posn (/ width 2) 20)
(make-posn (/ width 2) 30) (make-posn (/ width
2) 40) (make-posn (/ width 2) 50)
(make-posn (/ width 2) 60) (make-posn (/ width 2)
70) (make-posn (/ width 2) 80)
(make-posn (/ width 2) 90) (make-posn (/ width 2)
100) (make-posn (/ width 2) 110)
(make-posn (/ width 2) 120) (make-posn (/ width
2) 130) (make-posn (/ width 2) 140)
(make-posn (/ width 2) 150) (make-posn (/ width
2) 160) (make-posn (/ width 2) 170)
(make-posn (/ width 2) 180) (make-posn (/ width
2) 190) (make-posn (/ width 2) 200)
(make-posn (/ width 2) 210) (make-posn (/ width
2) 220) (make-posn (/ width 2) 230)))
|#
(define loufo0 empty)
(define loufo1 (cons ufo1 (cons ufo2 empty)))
(define loufo2 (cons ufo3 (cons ufo4 empty)))
;;------------------------------------------------------------------------------
;; ************ this section is copy from HW 8 ************
;; <=? : number number number -> boolean
;; see if the given numbers are in order of <=(a<=b<=c ?)
(define (<=? a b c)
(local ((define a<=b?(or (< a b) (= a b)))
(define b<=c?(or (< b c) (= b c))))
(and a<=b? b<=c?)))
;; Examples/tests for <=?
(equal? (<=? 1 2 3) true)
(equal? (<=? 1 1 1) true)
(equal? (<=? 36 37 37) true)
(equal? (<=? 35 33 32) false)
(equal? (<=? 35 80 75) false)
(equal? (<=? 21 15 79) false)
;; "random" already build in
;; random : N -> N
;; to compute a natural number between 0 and n-1
;; (define (random n) ...)
;; random-n-m : integer integer -> integer
;; Assume: n < m
;; randomly create a number with is between n and m
(define (random-in-range lower upper)
(+ (random (+ (- upper lower ) 1)) lower))
;; example for random
(<=? 2 (random-in-range 2 20) 20)
(<=? 2 (random-in-range 2 20) 20)
(<=? 5 (random-in-range 5 8) 8)
;;------------------------------------------------------------------------------
;; ufo<=? : UFO UFO UFO -> boolean
;; see if the given UFOs are in order of
;; au be at the left top or equal to bu, and
;; bu be at the left top or equal to cu.
(define (ufo<=? au bu cu)
(local ((define au<=bu?(and (or (< (posn-x au) (posn-x bu)) (= (posn-x au)
(posn-x bu)))
(or (< (posn-y au) (posn-y bu)) (= (posn-y au)
(posn-y bu)))))
(define bu<=cu?(and (or (< (posn-x bu) (posn-x cu)) (= (posn-x bu)
(posn-x cu)))
(or (< (posn-y bu) (posn-y cu)) (= (posn-y bu)
(posn-y cu))))))
(and au<=bu? bu<=cu?)))
;; Examples/tests for ufo<=?
(ufo<=? (make-posn 30 240) (make-posn 30 240) (make-posn 30 240))
(ufo<=? (make-posn 30 240) (make-posn 35 248) (make-posn 35 249))
(ufo<=? (make-posn 8 240) (make-posn 8 241) (make-posn 13 242))
(ufo<=? (make-posn 8 240) (make-posn 55 250) (make-posn 66 289))
(equal? (ufo<=? (make-posn 30 240) (make-posn 19 240) (make-posn 10 240))
false)
(equal? (ufo<=? (make-posn 30 240) (make-posn 27 238) (make-posn 35 57))
false)
(equal? (ufo<=? (make-posn 8 240) (make-posn 7 240) (make-posn 13 240))
false)
(equal? (ufo<=? (make-posn 99 240) (make-posn 55 250) (make-posn 66 230))
false)
;;------------------------------------------------------------------------------
;; loufo<=? : loufo loufo loufo -> boolean
;; see if the given ufos are in order of loa <= lob <= loc
(define (loufo<=? loa lob loc)
(cond
((= (length loa) (length lob) (length loc))
(andmap (lambda (x y z) (ufo<=? x y z)) loa lob loc))
(else false)))
;; Examples/test for loufo<=?
(equal? (loufo<=? empty empty (list (make-posn 30 240))) false)
(equal? (loufo<=? empty (list (make-posn 30 240)) empty) false)
(equal? (loufo<=? (list (make-posn 30 240)) empty empty) false)
(equal? (loufo<=? empty (list (make-posn 29 245)) (list (make-posn 30 240)))
false)
(equal? (loufo<=? (list (make-posn 29 245)) empty (list (make-posn 30 240)))
false)
(equal? (loufo<=? (list (make-posn 29 245)) (list (make-posn 30 240))
empty) false)
(equal? (loufo<=? empty empty empty) true)
(equal? (loufo<=? (list (make-posn 30 240))
(list (make-posn 30 240))
(list (make-posn 30 240))) true)
(equal? (loufo<=? (list (make-posn 30 240))
(list (make-posn 35 244))
(list (make-posn 31 243))) false)
(equal? (loufo<=? (list (make-posn 30 240) (make-posn 8 240))
(list (make-posn 30 240) (make-posn 10 241))
(list (make-posn 30 240) (make-posn 13 242))) true)
(equal? (loufo<=? (list (make-posn 30 240) (make-posn 56 240))
(list (make-posn 30 240) (make-posn 24 241))
(list (make-posn 30 240) (make-posn 24 241))) false)
;;------------------------------------------------------------------------------
;; X | 0 1 2 3 4 5 6 7 8
;; | _ _ _
;; | /_|_|_\
;; | _ _ _ _ _ _/_|_|_|_|_\_ _ _ _ _ _
;; ||_|_|_|_|_|_|_|_|X|_|_|_|_|_|_|_|_|
;; ||_|_|_|_|_|_|_|_|_|_|_|_|_|_|_|_|_|
;; ||_|_|_|_|_|_|_|_|_|_|_|_|_|_|_|_|_|
;; | \_|_|_|_|_/
;; | \_|_|_/
;; |
;; | the-ufo
;; Assume that ufo's x-position will never be created to be less than 8,
;; **and** x position will never be create to be greater than (- width 9)
;; also when we move the ufo randomly it will not fail to follow that too.
;;
;; move-ran-ufo : an-ufo -> an-ufo
(define (move-ran-ufo an-ufo)
(local ((define x-ran(random-in-range (- 0 x-change-by) x-change-by))
(define y-ran(random (+ y-change-by 1)))
(define new-x(+ (posn-x an-ufo) x-ran))
(define new-y(+ (posn-y an-ufo) y-ran)))
(cond
((and (> new-x 7) (< new-x (- width 8))) (make-posn new-x new-y))
(else (make-posn (- (posn-x an-ufo) x-ran) new-y)))))
;; Examples/tests for move-ran-ufo
#|
(ufo<=? (make-posn 33 240) (move-ran-ufo (make-posn 35 240)) (make-posn 37
242))
(ufo<=? (make-posn 33 240) (move-ran-ufo (make-posn 35 240)) (make-posn 37
242))
(ufo<=? (make-posn 33 240) (move-ran-ufo (make-posn 35 240)) (make-posn 37
242))
(ufo<=? (make-posn 89 35) (move-ran-ufo (make-posn 91 35)) (make-posn 91
37))
(ufo<=? (make-posn 89 35) (move-ran-ufo (make-posn 91 35)) (make-posn 91
37))
(ufo<=? (make-posn 89 35) (move-ran-ufo (make-posn 91 35)) (make-posn 91
37))
(ufo<=? (make-posn 8 240) (move-ran-ufo (make-posn 8 240)) (make-posn 10
242))
(ufo<=? (make-posn 8 240) (move-ran-ufo (make-posn 8 240)) (make-posn 10
242))
(ufo<=? (make-posn 8 240) (move-ran-ufo (make-posn 8 240)) (make-posn 10
242))
(ufo<=? (make-posn 8 240) (move-ran-ufo (make-posn 8 240)) (make-posn 10
242))
(ufo<=? (make-posn 8 240) (move-ran-ufo (make-posn 8 240)) (make-posn 10
242))
(ufo<=? (make-posn 8 240) (move-ran-ufo (make-posn 8 240)) (make-posn 10
242))
(ufo<=? (make-posn 8 240) (move-ran-ufo (make-posn 8 240)) (make-posn 10
242))
;; many same tests, so they can have more chances to hitting all cases
;; (because it is random do we don't know which test going to hit which
case)
;; because (x-change-by and y-change-by) can be changed so the tests above
may not be usefull,
;; so the tests below are been used.
|#
(ufo<=? (make-posn (- 35 x-change-by) 240) (move-ran-ufo (make-posn 35 240))
(make-posn (+ 35 x-change-by) (+ 242 y-change-by)))
(ufo<=? (make-posn (- 35 x-change-by) 240) (move-ran-ufo (make-posn 35 240))
(make-posn (+ 35 x-change-by) (+ 242 y-change-by)))
(ufo<=? (make-posn (- 35 x-change-by) 240) (move-ran-ufo (make-posn 35 240))
(make-posn (+ 35 x-change-by) (+ 242 y-change-by)))
(ufo<=? (make-posn (- 91 x-change-by) 35) (move-ran-ufo (make-posn (- width
9) 35)) (make-posn (- width 9) (+ 35 y-change-by)))
(ufo<=? (make-posn (- 91 x-change-by) 35) (move-ran-ufo (make-posn (- width
9) 35)) (make-posn (- width 9) (+ 35 y-change-by)))
(ufo<=? (make-posn (- 91 x-change-by) 35) (move-ran-ufo (make-posn (- width
9) 35)) (make-posn (- width 9) (+ 35 y-change-by)))
(ufo<=? (make-posn 8 240) (move-ran-ufo (make-posn 8 240)) (make-posn (+ 8
x-change-by) (+ 240 y-change-by)))
(ufo<=? (make-posn 8 240) (move-ran-ufo (make-posn 8 240)) (make-posn (+ 8
x-change-by) (+ 240 y-change-by)))
(ufo<=? (make-posn 8 240) (move-ran-ufo (make-posn 8 240)) (make-posn (+ 8
x-change-by) (+ 240 y-change-by)))
(ufo<=? (make-posn 8 240) (move-ran-ufo (make-posn 8 240)) (make-posn (+ 8
x-change-by) (+ 240 y-change-by)))
(ufo<=? (make-posn 8 240) (move-ran-ufo (make-posn 8 240)) (make-posn (+ 8
x-change-by) (+ 240 y-change-by)))
(ufo<=? (make-posn 8 240) (move-ran-ufo (make-posn 8 240)) (make-posn (+ 8
x-change-by) (+ 240 y-change-by)))
(ufo<=? (make-posn 8 240) (move-ran-ufo (make-posn 8 240)) (make-posn (+ 8
x-change-by) (+ 240 y-change-by)))
(ufo<=? (make-posn 8 240) (move-ran-ufo (make-posn 8 240)) (make-posn (+ 8
x-change-by) (+ 240 y-change-by)))
(ufo<=? (make-posn 8 240) (move-ran-ufo (make-posn 8 240)) (make-posn (+ 8
x-change-by) (+ 240 y-change-by)))
(ufo<=? (make-posn 8 240) (move-ran-ufo (make-posn 8 240)) (make-posn (+ 8
x-change-by) (+ 240 y-change-by)))
;; many same tests, so they can have more chances to hitting all cases
;; (because it is random do we don't know which test going to hit which
;;case)
;;------------------------------------------------------------------------------
;; The ufo will be draw out like one show below;
;; the x's position is the-ufo, which is (make-posn (posn-x the-ufo)
;;posn-y the-fuo)).
;; _ _ _
;; /_|_|_\
;; _ _ _ _ _ _/_|_|_|_|_\_ _ _ _ _ _
;; |_|_|_|_|_|_|_|_|X|_|_|_|_|_|_|_|_|
;; |_|_|_|_|_|_|_|_|_|_|_|_|_|_|_|_|_|
;; |_|_|_|_|_|_|_|_|_|_|_|_|_|_|_|_|_|
;; \_|_|_|_|_/
;; \_|_|_/
;;
;; the-ufo
;; draw-ufo: ufo -> boolean
;; Takes an ufo and try to draw it and return a boolean
(define (draw-ufo an-ufo)
(local ((define rect (draw-solid-rect (make-posn (- (posn-x an-ufo) 8)
(posn-y an-ufo)) 17 3 'green))
(define disk (draw-solid-disk (make-posn (posn-x an-ufo) (+
(posn-y an-ufo) 1)) 4 'green)))
(and rect disk)))
;; Examples/tests for draw-ufo
;;(draw-ufo ufo3) ;;(don't need to test it, if wanted uncommment them)
;;(draw-ufo ufo4)
;;------------------------------------------------------------------------------
;; clear-ufo: ufo -> boolean
;; Takes an ufo and try to clear the ufo from the gui and return a boolean
(define (clear-ufo an-ufo)
(local ((define rect (clear-solid-rect (make-posn (- (posn-x an-ufo) 8)
(posn-y an-ufo)) 17 3 'green))
(define disk (clear-solid-disk (make-posn (posn-x an-ufo) (+
(posn-y an-ufo) 1)) 4 'green)))
(and rect disk)))
;; Examples/tests for clear-ufo
;;(clear-ufo ufo3) ;;(don't need to test it, if wanted uncomment them)
;;(clear-ufo ufo4)
;;------------------------------------------------------------------------------
;; if height = _ _ _
;; _ _ _ /_|_|_\
;; /_|_|_\ _ _ _ _ _ _/_|_|_|_|_\_ _
;;_ _ _ _
;; _ _ _ _ _ _/_|_|_|_|_\_ _ _ _ _ _ -5
;;|_|_|_|_|_|_|_|_|X|_|_|_|_|_|_|_|_|
;; |_|_|_|_|_|_|_|_|X|_|_|_|_|_|_|_|_| -4
;;|_|_|_|_|_|_|_|_|_|_|_|_|_|_|_|_|_|
;; |_|_|_|_|_|_|_|_|_|_|_|_|_|_|_|_|_| -3
;;|_|_|_|_|_|_|_|_|_|_|_|_|_|_|_|_|_|
;; |_|_|_|_|_|_|_|_|_|_|_|_|_|_|_|_|_| -2 \_|_|_|_|_/
;;
;;_____________\_|_|_|_|_/________________-1__________________\_|_|_/___________
;; \_|_|_/ 0 ufo02
;; ufo01 1
;;
;; (draw-ufo? ufo01) -> true (draw-ufo? ufo02) -> false
;; draw-ufo? : ufo -> boolean
;; see if any part of ufo can be draw out.
(define (draw-ufo? a-ufo)
(> (posn-y a-ufo) -5))
;; Examples/tests for draw-ufo?
(boolean=? (draw-ufo? (make-posn 40 -6)) false)
(boolean=? (draw-ufo? (make-posn 53 -4)) true)
(boolean=? (draw-ufo? (make-posn 50 56)) true)
;;------------------------------------------------------------------------------
;;draw-all-ufos: loufo -> true
;;takes in a list of ufos and draws them on the screen and pass back true
(define (draw-all-ufos a-loufo)
(andmap (lambda (x) (draw-ufo x)) (filter draw-ufo? a-loufo)))
;; Examples/tests for draw-list-ufo
;;(draw-all-ufos loufo0) ;;(don't need to test it, if wanted uncommon them)
;;(draw-all-ufos loufo1)
;;(draw-all-ufos loufo2)
;;------------------------------------------------------------------------------
;;clear-all-ufos: loufo -> true
;;takes in a list of ufos and clear all the ufo and pass back true
(define (clear-all-ufos a-loufo)
(andmap (lambda (x) (clear-ufo x)) (filter draw-ufo? a-loufo)))
;; Examples/tests for draw-list-ufo
;;(clear-all-ufos loufo0) ;;(don't need to test it, if wanted uncommon them)
;;(clear-all-ufos loufo1)
;;(clear-all-ufos loufo2)
;;------------------------------------------------------------------------------
;; if height = 300 _ _ _
;;______________________________________ 299
;;___________________/_|_|_\________________
;; /_|_|_\ 300 _ _ _ _ _ _/_|_|_|_|_\_ _
;;_ _ _ _
;; _ _ _ _ _ _/_|_|_|_|_\_ _ _ _ _ _ 301
;;|_|_|_|_|_|_|_|_|X|_|_|_|_|_|_|_|_|
;; |_|_|_|_|_|_|_|_|X|_|_|_|_|_|_|_|_| 302
;;|_|_|_|_|_|_|_|_|_|_|_|_|_|_|_|_|_|
;; |_|_|_|_|_|_|_|_|_|_|_|_|_|_|_|_|_|
;;|_|_|_|_|_|_|_|_|_|_|_|_|_|_|_|_|_|
;; |_|_|_|_|_|_|_|_|_|_|_|_|_|_|_|_|_| \_|_|_|_|_/
;; \_|_|_|_|_/ \_|_|_/
;; \_|_|_/ ufo02
;; ufo01
;;
;; (ufo-not-out? ufo01) -> false (ufo-not-out? ufo02)
;;-> true
;; ufo-not-out? : ufo -> boolean
(define (ufo-not-out? ufo)
(< (posn-y ufo) (+ height 2)))
(equal? (ufo-not-out? (make-posn 50 (+ height 2) )) false)
(equal? (ufo-not-out? (make-posn 60 301)) true)
(equal? (ufo-not-out? (make-posn 23 -50)) true)
;;------------------------------------------------------------------------------
;; move-all-ufos: loufo -> loufo
;; randomly move all the ufos to new position, and return the new ufos
(define (move-all-ufos a-loufo)
(map (lambda (x) (move-ran-ufo x)) (filter ufo-not-out? a-loufo)))
;;(define ufo0 (make-posn 55 3))
;;(define ufo1 (make-posn 55 255))
;;(define ufo2 (make-posn 75 225))
;;(define ufo3 (make-posn 55 200))
;;(define ufo4 (make-posn 75 125))
;;(define loufo0 empty)
;;(define loufo1 (cons ufo1 (cons ufo2 empty)))
;;(define loufo2 (cons ufo3 (cons ufo4 empty)))
;; Examples /test for move-all-ufos
(equal? (move-all-ufos loufo0) empty)
(loufo<=? (list (make-posn (- 55 x-change-by) 255) (make-posn (- 75
x-change-by) 225))
(move-all-ufos loufo1)
(list (make-posn (+ 55 x-change-by) (+ 255 y-change-by))
(make-posn (+ 75 x-change-by) (+ 225 y-change-by))))
(loufo<=? (list (make-posn (- 55 x-change-by) 200) (make-posn (- 75
x-change-by) 125))
(move-all-ufos loufo2)
(list (make-posn (+ 55 x-change-by) (+ 200 y-change-by))
(make-posn (+ 75 x-change-by) (+ 125 y-change-by))))
;;------------------------------------------------------------------------------
;; A AUP is: number
;; the number is the x position of the AUP,
;; and y position alway going to be (- height 5)=295
;; Example for AUP
(define start-aup (/ width 2))
(define aup0 50)
(define aup1 75)
;;------------------------------------------------------------------------------
;; The aup draw out is like one show below
;; the x's position is (make-posn the-aup bottom)
;; _
;; |_|
;; _ _ _ _ _|_|_ _ _ _ _
;; |_|_|_|_|_|x|_|_|_|_|_|
;; |_|_|_|_|_|_|_|_|_|_|_|
;;
;; the-aup
;; draw-aup: posn -> boolean
;; Takes an aup and try to draw the aup and return a boolean
(define (draw-aup position)
(local ((define bodypart (draw-solid-rect (make-posn (- (posn-x position)
5) (posn-y position)) 11 2 'blue))
(define toppart (draw-solid-rect (make-posn (posn-x position) (-
(posn-y position) 2)) 1 2 'blue)))
(and bodypart toppart)))
;; Examples/tests for draw-aup
;;(draw-aup (make-posn aup0 bottom)) ;;(don't need to test it, if wanted
;;uncommon them)
;;(draw-aup (make-posn aup1 bottom))
;;------------------------------------------------------------------------------
;; clear-aup: posn -> boolean
;; Takes an aup and clear the aup from ghe gui and return a boolean
(define (clear-aup position)
(local ((define bodypart (clear-solid-rect (make-posn (- (posn-x position)
5) (posn-y position)) 11 2 'blue))
(define toppart (clear-solid-rect (make-posn (posn-x position) (-
(posn-y position) 2)) 1 2 'blue)))
(and bodypart toppart)))
;; Examples/tests for clear-aup
;;(clear-aup (make-posn aup0 bottom)) ;;(don't need to test it, if wanted
;;uncommon them)
;;(clear-aup (make-posn aup1 bottom))
;;------------------------------------------------------------------------------
;; |
;; |
;; |
;; |
;; | shot1
;;
;;
;; |
;; |
;; |
;; |
;; | shot2
;;
;; any shot is make up by (1 unit * 5 unit) when is drawn
(define-struct shot (top bottom))
;; a shot is:
;; (make-shot posn posn)
;; Examples for shot
(define shot1 (make-shot (make-posn 55 285) (make-posn 55 290)))
(define shot2 (make-shot (make-posn 55 255) (make-posn 55 260)))
(define shot3 (make-shot (make-posn 75 245) (make-posn 75 250)))
(define shot4 (make-shot (make-posn 75 225) (make-posn 75 230)))
(define shot5 (make-shot (make-posn 70 205) (make-posn 70 210)))
;;------------------------------------------------------------------------------
;; list of shot(short: loshot) is one of:
;; - empty
;; - (cons shot loshot)
;; Examples for loshot
(define loshot0 empty)
(define loshot1 (cons shot1(cons shot2 empty)))
(define loshot2 (cons shot3 (cons shot4 (cons shot5 empty))))
;;------------------------------------------------------------------------------
;; not-out? shot -> boolean
;; see if top and bottom's x-position of the shot is less than 0,
;; if it is less than 0, then it is out, function will return false,
;; if not, function will return true.
(define (not-out? a-shot)
(cond
((and (> (posn-y (shot-bottom a-shot)) 0) (< (posn-y (shot-top a-shot))
(- height 1))) true)
(else false)))
;; Examples/test for shot-out?
(equal? (not-out? (make-shot (make-posn 34 -6) (make-posn 34 -1))) false)
(equal? (not-out? (make-shot (make-posn 34 -16) (make-posn 34 -11))) false)
(equal? (not-out? (make-shot (make-posn 54 -3) (make-posn 54 1))) true)
(equal? (not-out? (make-shot (make-posn 54 55) (make-posn 54 60))) true)
(equal? (not-out? (make-shot (make-posn 66 (+ height 2)) (make-posn 66 (+
height 7)))) false)
;;------------------------------------------------------------------------------
;; move-all-shots : loshot (number number -> number) number -> loshot
;; move all shots up or down shot_speed units, and return back the new list
;;of shot
(define (move-all-shots a-loshot f speed)
(local (;;move-shot : shot-> shot
;;takes in a shot and moves it the appropiate distance and returns
;;the new shot
(define (move-shot a-shot)
(make-shot (make-posn (posn-x (shot-top a-shot))
(f (posn-y (shot-top a-shot)) speed))
(make-posn (posn-x (shot-bottom a-shot))
(f (posn-y (shot-bottom a-shot))
speed)))))
(map move-shot (filter not-out? a-loshot))))
;; the definetions bellow are already define above, copy down to make it
;;easier to check for the Examples/tests
;; (define shot1 (make-shot (make-posn 55 285) (make-posn 55 290)))
;; (define shot2 (make-shot (make-posn 55 255) (make-posn 55 260)))
;; (define shot3 (make-shot (make-posn 75 245) (make-posn 75 250)))
;; (define shot4 (make-shot (make-posn 75 225) (make-posn 75 230)))
;; (define shot5 (make-shot (make-posn 70 205) (make-posn 70 210)))
;;
;; (define loshot0 empty)
;; (define loshot1 (cons shot1(cons shot2 empty)))
;; (define loshot2 (cons shot3 (cons shot4 (cons shot5 empty))))
;; Examples/tests for move-all-shots
(equal? (move-all-shots loshot0 + ufo-shot-speed) empty)
(equal? (move-all-shots loshot0 - shot-speed) empty)
;;(equal? (move-all-shots loshot1)
;; (cons (make-shot (make-posn 55 278) (make-posn 55 283))
;; (cons (make-shot (make-posn 55 248) (make-posn 55 253))
;; empty)))
;;(equal? (move-all-shots loshot2)
;; (cons (make-shot (make-posn 75 238) (make-posn 75 243))
;; (cons (make-shot (make-posn 75 218) (make-posn 75 223))
;; (cons (make-shot (make-posn 70 198) (make-posn 70
;;203)) empty))))
;; because shot-speed can be changed so the tests above may not be usefull,
;; so the tests below are been used.
(equal? (move-all-shots loshot1 - shot-speed)
(cons (make-shot (make-posn 55 (- 285 shot-speed)) (make-posn 55 (-
290 shot-speed)))
(cons (make-shot (make-posn 55 (- 255 shot-speed)) (make-posn
55 (- 260 shot-speed)))
empty)))
(equal? (move-all-shots loshot1 + ufo-shot-speed)
(cons (make-shot (make-posn 55 (+ 285 ufo-shot-speed)) (make-posn 55
(+ 290 ufo-shot-speed)))
(cons (make-shot (make-posn 55 (+ 255 ufo-shot-speed))
(make-posn 55 (+ 260 ufo-shot-speed)))
empty)))
(equal? (move-all-shots loshot2 - shot-speed)
(cons (make-shot (make-posn 75 (- 245 shot-speed)) (make-posn 75 (-
250 shot-speed)))
(cons (make-shot (make-posn 75 (- 225 shot-speed)) (make-posn
75 (- 230 shot-speed)))
(cons (make-shot (make-posn 70 (- 205 shot-speed))
(make-posn 70 (- 210 shot-speed))) empty))))
(equal? (move-all-shots loshot2 + ufo-shot-speed)
(cons (make-shot (make-posn 75 (+ 245 ufo-shot-speed)) (make-posn 75
(+ 250 ufo-shot-speed)))
(cons (make-shot (make-posn 75 (+ 225 ufo-shot-speed))
(make-posn 75 (+ 230 ufo-shot-speed)))
(cons (make-shot (make-posn 70 (+ 205 ufo-shot-speed))
(make-posn 70 (+ 210 ufo-shot-speed))) empty))))
;;-----------------------------------------------------------------------------
;; draw-all-shots: loshot symbol -> boolean
;; Takes a list of shots and produces true if all of them draw correctly
(define (draw-all-shots aloshot color)
(andmap (lambda (x) (draw-solid-line (shot-bottom x) (shot-top x) color))
aloshot))
;; Examples/test for draw-all-shots
;;(equal? (draw-all-shots loshot0 'red) true) ;;(don't need to test it, if
;;wanted uncommon them)
;;(equal? (draw-all-shots loshot1 'blue) true)
;;(equal? (draw-all-shots loshot2 'red) true)
;;------------------------------------------------------------------------------
;; clear-all-shots: loshot symbol -> boolean
;; Takes a list of shots and produces true if all of them clear correctly
(define (clear-all-shots aloshot color)
(andmap (lambda (x) (clear-solid-line (shot-bottom x) (shot-top x) color))
aloshot))
;; Examples/tests for clear-all-shots
;;(equal? (clear-all-shots loshot0 'red) true) ;;(don't need to test it, if
;;wanted uncommon them)
;;(equal? (clear-all-shots loshot1 'blue) true)
;;(equal? (clear-all-shots loshot2 'red) true)
;;-----------------------------------------------------------------------------
;;
;; | -1
;; _ _ _ _ _ _
;; | -2
;; /_|_|_ /_|_|_\
;; | -3
;; _ _ _ _ _ _/_|_|_|_|_\_ _ _ _ _ _ _ _ _ _ _
;; _/_|_|_|_|_\_ _ _ _ _ | -4
;; |_|_|_|_|_|_|_|_|X|_|_|_|_|_|_|_|_|
;; |_|_|_|_|_|_|_|_|X|_|_|_|_|_|_|_|||
;; |_|_|_|_|_|_|_|_|_|1|2|3|4|5|6|7|8| 2
;; |_|_|_|_|_|_|_|_|_|_|_|_|_|_|_|_|_|
;; |_|_|_|_|_|_|_|_|_|_|_|_|_|_|_|_||| 1
;; |_|_|_|_|_|_|_|_|_|_|_|_|_|_|_|_|_|
;; \_|_|_|_|_/ | \_|_|_|_|_/
;; \_|_|_/ | \_|_|_/
;; the-ufo |
;; | the-shot
;; (the-ufo is shoted by the-shot) (x-different can only be different
;;between 8 and -8
;; y-different can only be different
;;between 2 and -4)
;;
;; _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _
;; |_|_|_|_|_|_|_|_|x|_|_|_|_|_|_|_|_|
;; |_|_|_|_|_|_|_|_|_|_|_|_|_|_|_|_|_|
;; |_|_|_|_|_|_|_|_|_|_|_|_|_|_|_|_|_|
;; ufo is shot when the shot touch this area,
;; if the shot got the circle area outside this rectangel, ufo
;;is not shot
;;*************** Because of the shot speed and ufo move speed, some shot
;;just jump over the ufo, not shoting the ufo.************
;; got-shot? : posn posn -> boolean
;; see if the-ufo is been shot by the-shot
(define (got-shot? the-ufo the-shot)
(local ((define x-different (< (abs (- (posn-x the-ufo) (posn-x
the-shot))) 9))
(define y-different (and (< (- (posn-y the-ufo) (posn-y the-shot))
5)
(> (- (posn-y the-ufo) (posn-y the-shot))
-3))))
(and x-different y-different)))
;; the definetions bellow are already define above, copy down to make it
;; easier to check for the Examples/tests
;; (define ufo1 (make-posn 55 255))
;; (define ufo2 (make-posn 75 225))
;;
;; (define shot1 (make-shot (make-posn 55 285) (make-posn 55 290)))
;; (define shot2 (make-shot (make-posn 55 255) (make-posn 55 260)))
;; (define shot3 (make-shot (make-posn 75 245) (make-posn 75 250)))
;; (define shot4 (make-shot (make-posn 75 225) (make-posn 75 230)))
;; (define shot5 (make-shot (make-posn 70 205) (make-posn 70 210)))
(define shot6 (make-shot (make-posn 50 257) (make-posn 50 262)))
(define shot7 (make-shot (make-posn 60 251) (make-posn 60 256)))
;; Examples/tests for got-shot?
(boolean=? (got-shot? (make-posn 50 50) (make-posn 58 52)) true)
(boolean=? (got-shot? (make-posn 50 50) (make-posn 42 52)) true)
(boolean=? (got-shot? (make-posn 50 50) (make-posn 58 46)) true)
(boolean=? (got-shot? (make-posn 50 50) (make-posn 42 46)) true)
(boolean=? (got-shot? ufo1 (shot-top shot1)) false)
(boolean=? (got-shot? ufo1 (shot-top shot2)) true)
(boolean=? (got-shot? ufo2 (shot-top shot3)) false)
(boolean=? (got-shot? ufo2 (shot-top shot4)) true)
(boolean=? (got-shot? ufo1 (shot-top shot6)) true)
(boolean=? (got-shot? ufo1 (shot-top shot7)) true)
;;-----------------------------------------------------------------------------
;; hit-by-shots? : loshot UFO -> boolean
;; determine if any of the shots hit the UFO
(define (hit-by-shots? aloshot an-ufo)
(ormap (lambda (x) (got-shot? an-ufo (shot-top x))) aloshot))
;; the definetions bellow are already define above, copy down to make it
;;easier to check for the Examples/tests
;; (define ufo1 (make-posn 55 255))
;; (define ufo2 (make-posn 75 225))
;;
;; (define shot1 (make-shot (make-posn 55 285) (make-posn 55 290)))
;; (define shot2 (make-shot (make-posn 55 255) (make-posn 55 260)))
;; (define shot3 (make-shot (make-posn 75 245) (make-posn 75 250)))
;; (define shot4 (make-shot (make-posn 75 225) (make-posn 75 230)))
;; (define shot5 (make-shot (make-posn 70 205) (make-posn 70 210)))
;;
;; (define loshot0 empty)
;; (define loshot1 (cons shot1(cons shot2 empty)))
;; (define loshot2 (cons shot3 (cons shot4 (cons shot5 empty))))
;;Examples/tests for hit-by-shot?
(boolean=? (hit-by-shots? (list (make-shot (make-posn 58 52) (make-posn 58
57))) (make-posn 50 50)) true)
(boolean=? (hit-by-shots? (list (make-shot (make-posn 42 52) (make-posn 42
52))) (make-posn 50 50)) true)
(boolean=? (hit-by-shots? (list (make-shot (make-posn 58 46) (make-posn 58
46))) (make-posn 50 50)) true)
(boolean=? (hit-by-shots? (list (make-shot (make-posn 42 46) (make-posn 42
46))) (make-posn 50 50)) true)
(boolean=? (hit-by-shots? loshot0 ufo1) false)
(boolean=? (hit-by-shots? loshot1 ufo1) true)
(boolean=? (hit-by-shots? loshot2 ufo1) false)
(boolean=? (hit-by-shots? loshot1 ufo2) false)
(boolean=? (hit-by-shots? loshot2 ufo2) true)
;;-----------------------------------------------------------------------------
;; ************** this is not use on this version(version 3.0)
;;***********************
;; _ _ _
;; /_|_|_\
;; _ _ _ _ _ _/_|_|_|_|_\_ _ _ _ _ _
;; 291 |_|_|_|_|_|_|_|_|X|_|_|_|_|_|_|_|_|
;; 292 |_|_|_|_|_|_|_|_|1|_|_|_|_|_|_|_|_| _
;; 293 |_|_|_|_|_|_|_|_|2|_|_|_|_|_|_|_|_| |_|
;; 294 \_|_|3|_|_/ _ _ _ _ _|_|_ _ _ _ _
;; 295 \_|4|_/ <-----------> |_|_|_|_|_|X|_|_|_|_|_|
;;BUTTOM
;; |_|_|_|_|_|_|_|_|_|_|_|
;;
;; (at-bottoms? the-ufo) -> true
;; when the "ufo's bottom" touch the bottom it will consider it is on
;;the bottom
;; at-bottoms? : UFO -> boolean
;; determine if the ufo is at the bottom
(define (at-bottom? a-ufo)
(> (- (posn-y a-ufo) bottom) -5))
;; example (> (- 291 295) -5) -> (> -4 15) -> true (according the graph
;;above)
;; as the-ufo move down the number is going get bigger and different is
;;going to be bigger so i just ">"
;; as the-ufo move down it is going to be below the BUTTOM, but i still
;;going to call it is at the bottom.
;; Examples/texts for at-bottom?
(boolean=? (at-bottom? (make-posn 50 -29)) false)
(boolean=? (at-bottom? (make-posn 50 29)) false)
(boolean=? (at-bottom? (make-posn 75 bottom)) true)
(boolean=? (at-bottom? (make-posn 80 (+ bottom 5))) true)
(boolean=? (at-bottom? (make-posn 25 (- bottom 4))) true)
;;-----------------------------------------------------------------------------
;; draw-scene : loufo AUP loshot loshot number-> boolean
;; draw the ufo, aup and list of shots
(define (draw-scene ufos an-aup shots ufo-shots score lives)
(local ((define draw-ufos (draw-all-ufos ufos))
(define draw-an-aup (draw-aup (make-posn an-aup bottom)))
(define draw-shots (draw-all-shots shots 'red))
(define draw-ufo-shots (draw-all-shots ufo-shots 'blue))
(define space-invaders (draw-solid-string (make-posn 10 20)
"Space Invaders v6.0 "))
(define string-score (draw-solid-string (make-posn (- width 80 )
20) "Score: "))
(define draw-score (draw-solid-string (make-posn (- width 30) 20 )
(number->string score)))
(define (draw-lives lives)
(cond
((<= lives 1) true)
(else (and (draw-aup (make-posn (- width (* 13 lives)) 45))
(draw-lives (- lives 1)))))))
(draw-lives lives)))
;; Exampes/tests for draw-scene is below with clear-scene's Examples/tests
;;(draw-scene loufo0 aup0 loshot0 loshot1)
;;(draw-scene loufo1 aup1 loshot1 loshot2)
;;(draw-scene loufo2 aup1 loshot2 loshot0)
;;-----------------------------------------------------------------------------
;; clear-scene : loufo AUP loshot number-> boolean
;; clear the ufo, aup and list of shots from the gui.
(define (clear-scene ufos an-aup shots ufo-shots score)
(local ((define clear-ufos (clear-all-ufos ufos))
(define clear-an-aup (clear-aup an-aup))
(define clear-shots (clear-all-shots shots 'red))
(define clear-ufo-shots (clear-all-shots ufo-shots 'blue))
(define clear-score (clear-solid-string (make-posn 20 (* 3 score))
"(number->string score)")))
true))
;; Examples/tests for clear-scene and draw-scene
;;(draw-scene loufo0 aup0 loshot0 loshot1) ;;(don't need to test it, if
;;wanted uncommon them)
;;(clear-scene loufo0 aup0 loshot0 loshot1)
;;(draw-scene loufo1 aup1 loshot1 loshot2)
;;(clear-scene loufo1 aup1 loshot1 loshot2)
;;(draw-scene loufo2 aup1 loshot2 loshot0)
;;(clear-scene loufo2 aup1 loshot2 loshot0)
;;-----------------------------------------------------------------------------
;;if height is 300 _ _ _
;; /_|_|_\
;; _ _ _ _ _ _/_|_|_|_|_\_ _ _ _ _ _
;; 292 |_|_|_|_|_|_|_|_|X|_|_|_|_|_|_|_|_| _
;; 293 |_|_|_|_|_|_|_|_|_|_|_|_|_|_|_|_|_| |_|
;; 294 |_|_|_|_|_|_|_|_|_|1|2|3|4|5|6|7|8|_ _ _ _|_|_ _ _ _ _
;; 295 \_|_|_|_|_/ |_|_|_|_|_|x|_|_|_|_|_|
;; \_|_|_/ |_|9|0|1|2|3|_|_|_|_|_|
;;
;; (landed-on-aup? the-aup the-ufo) -> true x-position different
;;is 13
;; _ _ _
;; /_|_|_\
;; _ _ _ _ _ _/_|_|_|_|_\_ _ _ _ _ _
;; 292 |_|_|_|_|_|_|_|_|X|_|_|_|_|_|_|_|_| _
;; 293 |_|_|_|_|_|_|_|_|_|_|_|_|_|_|_|_|1| |_|
;; 294 |_|_|_|_|_|_|_|_|_|_|_|_|_|_|_|_|2|_ _ _ _|_|_ _ _ _ _
;; 295 \_|_|_|_|_/ |3|_|_|_|_|x|_|_|_|_|_|
;; \_|_|_/ |_|_|_|_|_|_|_|_|_|_|_|
;;
;; (landed-on-aup? the-aup the-ufo) -> true y-position different
;;is 3
;; _ _ _
;; /_|_|_\ ufo part
;; _ _ _ _ _ _/_|_|_|_|_\_ _ _ _ _ _ _ _ _ _ _ _ _ _
;; _ _ _ _ _ _ _ _ _
;; 291 |_|_|_|_|_|_|_|_|X|_|_|_|_|_|_|_|_|
;; |_|_|_|_|_|_|_|_|X|_|_|_|_|_|_|_|_|
;; 292 |_|_|_|_|_|_|_|_|1|_|_|_|_|_|_|_|_|
;; |_|_|_|_|_|_|_|_|1|_|_|_|_|_|_|_|_|
;; 293 |_|_|_|_|_|_|_|_|2|_|_|_|_|_|_|_|_|
;; |_|_|_|_|_|_|_|_|2|_|_|_|_|_|_|_|_|_ _ _ _ _ _ _ _
;; 294 \_|_|3|_|_/_ _ _ _ _|_|_ _ _ _ _
;; |_|_|_|_|_|x|_|_|_|_|_|
;; 295 - BOTTOM \_|4|_/ |_|_|_|_|_|x|_|_|_|_|_|
;; |_|_|_|_|_|_|_|_|_|_|_|
;; |_|_|_|_|_|_|_|_|_|_|_|
;; aup part
;;
;; (landed-on-aup? the-aup the-ufo) -> false The ufo
;;landed on aup if these two part of ufo
;; and
;;aup touch or on each other.
;; landed-on-aup? : AUP UFO -> boolean
;; see if the UFO is on top of the AUP
(define (landed-on-aup? an-aup an-ufo)
(local ((define x-different (< (abs (- an-aup (posn-x an-ufo))) 14))
(define y-different (< (abs (- bottom (posn-y an-ufo))) 4)))
(and x-different y-different)))
;; Examples/texts for landed-on-aup?
(boolean=? (landed-on-aup? aup0 (make-posn 50 29)) false)
(boolean=? (landed-on-aup? aup0 (make-posn 43 bottom)) true)
(boolean=? (landed-on-aup? aup0 (make-posn 50 (- bottom 3))) true)
(boolean=? (landed-on-aup? aup0 (make-posn 7 (+ bottom 2))) false)
(boolean=? (landed-on-aup? aup1 (make-posn 50 (+ bottom 5))) false)
(boolean=? (landed-on-aup? aup1 (make-posn 75 (- bottom 4))) false)
;;-----------------------------------------------------------------------------
;; ****** copy from "Extended Exercise: Interactive Games" *****
;;A KeyEvent is either
;;a Boolean, i.e., false, if the user didn't press a
;;key;
;;a Character, e.g., #\a, #\space, if the user pressed an
;;alphanumeric key,
;;a Symbol, e.g., 'up, 'down, 'left, 'right, if the user pressed a
;;special key (or other events happened).
;;*****************************************************************************
;; decode-user-input : keyevent -> symbol
;; take in the key event and change it to symbol
;; if it is false will return 'false
;; if it is a character it will return 'fire
;; if it is symbol it just return itself
(define (decode-user-input a-key-event)
(cond
((boolean? a-key-event) 'none)
((char? a-key-event) 'fire)
((symbol=? a-key-event 'left) 'move-left)
((symbol=? a-key-event 'right) 'move-right)
(else 'none)))
;;Examples/tests for decode-user-input
(equal? (decode-user-input false) 'none)
(equal? (decode-user-input #\a) 'fire)
(equal? (decode-user-input #\space) 'fire)
(equal? (decode-user-input #\g) 'fire)
(equal? (decode-user-input 'up) 'none)
(equal? (decode-user-input 'down) 'none)
(equal? (decode-user-input 'left) 'move-left)
(equal? (decode-user-input 'right) 'move-right)
;;-----------------------------------------------------------------------------
;; X | 0 1 2 3 4 5
;; | _
;; | |_|
;; | _ _ _ _ _|_|_ _ _ _ _
;; ||_|_|_|_|_|x|_|_|_|_|_|
;; ||_|_|_|_|_|_|_|_|_|_|_|
;; |
;; the-aup
;; Assume that aup's position will never be created to be less than 5,
;; **and** x position will never be create to be greater than (- width 6)
;; also when we move the aup it will not fail to follow that too.
;; move-aup : aup symbol -> aup
;; jusing the given symbol determind what to do with the aup
(define (move-aup an-aup user-action)
(cond
((symbol=? user-action 'move-left)
(cond
((< (- an-aup aup-speed) 5) an-aup) ;; <- when the aup is at the
;;end-of-left side, not matter how many times
(else (- an-aup aup-speed)))) ;; player click left it is
;;not going to more left
((symbol=? user-action 'move-right)
(cond
((> (+ an-aup aup-speed) (- width 6)) an-aup) ;; <- when the aup
;;is at the end-of-right side, not matter how many times
(else (+ an-aup aup-speed)))) ;; player click
;;right it is not going to more right
(else an-aup)))
;; Examples/tests for move-aup
(= (move-aup 5 'move-left) 5)
(= (move-aup 5 'move-right) (+ 5 aup-speed))
(= (move-aup 25 'move-left) (- 25 aup-speed))
(= (move-aup 25 'move-right) (+ 25 aup-speed))
(= (move-aup 94 'move-left) (- 94 aup-speed))
(= (move-aup (- width 6) 'move-right) (- width 6))
(= (move-aup 90 'none) 90)
(= (move-aup 90 'fire) 90)
;;-----------------------------------------------------------------------------
;; update-shots : loshot aup symbol -> loshot
;; move all the shot and create new shot acroding user-action and an-aup
(define (update-shots shots an-aup user-action)
(local ((define updated(move-all-shots shots - shot-speed))
(define new_shot(make-shot (make-posn an-aup (- bottom 8))
(make-posn an-aup (- bottom 3))))
(define shot?(symbol=? user-action 'fire)))
(cond
((and shot? (<= (length updated) shot-limit)) (cons new_shot updated))
(else updated))))
;; (define shot1 (make-shot (make-posn 55 285) (make-posn 55 290)))
;; (define shot2 (make-shot (make-posn 55 255) (make-posn 55 260)))
;; (define shot3 (make-shot (make-posn 75 245) (make-posn 75 250)))
;; (define shot4 (make-shot (make-posn 75 225) (make-posn 75 230)))
;; (define shot5 (make-shot (make-posn 70 205) (make-posn 70 210)))
;;
;; (define loshot0 empty)
;; (define loshot1 (cons shot1(cons shot2 empty)))
;; (define loshot2 (cons shot3 (cons shot4 (cons shot5 empty))))
;;(define aup0 50)
;;(define aup1 75)
;;Examples for update-shots
(equal? (update-shots loshot1 aup1 'left)
(cons (make-shot (make-posn 55 (- 285 shot-speed))
(make-posn 55 (- 290 shot-speed)))
(cons (make-shot (make-posn 55 (- 255 shot-speed))
(make-posn 55 (- 260 shot-speed))) empty)))
(equal? (update-shots loshot1 aup1 'right)
(cons (make-shot (make-posn 55 (- 285 shot-speed))
(make-posn 55 (- 290 shot-speed)))
(cons (make-shot (make-posn 55 (- 255 shot-speed))
(make-posn 55 (- 260 shot-speed))) empty)))
(equal? (update-shots loshot1 aup1 'false)
(cons (make-shot (make-posn 55 (- 285 shot-speed))
(make-posn 55 (- 290 shot-speed)))
(cons (make-shot (make-posn 55 (- 255 shot-speed))
(make-posn 55 (- 260 shot-speed))) empty)))
(equal? (update-shots loshot1 aup1 'fire)
(cons (make-shot (make-posn 75 (- bottom 8))
(make-posn 75 (- bottom 3)))
(cons (make-shot (make-posn 55 (- 285 shot-speed))
(make-posn 55 (- 290 shot-speed)))
(cons (make-shot (make-posn 55 (- 255 shot-speed))
(make-posn 55 (- 260 shot-speed)))
empty))))
(equal? (update-shots loshot0 aup1 'left) empty)
(equal? (update-shots loshot0 aup1 'right) empty)
(equal? (update-shots loshot0 aup1 'false) empty)
(equal? (update-shots loshot0 aup1 'fire)
(cons (make-shot (make-posn 75 (- bottom 8))
(make-posn 75 (- bottom 3))) empty))
;;------------------------------------------------------------------------------
;; _ _ _
;; /_|_|_\
;; _ _ _ _ _ _/_|_|_|_|_\_ _ _ _ _ _
;; |_|_|_|_|_|_|_|_|X|_|_|_|_|_|_|_|_|
;; |_|_|_|_|_|_|_|_|_|_|_|_|_|_|_|_|_|
;; |_|_|_|_|_|_|_|_|_|_|_|_|_|_|_|_|_|
;; \_|_|_|_|_/
;; \_|_|_/
;;
;;
;; |
;; |
;; |
;; |
;; |
;; |
;;
;; update-ufo-shots : loshot ufos -> loshot
;; move all the ufo shot down and create new shot accordingly random and
;; position of the ufos
(define (update-ufo-shots ufo-shots ufos)
(local ((define updated(move-all-shots ufo-shots + ufo-shot-speed))
(define (make-new-ufo-shot ufos)
(local ((define ran(random chance-of-fire)))
(cond
((empty? ufos) empty)
((= 0 ran) (cons (make-shot (make-posn (posn-x (first ufos))
(+ (posn-y (first ufos)) 7))
(make-posn (posn-x (first ufos))
(+ (posn-y (first ufos)) 12)))
(make-new-ufo-shot (rest ufos))))
(else (make-new-ufo-shot (rest ufos)))))))
(append updated (make-new-ufo-shot ufos))))
(equal? (update-ufo-shots empty empty) empty)
(equal? (update-ufo-shots loshot1 empty)
(cons (make-shot (make-posn 55 (+ 285 ufo-shot-speed))
(make-posn 55 (+ 290 ufo-shot-speed)))
(cons (make-shot (make-posn 55 (+ 255 ufo-shot-speed))
(make-posn 55 (+ 260 ufo-shot-speed)))
empty)))
(cons? (update-ufo-shots loshot1 loufo1))
;; can't test more that, because when loufo1 is not empty it will randomly
;; create shot,
;; there is no way to make sure how long the list is that function pass back
;;------------------------------------------------------------------------------
;; shots-not-hit-ufo : loufo loshot -> loshot
;; remove shots that shot the ufo, and keep other shot and pass them back as
;; a new list
(define (shots-not-hit-ufo ufos shots)
(filter (lambda (y) (not (ormap (lambda (x) (got-shot? x (shot-top y)))
ufos))) shots))
;; Examples/tests for shots-not-hit-ufo
(equal? (shots-not-hit-ufo empty empty) empty)
(equal? (shots-not-hit-ufo loufo1 empty) empty)
(equal? (shots-not-hit-ufo empty loshot1) loshot1)
(equal? (shots-not-hit-ufo loufo1 loshot1) (list (make-shot (make-posn 55
285) (make-posn 55 290))))
(equal? (shots-not-hit-ufo loufo2 loshot1) loshot1)
;;------------------------------------------------------------------------------
;; If the height is 300
;;
;; 291 4 | ufo-shot
;; 292 3 | _ _
;; 293 2 | |_| |_|
;; 294 1 | _ _ _ _|_|_ _ _ _ _ _ _ _ _ _|_|_ _ _ _ _
;; 295 |||_|_|_|_|x|_|_|_|_|_| |_|_|_|_|_|x|_|_|_|_|_| <------
;;bottom
;; |5|4|3|2|1|_|_|_|_|_|_| |_|_|_|_|_|_|_|_|_|_||| 1
;; aup1 is shot apu2 is shot |
;; |
;; |
;; | ufo-shot
;;
;; 289 ---------------> | ufo-shot
;; 290 |
;; 291 |
;; 292 |
;; 293 |||
;; 294 _ _ _ _ _|_|__ _ _ _
;; 295 |_|_|_|_|_|x|_|_|_|_|_|
;; |_|_|_|_|_|_|_|_|_|_|_|
;; aup is shot when the shot touch this area,
;; if the shot got the rest of aup's area outside this
;; rectange, aup is not shot
;;*************** Because of the ufo shot speed and aup move speed, some
;;shot just jump over the aup, not shoting the aup.************
;; aup-shot? : aup posn -> boolean
;; see if the aup is shot
(define (aup-shot? aup shot)
(local ((define top (and (= aup (posn-x shot)) (or (equal? bottom (+
(posn-y shot) 6)) (equal? bottom (+ (posn-y shot) 5)))))
(define x-different (< (abs (- aup (posn-x shot))) 6))
(define y-different (and (< (- bottom (posn-y shot)) 5)
(> (- bottom (posn-y shot)) -2))))
(or top (and x-different y-different))))
;;Examples/tests for aup-shot?
(equal? (aup-shot? 50 (make-posn 50 bottom)) true)
(equal? (aup-shot? 100 (make-posn 100 bottom)) true)
(equal? (aup-shot? 50 (make-posn 50 (+ bottom 1))) true)
(equal? (aup-shot? 100 (make-posn 100 (+ bottom 2))) false)
(equal? (aup-shot? 50 (make-posn 50 (- bottom 5))) true)
(equal? (aup-shot? 100 (make-posn 100 (- bottom 6))) true)
(equal? (aup-shot? 50 (make-posn 45 (- bottom 4))) true)
(equal? (aup-shot? 100 (make-posn 105 (- bottom 4))) true)
(equal? (aup-shot? 50 (make-posn 100 bottom)) false)
(equal? (aup-shot? 50 (make-posn 100 bottom)) false)
;;------------------------------------------------------------------------------
;; shots-not-hit-aup : aup loshot -> loshot
;; remove shots that shot the aup, and keep other shot and pass them back as
;; new list
(define (shots-not-hit-aup aup shots)
(filter (lambda (x) (not (aup-shot? aup (shot-top x)))) shots))
;; Examples/tests for shots-not-hit-aup
(equal? (shots-not-hit-aup 50 empty) empty)
(equal? (shots-not-hit-aup 50 loshot1) loshot1)
(equal? (shots-not-hit-aup 50 (list (make-shot (make-posn 50 (- bottom 5))
(make-posn 50 (- bottom 1))))) empty)
(equal? (shots-not-hit-aup 50 (list (make-shot (make-posn 45 (- bottom 3))
(make-posn 45 (+ bottom 1))))) empty)
;;------------------------------------------------------------------------------
;; aup-down? : aup loufo loshot -> boolean
;; see if aup is shot or if aup is crash by ufo
(define (aup-down? aup ufos ufo-shots)
(or (ormap (lambda (x) (landed-on-aup? aup x)) ufos)
(ormap (lambda (x) (aup-shot? aup (shot-top x))) ufo-shots)))
;;how-many-ufos :UFO -> Number
;;count the number of ufos in the list
(define (how-many-ufos losufo)
(cond
((empty? losufo) 0)
((cons? losufo) (+ 1 (how-many-ufos (rest losufo))))))
(equal? (how-many-ufos loufo1) 2)
(equal? (how-many-ufos loufo2) 2)
(equal? (how-many-ufos loufo0) 0)
;;-----------------------------------------------------------------------------
(define-struct lifescore(life score))
;;a life-score is (make-lifescore Number Number)
;;Data Example
(define lifescore1 (make-lifescore 2 100))
(define lifescore2 (make-lifescore 1 50))
(define lifescore3 (make-lifescore 3 300))
;;------------------------------------------------------------------------------
;; fly-until-down : UFO AUP loshot loshot number number -> lifescore
;; flies the UFO until it hits bottom or is shot
;; returns true if the UFO lands on the AUP or is shot
(define (fly-until-down ufos an-aup shots ufo-shots score lives)
(cond
[(empty? ufos)
(local ((define a (draw-scene ufos an-aup shots ufo-shots score
lives)))
(make-lifescore lives score) )]
[(and (aup-down? an-aup ufos ufo-shots) (= lives 0))
(local ((define a (draw-scene ufos an-aup shots ufo-shots score lives))
(define b (draw-solid-string (make-posn (- (/ width 2) 40) (/
height 2)) "Game Over")))
(make-lifescore lives score) )]
[else
(local ((define a (draw-scene ufos an-aup shots ufo-shots score lives))
(define b (sleep-for-a-while .05))
(define c (clear-all))
(define user-action (decode-user-input (get-key-event)))
(define (remove-shot-ufos list-ufos list-shots)
(filter (lambda (x) (not (hit-by-shots? list-shots x)))
list-ufos))
(define new-ufos (move-all-ufos (filter (lambda (x) (not
(landed-on-aup? an-aup x)))
(remove-shot-ufos ufos
shots))))
(define (update-score ufos shots an-aup score)
( + score (* 5 (- (how-many-ufos ufos) (how-many-ufos (filter
(lambda (x) (not (landed-on-aup? an-aup x)))
(remove-shot-ufos ufos
shots))))))))
(cond
[(aup-down? an-aup ufos ufo-shots) (fly-until-down
new-ufos
(move-aup an-aup user-action)
(update-shots
(shots-not-hit-ufo ufos shots) an-aup user-action)
(update-ufo-shots
(shots-not-hit-aup an-aup ufo-shots) ufos)
(update-score ufos shots an-aup
score)
(- lives 1))]
[else (fly-until-down
new-ufos
(move-aup an-aup user-action)
(update-shots (shots-not-hit-ufo ufos shots) an-aup
user-action)
(update-ufo-shots ufo-shots ufos)
(update-score ufos shots an-aup score)
lives)]))]))
;;Examples
;;we can't do example due to the fact that it is based on user input
;;------------------------------------------------------------------------------
;; main: Number-> String
;; plays the space invaders game with 3 different levels
(define (main lives)
(local ((define show-level1 (draw-solid-string (make-posn (- (/ width 2)
40) (/ height 2)) "Level 1"))
(define space-invaders (draw-solid-string (make-posn 10 20)
"Space Invaders v6.0 "))
(define string-score (draw-solid-string (make-posn (- width 80 )
20) "Score: "))
(define draw-score (draw-solid-string (make-posn (- width 30) 20 )
(number->string 0)))
(define b (sleep-for-a-while 2))
(define c (clear-all))
(define level1 (fly-until-down ufos-level1 start-aup empty empty 0
lives)))
(cond
((= (lifescore-life level1) 0) "Game Over")
(else
(local ((define a (clear-all))
(define show-level2 (draw-solid-string (make-posn (- (/ width
2) 40) (/ height 2)) "Level 2"))
(define space-invaders (draw-solid-string (make-posn 10 20)
"Space Invaders v6.0 "))
(define string-score (draw-solid-string (make-posn (- width
80 ) 20) "Score: "))
(define draw-score (draw-solid-string (make-posn (- width 30)
20 ) (number->string (lifescore-score level1))))
(define b (sleep-for-a-while 2))
(define c (clear-all))
(define level2 (fly-until-down ufos-level2 start-aup empty
empty (lifescore-score level1) (lifescore-life level1))))
(cond
((= (lifescore-life level2) 0) "Game Over")
(else
(local ((define a (clear-all))
(define show-level3 (draw-solid-string (make-posn (- (/
width 2) 40) (/ height 2)) "Level 3"))
(define space-invaders (draw-solid-string (make-posn 10
20) "Space Invaders v6.0 "))
(define string-score (draw-solid-string (make-posn (-
width 80 ) 20) "Score: "))
(define draw-score (draw-solid-string (make-posn (-
width 30) 20 ) (number->string (lifescore-score level2))))
(define b (sleep-for-a-while 2))
(define c (clear-all))
(define level3 (fly-until-down ufos-level3 start-aup
empty empty (lifescore-score level2) (lifescore-life level2))))
(cond
((= (lifescore-life level3) 0) "Game Over")
(else
(local ((define youwin (draw-solid-string (make-posn (- (/
width 2) 40) (/ height 2)) "You Win!!!")))
"You Win!!!")))))))))))
;;Examples/Test Run
(main aup-lives)
