;; The first three lines of this file were inserted by DrRacket. They record metadata ;; about the language level of this file in a form that our tools can easily process. #reader(lib "htdp-advanced-reader.ss" "lang")((modname |problem set 10 working final-1|) (read-case-sensitive #t) (teachpacks ((lib "draw.ss" "teachpack" "htdp") (lib "gui.ss" "teachpack" "htdp"))) (htdp-settings #(#t constructor repeating-decimal #t #t none #f ((lib "draw.ss" "teachpack" "htdp") (lib "gui.ss" "teachpack" "htdp"))))) ;; Reid Ronnander ;; B.J Pennington ;; Jean Cochran ;; Ehren Wessel ;; CSci 1301 ;; Problem set 10 ; ============== These are the two predefined functions ==================== ;; You don't need to understand their code, only the contract and the purpose ;; =========================================================================== ;; ===================== You may skip to the sample code below ================ ;; get-choice: string, list of strings -> integer ;; the function displays a simple menu form with the given message ;; and a drop-down menu with the list of choices. The menu ;; initially displays "Make a choice". Once a different item is chosen, ;; that item is returned. ;; When a "Close" button is pressed, the form disappears. (define (get-choice message list-of-choices) (local ( (define the-choices (make-choice (cons "Make a choice" list-of-choices))) (define w (create-window (list (list (make-message message)) (list the-choices) (list (make-button "Close" (lambda (e) (hide-window w))))))) (define (process-result n) (cond [(> n 200) (hide-window w)] ;; timeout after 200 sec [(= (choice-index the-choices) 0) (and (sleep-for-a-while 1) (process-result (+ n 1)))] [else true]) ) ) (cond [(process-result 0) (list-ref list-of-choices (- (choice-index the-choices) 1))]))) ;; get-answer: string number -> string ;; The function displays a simple text input with a question ;; and returns the answer typed in by the user ;; The second parameter (time-delay) is the number of seconds ;; the function waits after the typing of the first character ;; before it returns the answer. If the user takes longer ;; than that, a partial answer may be returned ;; 5 sec delay is reasonable for a one-word answer (define (get-answer question time-delay) (local ((define the-answer (make-text question)) (define w (create-window (list (list the-answer) (list (make-button "Close" (lambda (e) (hide-window w))))))) (define (process-result n) (cond [(> n 200) (hide-window w)] ;; timeout after 200 sec [(string=? (text-contents the-answer) "") (and (sleep-for-a-while 1) (process-result (+ n 1)))] [else true] ;; the user starts typing ))) (cond [(process-result 0) (cond [(sleep-for-a-while time-delay) (text-contents the-answer)]) ]) )) ;; =========================== do not change anything above this line ============= ;; NOTE: The language is Advanced Student. Teachpacks: gui.ss, draw.ss ;; =========================== Your work goes here: =============================== ;; clear-screen: input -> true ;; purpose: clears the canvas of all drawings and returns true (as opposed to void) given a dummy parameter (define (clear-screen a) (begin (clear-all) true)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Defined Pictures ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; useful drawing functions ;; The structure represents a circle ;; The structure represents a circle ;; center is the position (posn structure) of the center ;; radius is its radius (a non-negative number), and ;; color is a symbol representing a color (define-struct circle (center radius color)) ;; draw-a-circle: circle -> true ;; the function draws a circle structure as a disk ;; and returns true (define (draw-a-circle a-circle) (draw-solid-disk (circle-center a-circle) (circle-radius a-circle) (circle-color a-circle)) ) ;; clear-a-circle: circle -> true ;; the function clears a disk corresponding to a circle ;; and returns true (define (clear-a-circle a-circle) (clear-solid-disk (circle-center a-circle) (circle-radius a-circle)) ) ;; draw-and-clear-circle: circle -> true ;; given a circle, draw and clear it with a pause in-between (define (draw-and-clear-circle a-circle) (and (draw-a-circle a-circle) (sleep-for-a-while .1) (clear-a-circle a-circle))) ;; grow-circle: circle integer -> circle ;; given a circle, create a new circle with the radius increased by the given number (define (grow-circle a-circle r-change) (make-circle (make-posn (posn-x (circle-center a-circle)) (posn-y (circle-center a-circle))) (+ r-change (circle-radius a-circle)) (circle-color a-circle))) ;; animate-circle: circle integer integer -> true ;; make a circle grow by a given number of pixels in the radius a given number of times (define (animate-circle a-circle r-change repeat) (map draw-and-clear-circle (build-list repeat (lambda (n) (grow-circle a-circle (* r-change n)))))) ;; Level 1 Drawings ;; wizard: input -> true ;; purpose: to draw the set of drawings that make up the wizard given a dummy parameter (define (wizard a) ;; a is a free variable (and ;cape (draw-solid-rect (make-posn 93 200) 15 10 'red) (draw-solid-rect (make-posn 90 205) 20 15 'red) (draw-solid-rect (make-posn 87 210) 25 20 'red) (draw-solid-rect (make-posn 84 215) 30 25 'red) (draw-solid-rect (make-posn 81 220) 35 30 'red) (draw-solid-rect (make-posn 78 225) 40 35 'red) (draw-solid-rect (make-posn 75 230) 45 40 'red) (draw-solid-rect (make-posn 72 235) 50 45 'red) (draw-solid-rect (make-posn 69 240) 55 50 'red) (draw-solid-rect (make-posn 66 245) 60 55 'red) (draw-solid-rect (make-posn 63 250) 65 60 'red) (draw-solid-rect (make-posn 60 255) 70 65 'red) ; body (draw-solid-line (make-posn 100 200) (make-posn 100 300) 'black) (draw-solid-line (make-posn 100 235) (make-posn 65 260)) (draw-solid-line (make-posn 65 325) (make-posn 100 300)) (draw-solid-line (make-posn 135 325) (make-posn 100 300)) (draw-solid-line (make-posn 100 235) (make-posn 135 210) 'black) (draw-circle (make-posn 100 150) 50 'black) (draw-solid-disk (make-posn 80 130) 10 'gray) (draw-solid-disk (make-posn 120 130) 10 'gray) (draw-solid-line (make-posn 80 175) (make-posn 105 175) 'black) ; hat (draw-solid-line (make-posn 130 105) (make-posn 100 40) 'blue) (draw-solid-line (make-posn 100 40) (make-posn 70 105) 'blue) (draw-solid-line (make-posn 130 105) (make-posn 70 105) 'blue) ) ) ;; Level 2 Drawings ;; Frog Drawings (define-struct body (disk1 disk2 disk3)) ;; where disk1, disk2, and disk3 are all solid-disks (define-struct eye (disk1)) ;; where disk1 is a solid-disk (define-struct tongue (rectangle)) ;; where rectangle is a solid-rect (define-struct frog (body eye tongue)) ;; where body is a body-struct, eye is an eye-struct, and tongue is a tongue-struct ;; frog2: input -> true ;; purpose: to draw the set of drawings that represent a frog given a dummy parameter (define (frog2 a) (and (draw-solid-disk (make-posn 100 100) 30 'green) (draw-solid-disk (make-posn 125 105) 15 'green) (draw-solid-disk (make-posn 100 150) 40 'green)(draw-solid-disk (make-posn 105 85) 5 'black) (draw-solid-rect (make-posn 140 108) 10 5 'red))) ;; Fish Drawings (define-struct tail (line1 line2 line3)) ;; where line1 line2 and line3 are solid-lines (define-struct body1 (disk1 circle1)) ;; where disk1 is a solid-disk and circle1 is a circle-struct (define-struct fish (tail body)) ;; fish1: input -> true ;; purpose: to draw the set of drawings that represent a fish given a dummy parameter (define (fish1 z) (and (draw-circle (make-posn 200 200) 50 'magenta) (and (draw-solid-line (make-posn 250 200) (make-posn 300 150) 'purple) (draw-solid-line (make-posn 300 150) (make-posn 300 250) 'orange) (draw-solid-line (make-posn 300 250) (make-posn 250 200) 'blue) (draw-solid-disk (make-posn 185 175) 10 'blue) (draw-solid-line (make-posn 155 220) (make-posn 175 220) 'black) (draw-solid-line (make-posn 175 220) (make-posn 185 210) 'black)))) ;; Sun Drawings (define-struct sun-base (disk1)) ;; where disk1 is a solid-disk (define-struct sun-rays (line1 line2 line3 line4 line5 line6 line7 line8 line9 line10 line11 line12)) ;; where line1, line2, line3, line4, line5, line6, line7, line8, line9, line10, line11, and line12 are all solid-lines (define-struct sun (sun-base sun-rays)) ;; where sun-base is a sun-base-struct and sun-rays is a sun-rays-struct ;; sun1: input -> true ;; purpose: to draw the set of drawings that represent a sun given a dummy parameter (define (sun1 c) (and (draw-solid-disk (make-posn 150 150) 50 'yellow) (and (draw-solid-line (make-posn 220 150) (make-posn 250 150) 'orange) (draw-solid-line (make-posn 150 80) (make-posn 150 50) 'orange) (draw-solid-line (make-posn 80 150) (make-posn 50 150) 'orange) (draw-solid-line (make-posn 150 220) (make-posn 150 250) 'orange) (draw-solid-line (make-posn 210 120) (make-posn 250 90) 'orange) (draw-solid-line (make-posn 180 100) (make-posn 220 70) 'orange) (draw-solid-line (make-posn 120 100) (make-posn 80 70) 'orange) (draw-solid-line (make-posn 90 120) (make-posn 60 110) 'orange) (draw-solid-line (make-posn 70 230) (make-posn 100 210) 'orange) (draw-solid-line (make-posn 60 190) (make-posn 90 180) 'orange) (draw-solid-line (make-posn 200 220) (make-posn 210 250) 'orange) (draw-solid-line (make-posn 220 180) (make-posn 250 200) 'orange)))) ;; final level drawings ;; blackhole1: number number number symbol -> true ;; purpose: draws a solid disk from a set of parameters that describe the center, radius, and color of the disk (define (blackhole1 x y r symbol) (draw-solid-disk (make-posn x y) r symbol)) ;; blackhole1st: input -> true ;; draws a solid-disk given a dummy parameter (define (blackhole1st a) (blackhole1 200 200 20 'black)) ;; blackhole2nd: input -> true ;; draws a solid-disk given a dummy parameter (define (blackhole2nd a) (blackhole1 200 200 40 'black)) ;; blackhole3rd: input -> true ;; draws a solid-disk given a dummy parameter (define (blackhole3rd a) (blackhole1 200 200 60 'black)) ;; blackhole4th: input -> true ;; draws a solid-disk given a dummy parameter (define (blackhole4th a) (blackhole1 200 200 80 'black)) ;; blackhole5th: input -> true ;; draws a solid-disk given a dummy parameter (define (blackhole5th a) (blackhole1 200 200 100 'black)) ;; "game over" drawings (define-struct blackhole (center radius color)) ;; where center is a posn structure ;; radius is a positive integer ;; and color is a symbol (define black-hole (make-circle (make-posn 200 200) 20 'black)) ;; lose-screen: input -> true ;; purpose: given a dummy parameter, create the drawings for the canvas when the player has lost (define (lose-screen a) ;; a is a free variable (begin (clear-all) (draw-solid-string (make-posn 20 180) "Your answer is incorrect.") (draw-solid-string (make-posn 20 200) "You have failed.") (draw-solid-string (make-posn 20 220) "A black hole has consumed the world.") (sleep-for-a-while 4) (clear-all) (draw-a-circle black-hole) (animate-circle black-hole 3 90) (draw-solid-string (make-posn 150 200) "Game Over") )) (define-struct basic-line (start end color)) ;; where start and end are posns and color is a symbol (define colors (list 'red 'orange 'green 'yellow 'blue 'purple)) ;; random-circle: list-of-symbols -> circle-struct ;; purpose: create a circle-struct with random center and radius and color given a list of colors (define (random-circle color-list) (make-circle (make-posn (+ (random 300) 1) (+ (random 300) 1)) (+ (random 25) 1) (list-ref color-list (random 6)))) (define (random-line a-circle n m v w) (local ((define posn-start (make-posn (+ (posn-x (circle-center a-circle)) n) (+ (posn-y (circle-center a-circle)) m)))) (make-basic-line posn-start (make-posn (+ (posn-x posn-start) v) (+ (posn-y posn-start) w)) (circle-color a-circle)))) (define (random-firework color-list n) (local ((define main-circle (random-circle color-list))) (list main-circle (random-line main-circle 0 (+ (circle-radius main-circle) 10) 0 (random 101)) (random-line main-circle 0 (- (+ (circle-radius main-circle) 10)) 0 (- (random 101))) (random-line main-circle (+ (circle-radius main-circle) 10) 0 (random 101) 0) (random-line main-circle (- (+ (circle-radius main-circle) 10)) 0 (- (random 101)) 0) (random-line main-circle (+ (circle-radius main-circle) 10) (+ (circle-radius main-circle) 10) (random 101) (random 101)) (random-line main-circle (+ (circle-radius main-circle) 10) (- (+ (circle-radius main-circle) 10)) (random 101) (- (random 101))) (random-line main-circle (- (+ (circle-radius main-circle) 10)) (+ (circle-radius main-circle) 10) (- (random 101)) (random 101)) (random-line main-circle (- (+ (circle-radius main-circle) 10)) (- (+ (circle-radius main-circle) 10)) (- (random 101)) (- (random 101))) ))) (define (draw-losh list-of-shapes) (cond [(empty? list-of-shapes) true] [(circle? (first list-of-shapes)) (and (draw-solid-disk (circle-center (first list-of-shapes)) (circle-radius (first list-of-shapes)) (circle-color (first list-of-shapes))) (draw-losh (rest list-of-shapes)))] [(basic-line? (first list-of-shapes)) (and (draw-solid-line (make-posn (posn-x (basic-line-start (first list-of-shapes))) (posn-y (basic-line-start (first list-of-shapes)))) (make-posn (posn-x (basic-line-end (first list-of-shapes))) (posn-y (basic-line-end (first list-of-shapes)))) (basic-line-color (first list-of-shapes))) (draw-losh (rest list-of-shapes)))] ) ) (define (draw-losh-of-losh list-of-lists) (cond [(empty? list-of-lists) true] [else (and (draw-losh (first list-of-lists)) (draw-losh-of-losh (rest list-of-lists)))] )) (define (win-screen x) (begin (draw-losh-of-losh (build-list 5 (lambda (n) (random-firework colors n)))) (sleep-for-a-while 1) (clear-all) (draw-losh-of-losh (build-list 5 (lambda (n) (random-firework colors n)))) (sleep-for-a-while 1) (clear-all) (draw-losh-of-losh (build-list 5 (lambda (n) (random-firework colors n)))) (sleep-for-a-while 1) (clear-all) (draw-solid-string (make-posn 180 190) "You Win!") )) ;;;; Riddels ;;;; ;; all riddles taken from this site ;; www.rinkworks.com/brainfood/p/riddles1.shtml ;; a riddle is a structure with the following fields: ;; q : represents the question (a string) ;; at : represents the correct answer to the question (a string) ;; choices : represents the list of choices (a list of strings) ;; F : represents a draw-function -> true; or just true (define-struct riddle (q at choices F)) ;; the list of riddles: ; Level 1 (define r1 (make-riddle "What gets wetter and wetter the more it dries?" "towel" (list "cloud" "towel" "blow dryer") wizard)) (define r2 (make-riddle "What goes up and down stairs without moving?" "rug" (list "person" "time" "rug") wizard)) (define r3 (make-riddle "What can you catch but not throw?" "a cold" (list "a cold" "football" "a party") wizard)) ; Level 2-1 (define r4 (make-riddle "No sooner spoken than broken. What is it?" "silence" (list "promise" "silence" "glass") frog2)) (define r5 (make-riddle "All about, but cannot be seen, can be captured, cannot be held, no throat, but can be heard. What is it?" "wind" (list "wind" "voice" "fog") frog2)) (define r6 (make-riddle "What kind of coat can only be put on when wet?" "coat of paint" (list "raincoat" "coat of arms" "coat of paint") frog2)) ; Level 2-2 (define r7 (make-riddle "Until I am measured, I am not known. Yet how you miss me, when I have flown! What am I?" "time" (list "money" "weight" "time") fish1)) (define r8 (make-riddle "I am weightless, but you can see me. Put me in a bucket, and I'll make it lighter. What am I?" "hole" (list "air" "hole" "water") fish1)) (define r9 (make-riddle "I am light as a feather, yet the strongest man can't hold me for much more than a minute. What am I?" "breath" (list "bird" "truth" "breath") fish1)) ; Level 2-3 (define r10 (make-riddle "I'm the part of the bird that's not in the sky. I can swim in the ocean and yet remain dry. What am I?" "shadow" (list "feathers" "penguin" "shadow") sun1)) (define r11 (make-riddle "I can be cracked, I can be made. I can be told, I can be played. What am I?" "joke" (list "joke" "riddle" "egg") sun1)) (define r12 (make-riddle "When I am filled I can point the way, when I am empty, nothing moves me. I have two skins, one without and one within. What am I?" "glove" (list "compass" "snake" "glove") sun1)) ; Final Level (Level 3) (define r13 (make-riddle "You can have me but cannot hold me, gain me and quickly lose me. If treated with care I can be great, and if betrayed I will break. What am I?" "trust" (list "friendship" "trust" "love") blackhole1st)) (define r14 (make-riddle "At night they come without being fetched, and by day they are lost without being stolen. What are they?" "stars" (list "children" "hours" "stars") blackhole2nd)) (define r15 (make-riddle "I run over fields and woods all day. Under the bed at night I sit not alone. My tongue hangs out, up and to the rear, awaiting to be filled in the morning. What am I?" "shoe" (list "shoe" "dog" "wind") blackhole3rd)) (define r16 (make-riddle "The man who invented it doesn't want it. The man who bought it doesn't need it. The man who needs it doesn't know it." "coffin" (list "breath mint" "coffin" "coffee") blackhole4th)) (define r17 (make-riddle "What stinks when living and smells good when dead?" "bacon" (list "person" "nothing" "bacon") blackhole5th)) ;;;; define the main tally in the game ;;;; ;; the "oversoul" is a structure that represents the riddle number and points which will be determined later on. ;; define main structure: ;; structure "oversoul" contains the following fields: ;; riddle-number : a number that represents what riddle the player is on ;; point-counter : a number representing what riddle will be asked during the final boss (define-struct oversoul (riddle-number point-counter)) ;;;; this needs to change sometime soon: ;; the following is the current starting oversoul (define main-oversoul (make-oversoul 0 0)) ;;;; welcome ;;;; (define (welcome name) (begin (start 400 400) (draw-solid-string (make-posn 20 20) (string-append "Welcome " name) ) (draw-solid-string (make-posn 20 50) "Welcome to a game of riddles.") (draw-solid-string (make-posn 20 80) "Good luck") (sleep-for-a-while 3.5) (set-oversoul-riddle-number! main-oversoul (+ (oversoul-riddle-number main-oversoul) 1)) (Playing (oversoul-riddle-number main-oversoul) 1) ) ) ;;;; define the main round ;;;; ;; helper function: ;; contract : ask-question2 : structure -> boolean (define (ask-question2 riddle) (string=? (riddle-at riddle) (get-choice (riddle-q riddle) (riddle-choices riddle)) ) ) (define (die? riddle-number) (cond [(= (remainder riddle-number 3) 1) (lose-screen 1)] [else (begin (set-oversoul-riddle-number! main-oversoul (cond [(= (remainder riddle-number 3) 2) (+ 2 (oversoul-riddle-number main-oversoul))] [else (+ 1 (oversoul-riddle-number main-oversoul))])) (Playing (oversoul-riddle-number main-oversoul) (oversoul-point-counter main-oversoul)))] )) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; function for incorrect answer: ;; contract : incorrect : -> true (a drawn picture) ;; contract : Ask : riddle -> another function call ;; purpose: to ask a riddle, gain an answer, and then move on to the next round of questions, (define (point-tracker riddle-number) (cond [(= (remainder riddle-number 3) 1) (void)] [else (set-oversoul-point-counter! main-oversoul (+ (oversoul-point-counter main-oversoul) 1))] )) (define (Ask riddle) (cond [(and (clear-screen 1) ((riddle-F riddle) 1);; this will be replaced with a draw-function. (riddle-F riddle) (ask-question2 riddle)) (begin (point-tracker (oversoul-riddle-number main-oversoul)) (set-oversoul-riddle-number! main-oversoul (+ (oversoul-riddle-number main-oversoul) 1)) ;; (set-oversoul-riddle- ;; change the number of points for final boss (modulus stuff) (Playing (oversoul-riddle-number main-oversoul) 1))] ;; the restult of a correct answer [else ;; the result due to an incorrect answer- a black hole eats the world (die? (oversoul-riddle-number main-oversoul))] ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;; ;; following to be run when points begin to count ;;;; Ask1 ;;;; same as ask but returns a different function ;; which is the same as Ask, excpet it calls through playing-final (define (Ask1 riddle) (cond [(and (clear-screen 1) ((riddle-F riddle) 1) ;; this will be replaced with a draw-function. (riddle-F riddle) (ask-question2 riddle)) (begin (set-oversoul-riddle-number! main-oversoul (+ (oversoul-riddle-number main-oversoul) 1)) ;; (set-oversoul-riddle- ;; change the number of points for final boss (modulus stuff) (playing-final (oversoul-riddle-number main-oversoul)))] ;; the restult of a correct answer [else ;; the result due to an incorrect answer- a black hole eats the world (begin (clear-all) (lose-screen 1) )] ) ) ;; playing through the final boss: ;; basically you start at some riddle and go through however many questions you have to ;; contract : playing-final : riddle-number -> stuff (define (playing-final riddle-number) (cond [(= riddle-number 13) (Ask1 r13)] [(= riddle-number 14) (Ask1 r14)] [(= riddle-number 15) (Ask1 r15)] [(= riddle-number 16) (Ask1 r16)] [(= riddle-number 17) (Ask1 r17)] [else (and (clear-screen 1) (win-screen 1))] ) ) ;; take the points -> what riddle will be asked. ;; 1st, draw the black hole (great, well, because of how this all works it is going to be placed somewhere were it will just run... grr! (define (final-boss points) (begin (cond [(<= points 2) (set-oversoul-riddle-number! main-oversoul 13)] [(<= points 4) (set-oversoul-riddle-number! main-oversoul 15)] [else (set-oversoul-riddle-number! main-oversoul 17)] ) (playing-final (oversoul-riddle-number main-oversoul)) ) ) ;;;; define the whole mainphase ;;;; ;; contract : Playing : number, number -> function call -> true ;; purpose: to "play" the game and select the different levels. (define (Playing counter points) (cond [(= counter 0) (welcome (get-answer "Name " 3))] [(= counter 1) (Ask r1)] [(= counter 2) (Ask r2)] [(= counter 3) (Ask r3)] [(= counter 4) (Ask r4)] [(= counter 5) (Ask r5)] [(= counter 6) (Ask r6)] [(= counter 7) (Ask r7)] [(= counter 8) (Ask r8)] [(= counter 9) (Ask r9)] [(= counter 10) (Ask r10)] [(= counter 11) (Ask r11)] [(= counter 12) (Ask r12)] [(= counter 13) (final-boss (oversoul-point-counter main-oversoul))] ) ) ;; testing with just the riddles: (Playing 0 0)