Created
December 6, 2013 22:04
-
-
Save jbclements/7832875 to your computer and use it in GitHub Desktop.
fixed performance problems with spaceman spiff
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#| | |
_ | |
_____ _____ _ ___ ___ | | | |
| __| ___ ___ ___ ___ _____ ___ ___ | __| ___ |_|| _|| _||_| ___ | |
|__ || . || .'|| _|| -_|| || .'|| | |__ || . || || _|| _| |_ -| | |
|_____|| _||__,||___||___||_|_|_||__,||_|_| |_____|| _||_||_| |_| |___| | |
|_| |_| | |
_____ _ _ _____ _ | |
| __||_| ___ ___ | | | __| _ _ _____ ___ | |_ ___ ___ _ _ | |
| __|| || || .'|| | |__ || | || || . || || . || || | | | |
|__| |_||_|_||__,||_| |_____||_ ||_|_|_|| _||_|_||___||_|_||_ | | |
|___| |_| |___| | |
|# | |
;(require midi-readwrite) | |
(require rsound) | |
(require rsound/piano-tones) | |
(require 2htdp/universe) | |
(require 2htdp/image) | |
(require 2htdp/batch-io) | |
(require racket/list) | |
;; variables, images, pstreams | |
(define WIDTH 400) | |
(define HEIGHT 500) | |
(define NOTE-STOP 1000) | |
(define Y-SCALAR (/ 1 50)) | |
(define Y-ADJUSTMENT 5) | |
(define BG (bitmap "bg.png")) | |
(define SPIFF (bitmap "spiff.png")) | |
(define NOTE (bitmap "note.png")) | |
(define KANYE (bitmap "kanye.png")) | |
(define INTRO (rs-read "intro.wav")) | |
(define ps (make-pstream)) | |
(define ps2 (make-pstream)) | |
;; string, size, color -> text | |
;; makes text (this helper function makes it easier to change all fonts) | |
(define (make-text t s c) | |
(text/font t s c "Vermin Vibes 1989" 'system 'normal 'normal #f)) | |
;; evaluates 2 things | |
(define (both a b) b) | |
;; shapes, text | |
(define BAR (rectangle 300 2 "solid" "ghostwhite")) | |
(define BUTTON (overlay (rectangle 260 40 "outline" "ghostwhite") (rectangle 260 40 "solid" "black"))) | |
(define SCOREBOARD (overlay (rectangle 260 200 "outline" "ghostwhite") (rectangle 260 200 "solid" "black"))) | |
(define TITLE1 (make-text "SPACEMAN SPIFF'S" 32 "ghostwhite")) | |
(define TITLE2 (make-text "SPACEMAN SPIFF'S" 32 "maroon")) | |
(define TITLE3 (make-text "FINAL SYMPHONY" 32 "ghostwhite")) | |
(define TITLE4 (make-text "FINAL SYMPHONY" 32 "maroon")) | |
(define PLAY-TEXT (make-text "PLAY" 16 "ghostwhite")) | |
(define BACK-TEXT (make-text "BACK TO MENU" 16 "ghostwhite")) | |
(define GAME-OVER-TEXT (make-text "GAME OVER" 32 "ghostwhite")) | |
(define HI-SCORES-TEXT-S (make-text "HI-SCORES" 16 "ghostwhite")) | |
(define HI-SCORES-TEXT-L1 (make-text "HI-SCORES" 32 "ghostwhite")) | |
(define HI-SCORES-TEXT-L2 (make-text "HI-SCORES" 32 "maroon")) | |
(define HI-SCORES-LIST (read-file "hiscores.txt")) | |
(define EXTRAS-TEXT (make-text "EXTRAS" 16 "ghostwhite")) | |
(define CREDITS1 (make-text "Coded by" 32 "ghostwhite")) | |
(define CREDITS2 (make-text "Team Yeezus" 32 "ghostwhite")) | |
;; a note is (make-note note-num frames frames) | |
(define-struct note (pitch time duration)) | |
;; a note-block is one of (make-note-block rsound x-pos y-pos boolean) | |
(define-struct note-block (sound x-pos y-pos boolean)) | |
;; a world is (make-world (list number posn list-of-note-blocks number pstream number number number)) | |
;(define-struct world (screen spiff notes time pstream delta-y lives score)) | |
(define-struct world (loc)) | |
;; world, nth item, new value -> world | |
;; updates the world | |
(define (update-world w n new-val) | |
(make-world (append (take (world-loc w) n) | |
(list new-val) | |
(drop (world-loc w) (add1 n))))) | |
(check-expect (update-world (make-world (list 10 9 8 7 6 5 4 3 2 1 0 -1 -2 -3 -4 -5)) 3 999) | |
(make-world (list 10 9 8 999 6 5 4 3 2 1 0 -1 -2 -3 -4 -5))) | |
;; get the 'n'th component of a world | |
;; world number -> any | |
(define (get-component w n) | |
(list-ref (world-loc w) n)) | |
(check-expect (get-component (make-world (list 10 9 8 7 6 5 4 3 2 1 0 -1 -2 -3 -4 -5)) 3) | |
7) | |
;; list-of-strings -> list-of-numbers | |
;; get the scores | |
#|(define (get-scores l) | |
(cond [(empty? l) empty] | |
[else (cons (string->number (first l)) | |
(get-scores (rest l)))])) | |
(check-expect (get-scores HI-SCORES-LIST) "0")|# | |
;; seconds -> frames | |
(define (s seconds) | |
(* 44100 seconds)) | |
;; number -> number | |
;; oscillates based on time | |
(define (oscillate x w) | |
(+ (* (sin (/ (* 2 pi (get-component w 4)) 40)) x) 200)) | |
(define bach-notes | |
(list | |
(make-note 60 8820 8820) | |
(make-note 62 17640 8820) | |
(make-note 64 26460 8820) | |
(make-note 65 35280 8820) | |
(make-note 62 44100 8820) | |
(make-note 64 52920 8820) | |
(make-note 60 61740 8820) | |
(make-note 67 70560 17640) | |
(make-note 48 79380 8820) | |
(make-note 72 88200 17640) | |
(make-note 50 88200 8820) | |
(make-note 52 97020 8820) | |
(make-note 72 105840 2940) | |
(make-note 53 105840 8820) | |
(make-note 71 108780 2940) | |
(make-note 72 111720 2940) | |
(make-note 71 114660 8820) | |
(make-note 50 114660 8820) | |
(make-note 72 123480 17640) | |
(make-note 52 123480 8820) | |
(make-note 48 132300 8820) | |
(make-note 74 141120 8820) | |
(make-note 55 141120 17640) | |
(make-note 67 149940 8820) | |
(make-note 69 158760 8820) | |
(make-note 43 158760 17640) | |
(make-note 71 167580 8820) | |
(make-note 72 176400 8820) | |
(make-note 69 185220 8820) | |
(make-note 71 194040 8820) | |
(make-note 67 202860 8820) | |
(make-note 74 211680 17640) | |
(make-note 55 220500 8820) | |
(make-note 79 229320 17640) | |
(make-note 57 229320 8820) | |
(make-note 59 238140 8820) | |
(make-note 79 246960 2940) | |
(make-note 60 246960 8820) | |
(make-note 77 249900 2940) | |
(make-note 79 252840 2940) | |
(make-note 77 255780 8820) | |
(make-note 57 255780 8820) | |
(make-note 79 264600 17640) | |
(make-note 59 264600 8820) | |
(make-note 55 273420 8820) | |
(make-note 76 282240 8820) | |
(make-note 60 282240 17640) | |
(make-note 81 291060 8820) | |
(make-note 79 299880 8820) | |
(make-note 59 299880 17640) | |
(make-note 77 308700 8820) | |
(make-note 76 317520 8820) | |
(make-note 60 317520 17640) | |
(make-note 79 326340 8820) | |
(make-note 77 335160 8820) | |
(make-note 62 335160 17640) | |
(make-note 81 343980 8820) | |
(make-note 79 352800 8820) | |
(make-note 64 352800 17640) | |
(make-note 77 361620 8820) | |
(make-note 76 370440 8820) | |
(make-note 55 370440 17640) | |
(make-note 74 379260 8820) | |
(make-note 72 388080 8820) | |
(make-note 57 388080 17640) | |
(make-note 76 396900 8820) | |
(make-note 74 405720 8820) | |
(make-note 59 405720 17640) | |
(make-note 77 414540 8820) | |
(make-note 76 423360 8820) | |
(make-note 60 423360 17640) | |
(make-note 74 432180 8820) | |
(make-note 72 441000 8820) | |
(make-note 52 441000 17640) | |
(make-note 71 449820 8820) | |
(make-note 69 458640 8820) | |
(make-note 54 458640 17640) | |
(make-note 72 467460 8820) | |
(make-note 71 476280 8820) | |
(make-note 55 476280 17640) | |
(make-note 74 485100 8820) | |
(make-note 72 493920 8820) | |
(make-note 57 493920 17640) | |
(make-note 71 502740 8820) | |
(make-note 69 511560 8820) | |
(make-note 59 511560 17640) | |
(make-note 67 520380 8820) | |
(make-note 66 529200 8820) | |
(make-note 60 529200 42630) | |
(make-note 69 538020 8820) | |
(make-note 67 546840 8820) | |
(make-note 71 555660 8820) | |
(make-note 69 564480 17640) | |
(make-note 50 573300 8820) | |
(make-note 62 582120 17640) | |
(make-note 52 582120 8820) | |
(make-note 54 590940 8820) | |
(make-note 72 599760 4410) | |
(make-note 55 599760 8820) | |
(make-note 71 604170 4410) | |
(make-note 72 608580 17640) | |
(make-note 52 608580 8820) | |
(make-note 54 617400 8820) | |
(make-note 74 626220 8820) | |
(make-note 50 626220 8820) | |
(make-note 71 635040 8820) | |
(make-note 55 635040 17640) | |
(make-note 69 643860 8820) | |
(make-note 67 652680 8820) | |
(make-note 47 652680 17640) | |
(make-note 66 661500 8820) | |
(make-note 64 670320 8820) | |
(make-note 48 670320 17640) | |
(make-note 67 679140 8820) | |
(make-note 66 687960 8820) | |
(make-note 50 687960 17640) | |
(make-note 69 696780 8820) | |
(make-note 67 705600 8820) | |
(make-note 52 705600 17640) | |
(make-note 71 714420 8820) | |
(make-note 69 723240 8820) | |
(make-note 54 723240 17640) | |
(make-note 72 732060 8820) | |
(make-note 71 740880 8820) | |
(make-note 55 740880 17640) | |
(make-note 74 749700 8820) | |
(make-note 72 758520 8820) | |
(make-note 52 758520 17640) | |
(make-note 76 767340 8820) | |
(make-note 74 776160 8820) | |
(make-note 47 776160 26460) | |
(make-note 71 784980 4410) | |
(make-note 72 789390 4410) | |
(make-note 74 793800 8820) | |
(make-note 79 802620 8820) | |
(make-note 48 802620 8820) | |
(make-note 72 811440 2940) | |
(make-note 50 811440 17640) | |
(make-note 71 814380 2940) | |
(make-note 72 817320 2940) | |
(make-note 71 820260 8820) | |
(make-note 69 829080 8820) | |
(make-note 38 829080 17640) | |
(make-note 67 837900 8820) | |
(make-note 67 846720 17640) | |
(make-note 43 855540 8820) | |
(make-note 45 864360 8820) | |
(make-note 47 873180 8820) | |
(make-note 48 882000 8820) | |
(make-note 45 890820 8820) | |
(make-note 47 899640 8820) | |
(make-note 43 908460 8820) | |
(make-note 50 917280 17640) | |
(make-note 67 926100 8820) | |
(make-note 69 934920 8820) | |
(make-note 55 934920 17640) | |
(make-note 71 943740 8820) | |
(make-note 72 952560 8820) | |
(make-note 54 952560 17640) | |
(make-note 69 961380 8820) | |
(make-note 71 970200 8820) | |
(make-note 55 970200 17640) | |
(make-note 67 979020 8820) | |
(make-note 67 987840 2940) | |
(make-note 57 987840 8820) | |
(make-note 66 990780 2940) | |
(make-note 67 993720 2940) | |
(make-note 66 996660 8820) | |
(make-note 50 996660 8820) | |
(make-note 52 1005480 8820) | |
(make-note 54 1014300 8820) | |
(make-note 55 1023120 8820) | |
(make-note 52 1031940 8820) | |
(make-note 54 1040760 8820) | |
(make-note 50 1049580 8820) | |
(make-note 57 1058400 17640) | |
(make-note 69 1067220 8820) | |
(make-note 71 1076040 8820) | |
(make-note 62 1076040 17640) | |
(make-note 72 1084860 8820) | |
(make-note 74 1093680 8820) | |
(make-note 60 1093680 17640) | |
(make-note 71 1102500 8820) | |
(make-note 72 1111320 8820) | |
(make-note 62 1111320 17640) | |
(make-note 69 1120140 8820) | |
(make-note 71 1128960 17640) | |
(make-note 55 1128960 8820) | |
(make-note 67 1137780 8820) | |
(make-note 65 1146600 8820) | |
(make-note 64 1155420 8820) | |
(make-note 62 1164240 8820) | |
(make-note 65 1173060 8820) | |
(make-note 64 1181880 8820) | |
(make-note 67 1190700 8820) | |
(make-note 65 1199520 17640) | |
(make-note 74 1208340 8820) | |
(make-note 72 1217160 8820) | |
(make-note 64 1217160 17640) | |
(make-note 71 1225980 8820) | |
(make-note 69 1234800 8820) | |
(make-note 65 1234800 17640) | |
(make-note 72 1243620 8820) | |
(make-note 71 1252440 8820) | |
(make-note 62 1252440 17640) | |
(make-note 74 1261260 8820) | |
(make-note 72 1270080 17640) | |
(make-note 64 1270080 8820) | |
(make-note 69 1278900 8820) | |
(make-note 67 1287720 8820) | |
(make-note 65 1296540 8820) | |
(make-note 64 1305360 8820) | |
(make-note 67 1314180 8820) | |
(make-note 65 1323000 8820) | |
(make-note 69 1331820 8820) | |
(make-note 67 1340640 17640) | |
(make-note 76 1349460 8820) | |
(make-note 74 1358280 8820) | |
(make-note 65 1358280 17640) | |
(make-note 72 1367100 8820) | |
(make-note 71 1375920 8820) | |
(make-note 67 1375920 17640) | |
(make-note 74 1384740 8820) | |
(make-note 73 1393560 8820) | |
(make-note 64 1393560 17640) | |
(make-note 76 1402380 8820) | |
(make-note 74 1411200 17640) | |
(make-note 65 1411200 8820) | |
(make-note 70 1420020 8820) | |
(make-note 73 1428840 17640) | |
(make-note 69 1428840 8820) | |
(make-note 67 1437660 8820) | |
(make-note 74 1446480 17640) | |
(make-note 65 1446480 8820) | |
(make-note 69 1455300 8820) | |
(make-note 76 1464120 17640) | |
(make-note 67 1464120 8820) | |
(make-note 70 1472940 8820) | |
(make-note 77 1481760 17640) | |
(make-note 69 1481760 8820) | |
(make-note 67 1490580 8820) | |
(make-note 69 1499400 17640) | |
(make-note 65 1499400 8820) | |
(make-note 64 1508220 8820) | |
(make-note 71 1517040 17640) | |
(make-note 62 1517040 8820) | |
(make-note 65 1525860 8820) | |
(make-note 73 1534680 17640) | |
(make-note 64 1534680 8820) | |
(make-note 67 1543500 8820) | |
(make-note 74 1552320 17640) | |
(make-note 65 1552320 8820) | |
(make-note 64 1561140 8820) | |
(make-note 66 1569960 17640) | |
(make-note 62 1569960 8820) | |
(make-note 60 1578780 8820) | |
(make-note 68 1587600 17640) | |
(make-note 59 1587600 8820) | |
(make-note 62 1596420 8820) | |
(make-note 69 1605240 17640) | |
(make-note 60 1605240 8820) | |
(make-note 64 1614060 8820) | |
(make-note 71 1622880 17640) | |
(make-note 62 1622880 8820) | |
(make-note 60 1631700 8820) | |
(make-note 72 1640520 17640) | |
(make-note 59 1640520 8820) | |
(make-note 57 1649340 8820) | |
(make-note 74 1658160 44100) | |
(make-note 56 1658160 8820) | |
(make-note 59 1666980 8820) | |
)) | |
;; list-of-notes -> pitch (number) | |
;; returns the largest pitch of any note in a list | |
(define (max-pitch l) | |
(cond [(empty? l) empty] | |
[(empty? (rest l)) (note-pitch (first l))] | |
[else | |
(max (note-pitch (first l)) | |
(max-pitch (rest l)))])) | |
(check-expect (max-pitch | |
(cons (make-note 100 44100 25) | |
(cons (make-note 60 88200 25) | |
empty))) 100) | |
;; list-of-notes -> pitch (number) | |
;; returns the smallest pitch of any note in a list | |
(define (min-pitch l) | |
(cond [(empty? l) empty] | |
[(empty? (rest l)) (note-pitch (first l))] | |
[else | |
(min (note-pitch (first l)) | |
(min-pitch (rest l)))])) | |
(check-expect (min-pitch | |
(cons (make-note 100 44100 25) | |
(cons (make-note 60 88200 25) | |
empty))) 60) | |
;; clip the note unless the duration is longer | |
;; than the note's duration | |
(define (maybe-clip sound start end) | |
(clip sound start (min (rs-frames sound) end))) | |
;; list-of-note-blocks -> number | |
;; Produces the lowest number, but this is still the max height because of the way the | |
;; y scale works | |
(define (max-height list) | |
(cond | |
[(empty? (rest list)) (note-block-y-pos (first list))] | |
[else (min (note-block-y-pos (first list)) (max-height (rest list)))])) | |
;; # of big bang ticks in the song, list-of-block-notes -> number | |
;; Produces the change in the y-pos each tick in big bang | |
(define (determine-change-in-y list bbticks) | |
(* -1 (/ (max-height list) bbticks))) | |
(define test-list6 | |
(list (make-note-block ding 200 -100 true) | |
(make-note-block ding 300 -150 true) | |
(make-note-block ding 100 -200 true))) | |
;; note -> rsound | |
;; Turns each note into its proper rsound | |
(define (render-sound n) | |
(maybe-clip (piano-tone (note-pitch n)) | |
0 (* (note-duration n) 2))) | |
;; time (midi-ticks) -> y-pos | |
;; produces the y-pos based on the time | |
(define (determine-y t) | |
(* -1 (* t Y-SCALAR))) | |
;; pitch, list of notes -> x-pos | |
;; produces an x position related to the pitch | |
(define (determine-x pitch list max min) | |
(if (= (- max min) 0) | |
0 | |
(+ (* (/ (- (- WIDTH (/ (image-width NOTE) 2)) (/ (image-width NOTE) 2)) | |
(- max min)) | |
(- pitch min)) | |
(/ (image-width NOTE) 2)))) | |
(define test-list5 | |
(list | |
(make-note 0 0 0) | |
(make-note (/ WIDTH 2) 0 0) | |
(make-note WIDTH 0 0))) | |
(check-expect (determine-x 0 test-list5 (max-pitch test-list5) (min-pitch test-list5)) (/ (image-width NOTE) 2)) | |
(check-expect (determine-x (/ WIDTH 2) test-list5 (max-pitch test-list5) (min-pitch test-list5)) (/ WIDTH 2)) | |
(check-expect (determine-x WIDTH test-list5 (max-pitch test-list5) (min-pitch test-list5)) (- WIDTH (/ (image-width NOTE) 2))) | |
;; list of notes -> list of note-blocks | |
;; converts a list of notes to a list of note-blocks | |
(define (make-blocks list max min) | |
(cond [(empty? list) empty] | |
[else (cons | |
(make-note-block | |
(render-sound (first list)) | |
(determine-x (note-pitch (first list)) list max min) | |
(determine-y (note-time (first list))) | |
true) | |
(make-blocks (rest list) max min))])) | |
;(make-blocks bach-notes (max-pitch bach-notes) (min-pitch bach-notes)) | |
;; world, list of note-blocks -> image | |
;; draws all the note-blocks in a list based on their x and y positions | |
(define (draw-list w list) | |
(cond | |
[(empty? (rest list)) | |
(local | |
[(define LIVES-TEXT (make-text (string-append "LIVES: " (number->string (get-component w 6))) 16 "lightcyan")) | |
(define SCORE-TEXT (make-text (string-append "SCORE: " (number->string (get-component w 7))) 16 "lightcyan"))] | |
(place-image SCORE-TEXT 50 485 | |
(place-image LIVES-TEXT 350 485 | |
;(place-image NOTE (note-block-x-pos (first list)) (note-block-y-pos (first list)) | |
(place-image SPIFF (posn-x (get-component w 1)) (posn-y (get-component w 1)) | |
(place-image BG (/ WIDTH 2) (/ HEIGHT 2) | |
(empty-scene WIDTH HEIGHT))))))] | |
[(and (> (note-block-y-pos (first list)) 0) | |
(< (note-block-y-pos (first list)) (+ HEIGHT (image-height NOTE)))) | |
(place-image NOTE (note-block-x-pos (first list)) (note-block-y-pos (first list)) | |
(draw-list w (rest list)))] | |
[else (draw-list w (rest list))])) | |
;; list-of-strings -> image | |
#|(define (draw-scores l h n) | |
(cond [(= n 5) | |
(place-image (make-text (string-append (number->string n) " --- " (first l)) 16 "cyan") 200 h | |
(place-image SCOREBOARD 200 240 | |
(place-image BACK-TEXT (/ WIDTH 2) 400 | |
(place-image BUTTON (/ WIDTH 2) 400 | |
(place-image HI-SCORES-TEXT-L1 (/ WIDTH 2) 100 | |
(place-image HI-SCORES-TEXT-L2 (+ 2 (/ WIDTH 2)) 103 | |
(place-image BG (/ WIDTH 2) (/ HEIGHT 2) | |
(empty-scene WIDTH HEIGHT))))))))] | |
[else (place-image (make-text (string-append (number->string n) " --- " (first l)) 16 "cyan") 200 h | |
(draw-scores (rest l) (+ h 20) (+ n 1)))]))|# | |
;; world -> image | |
;; draw the world | |
(define (draw-world w) | |
(cond | |
;; if (world-screen) = 2 then the game is on the GAME screen | |
[(= 2 (get-component w 0)) | |
(draw-list w (get-component w 2))] | |
;; if (world-screen) = 3 then the game is on the GAME OVER screen | |
[(= 3 (get-component w 0)) | |
(both (if (> (get-component w 7) (string->number (read-file "hiscores.txt"))) (write-file "hiscores.txt" (number->string (get-component w 7))) "do nothing") | |
(place-image (make-text (string-append "SCORE: " (number->string (get-component w 7))) 16 "ghostwhite") (/ WIDTH 2) 140 | |
(place-image BACK-TEXT (/ WIDTH 2) 400 | |
(place-image BUTTON (/ WIDTH 2) 400 | |
(place-image GAME-OVER-TEXT (/ WIDTH 2) 100 | |
(place-image BG (/ WIDTH 2) (/ HEIGHT 2) | |
(empty-scene WIDTH HEIGHT)))))))] | |
;; if (world-screen) = 4 then the game is on the HI-SCORES screen | |
[(= 4 (get-component w 0)) | |
;(draw-scores HI-SCORES-LIST 190 1)] | |
(place-image (make-text (string-append "The high score is: " (read-file "hiscores.txt")) 16 "cyan") 200 190 | |
(place-image SCOREBOARD 200 240 | |
(place-image BACK-TEXT (/ WIDTH 2) 400 | |
(place-image BUTTON (/ WIDTH 2) 400 | |
(place-image HI-SCORES-TEXT-L1 (/ WIDTH 2) 100 | |
(place-image HI-SCORES-TEXT-L2 (+ 2 (/ WIDTH 2)) 103 | |
(place-image BG (/ WIDTH 2) (/ HEIGHT 2) | |
(empty-scene WIDTH HEIGHT))))))))] | |
;; if (world-screen) = 5 then the game is on the EXTRAS screen | |
[(= 5 (get-component w 0)) | |
(place-image KANYE (/ WIDTH 2) (/ HEIGHT 2) | |
(place-image BACK-TEXT (/ WIDTH 2) 400 | |
(place-image BUTTON (/ WIDTH 2) 400 | |
(place-image CREDITS2 (/ WIDTH 2) 140 | |
(place-image CREDITS1 (/ WIDTH 2) 100 | |
(place-image BG (/ WIDTH 2) (/ HEIGHT 2) | |
(empty-scene WIDTH HEIGHT)))))))] | |
;; (world-screen) = 1 then the game is on the START screen | |
[else | |
(place-image EXTRAS-TEXT (/ WIDTH 2) 400 | |
(place-image BUTTON (/ WIDTH 2) 400 | |
(place-image HI-SCORES-TEXT-S (/ WIDTH 2) 350 | |
(place-image BUTTON (/ WIDTH 2) 350 | |
(place-image PLAY-TEXT (/ WIDTH 2) 300 | |
(place-image BUTTON (/ WIDTH 2) 300 | |
(place-image BAR (/ WIDTH 2) 180 | |
(place-image TITLE3 (/ WIDTH 2) 140 | |
(place-image TITLE1 (/ WIDTH 2) 100 | |
(place-image TITLE4 (+ 2 (/ WIDTH 2)) 143 | |
(place-image TITLE2 (+ 2 (/ WIDTH 2)) 103 | |
(place-image BG (/ WIDTH 2) (/ HEIGHT 2) | |
(empty-scene WIDTH HEIGHT)))))))))))))])) | |
;; world key -> world | |
;; handles key events | |
(define (key-handler w k) | |
(cond | |
[(equal? k "left") | |
(update-world w 1 (make-posn (max 40 (- (posn-x (get-component w 1)) 10)) (posn-y (get-component w 1))))] | |
[(equal? k "right") | |
(update-world w 1 (make-posn (min 360 (+ (posn-x (get-component w 1)) 10)) (posn-y (get-component w 1))))] | |
[(equal? k "up") | |
(update-world w 1 (make-posn (posn-x (get-component w 1)) (max 40 (- (posn-y (get-component w 1)) 10))))] | |
[(equal? k "down") | |
(update-world w 1 (make-posn (posn-x (get-component w 1)) (min 460 (+ (posn-y (get-component w 1)) 10))))] | |
[(equal? k " ") (both (stop) w)] | |
[else w])) | |
;; x y x1 x2 y1 y2 -> boolean | |
;; determines if x and y are within the range of x1 to x2 and y1 to y2 respectively | |
(define (within? x y x1 x2 y1 y2) | |
(and (and (>= y y1) (<= y y2)) | |
(and (>= x x1) (<= x x2)))) | |
;; world number number string -> world | |
(define (mouse-handler w x y evt) | |
(cond | |
;; IN PLAY mouse events | |
[(= 2 (get-component w 0)) (update-world w 1 (make-posn x y))] | |
;; if not in play and not a button-up, just ignore it. | |
[(not (string=? evt "button-up")) w] | |
[(= 1 (get-component w 0)) | |
(cond [(within? x y 70 330 280 320) (both (stop) | |
(update-world (update-world (update-world w 4 (make-pstream)) 3 0) 0 2))] | |
[(within? x y 70 330 330 370) (update-world w 0 4)] | |
[(within? x y 70 330 380 420) (update-world w 0 5)] | |
[else w])] | |
;; GAME OVER screen mouse events | |
[(= 3 (get-component w 0)) | |
(cond [(within? x y 70 330 380 420) (both (stop) | |
(make-world (list 1 (make-posn 200 440) (make-blocks bach-notes (max-pitch bach-notes) (min-pitch bach-notes)) 4352 ps2 DELTA-Y-FOR-BACH-NOTES 3 0)))] | |
;(update-world (update-world (update-world w 6 3) 0 1) 3 4352) )] | |
[else w])] | |
;; HI-SCORES screen mouse events | |
[(= 4 (get-component w 0)) | |
(cond [(within? x y 70 330 380 420) (update-world w 0 1)] | |
[else w])] | |
;; EXTRAS screen mouse events | |
[(= 5 (get-component w 0)) | |
(cond [(within? x y 70 330 380 420) (update-world w 0 1)] | |
[else w])] | |
[else w])) | |
;; posn list-of-notes -> boolean | |
;; returns true if Spiff "hits" a note | |
(define (hit? spiff list) | |
(cond | |
[(empty? list) false] | |
[(and (< (sqrt (sqr (- (posn-x spiff) (note-block-x-pos (first list))))) 60) | |
(< (sqrt (sqr (- (posn-y spiff) (note-block-y-pos (first list))))) 75)) | |
true] | |
[else (hit? spiff (rest list))])) | |
;; list-of-note-blocks, posn -> list-of-note-blocks | |
;; eliminates the hit note-block from the list | |
(define (kill-block spiff list) | |
(cond | |
[(empty? list) empty] | |
[(and (< (sqrt (sqr (- (posn-x spiff) (note-block-x-pos (first list))))) 60) | |
(< (sqrt (sqr (- (posn-y spiff) (note-block-y-pos (first list))))) 75)) | |
(kill-block spiff (rest list))] | |
[else (cons (first list) (kill-block spiff (rest list)))])) | |
(check-expect (kill-block (make-posn 0 0) (make-blocks bach-notes (max-pitch bach-notes) (min-pitch bach-notes))) | |
(make-blocks bach-notes (max-pitch bach-notes) (min-pitch bach-notes))) | |
;; list, number -> list of note blocks | |
;; increases the y-pos of every note-block in the list an equal amount | |
(define (change-y list delta-y) | |
(cond | |
[(empty? list) empty] | |
[else (cons | |
(make-note-block (note-block-sound (first list)) | |
(note-block-x-pos (first list)) | |
(+ (note-block-y-pos (first list)) delta-y) | |
(if (> (- HEIGHT (/ (image-height NOTE) 2)) (note-block-y-pos (first list))) | |
true false)) | |
(change-y (rest list) delta-y))])) | |
;;Something is not quite right about this function. Maybe ask Clements. I feel like it should be >= but that results in it | |
;; playing twice. Where as, I feel like this should play twice. Why? I do not know | |
;; play a single note | |
;; note-block, world -> pstream | |
(define (play-note-block n w) | |
(cond | |
[(note-block-boolean n) (both (pstream-play (get-component w 4) (note-block-sound n)) | |
(update-world w 7 (+ (get-component w 7) 100)))] | |
[else "do nothing"])) | |
;; should play a ding | |
;(play-note-block (make-note-block ding 0 0 true) (make-world (list 0 0 0 0 ps 0 0 0))) | |
;; should not play a ding | |
;(play-note-block (make-note-block ding 0 0 false) (make-world (list 0 0 0 0 ps 0 0 0))) | |
;; note-block, world -> rsound, world | |
;; plays a sound if the y-pos in the note-block is greater than the height but less than the NOTE-REST | |
;; if (play-sound (make-note-block ding 50 500 (s 2))) expect sound to play | |
(define (play-block? n w) | |
(cond | |
[(>= (note-block-y-pos n) (- HEIGHT (/ (image-height NOTE) 2))) | |
(play-note-block n w)] | |
[else "do nothing"])) | |
;; should play a ding | |
;(play-block? (make-note-block ding 10 600 true) (make-world (list 0 0 0 0 ps 0 0 0))) | |
;; list-of-note-blocks, world -> pstream, world | |
;; plays sounds based on note-blocks | |
(define (play-list list w) | |
(cond | |
[(empty? (rest list)) (play-block? (first list) w)] | |
[else (both (play-block? (first list) w) (play-list (rest list) w))])) | |
(define test-list3 | |
(list (make-note-block 60 100 -100 (s 1)) | |
(make-note-block 62 200 -300 (s 1)) | |
(make-note-block 64 300 -500 (s 2)) | |
(make-note-block 62 200 -700 (s 1)) | |
(make-note-block 60 100 -800 (s 3)) | |
(make-note-block 61 150 -850 (s 1)) | |
(make-note-block 63 250 -950 (s 2)) | |
(make-note-block 61 150 -1000 (s 1)) | |
(make-note-block 60 100 -1100 (s 3)) | |
(make-note-block 64 300 -1300 (s 3)))) | |
(define test-list4 | |
(list (make-note-block 500 100 -120 (s 1)) | |
(make-note-block 500 200 -200 (s 1)) | |
(make-note-block 500 300 -300 (s 1)))) | |
; should play a piano-note at middle c for 2 second | |
; (play-list test-list3) | |
;;list of note-blocks -> boolean | |
;; Returns true every every note-block is false | |
(define (all-false? list) | |
(cond [(empty? list) true] | |
[(note-block-boolean (first list)) false] | |
[else (all-false? (rest list))])) | |
;; world -> world | |
;; handles timed/scheduled events | |
(define (tick-handler w) | |
(cond | |
[(and (= 4352 (get-component w 3)) | |
(not (= 2 (get-component w 0)))) | |
(both (play INTRO) (update-world w 3 0))] | |
[(= 0 (get-component w 6)) (update-world w 0 3)] | |
;; playing | |
[(= 2 (get-component w 0)) | |
(cond [(all-false? (get-component w 2)) (update-world w 0 3)] | |
[(hit? (get-component w 1) (get-component w 2)) | |
(update-world | |
(update-world w 6 (- (get-component w 6) 1)) | |
2 | |
(kill-block (get-component w 1) (get-component w 2)))] | |
[else (both (play-list (get-component w 2) w) | |
(update-world | |
(update-world w 7 (+ (get-component w 7) 1)) | |
2 | |
(change-y (get-component w 2) (get-component w 5))))])] | |
[else (update-world w 3 (add1 (get-component w 3)))])) | |
(define BBTICKS-FOR-TEST6 50) | |
(define DELTA-Y-FOR-TEST6 (determine-change-in-y test-list6 BBTICKS-FOR-TEST6)) | |
(define BBTICKS-FOR-BACH-NOTES 400) | |
(define DELTA-Y-FOR-BACH-NOTES 10 | |
#;(round | |
(determine-change-in-y | |
(make-blocks bach-notes 0 0) | |
BBTICKS-FOR-BACH-NOTES))) | |
(define init-blocks | |
(make-blocks bach-notes (max-pitch bach-notes) (min-pitch bach-notes))) | |
(time (change-y init-blocks DELTA-Y-FOR-BACH-NOTES)) | |
(big-bang (make-world | |
(list 1 (make-posn 200 440) init-blocks 4352 ps2 DELTA-Y-FOR-BACH-NOTES 3 0)) | |
(to-draw draw-world) | |
(on-key key-handler) | |
(on-mouse mouse-handler) | |
(on-tick tick-handler)) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment