diff --git a/collects/realm/chapter5/readme.txt b/collects/realm/chapter5/readme.txt new file mode 100644 index 0000000000..e95f41f8ec --- /dev/null +++ b/collects/realm/chapter5/readme.txt @@ -0,0 +1,18 @@ + +This chapter implements an interactive, graphical version of the "guess my +numbers" game. Open the file + + source.rkt + +in DrRacket. The instructions for starting are at the top of the file. +Our tests are at the bottom of the file in a separate 'test' submodule. + +;; ----------------------------------------------------------------------------- + +If you wish to experiment with a small world program, open + + ufo-source.rkt + +The file runs a UFO from the top of the screen to the bottom. + + diff --git a/collects/realm/chapter5/source.rkt b/collects/realm/chapter5/source.rkt new file mode 100644 index 0000000000..14a8579374 --- /dev/null +++ b/collects/realm/chapter5/source.rkt @@ -0,0 +1,249 @@ +#lang racket + +;; ----------------------------------------------------------------------------- +;; Play a "Guess my Number" game with a GUI. + +(require rackunit rackunit/text-ui 2htdp/image 2htdp/universe) + +;; Play a Guess my Number game at the REPL. +;; Run program. +;; Pick a number X between and . +;; Evaluate +;; (start ) +;; This will pop up a window with instructions for interacting with the program. +;; Watch how qiuckly the program guesses X. + +; +; +; +; ; +; +; ; ;; ;; ;;;; ;;; ; ;; +; ;; ;; ; ; ; ;; ; +; ; ; ; ;;;; ; ; ; +; ; ; ; ; ; ; ; ; +; ; ; ; ; ;; ; ; ; +; ; ; ; ;; ; ; ; ; +; +; + +;; Number Number -> GuessRange +;; Start playing a new game in [n,m] +;; > (start 0 100) ; Press up, up, down, q. +;; (interval 76 87) +(define (start lower upper) + (big-bang (interval lower upper) + (on-key deal-with-guess) + (to-draw render) + (stop-when single? render))) + +; +; +; +; +; ; ; +; ;;;; ;;;;; ;;;; ;;;;; ;;; +; ; ; ; ; ; ; +; ;; ; ;;;; ; ;;;;; +; ; ; ; ; ; ; +; ; ; ; ;; ; ; +; ;;;; ;;; ;; ; ;;; ;;;; +; +; + +(struct interval (small big) #:transparent) +;; A GuessRange is a (interval Number Number) +;; Always true: (interval l u) means (<= l u). + +; +; +; +; +; ; ; +; ;;;; ;;; ; ;; ;;;; ;;;;; ;;;; ; ;; ;;;;; ;;;; +; ; ; ; ;; ; ; ; ; ;; ; ; ; +; ; ; ; ; ; ;; ; ;;;; ; ; ; ;; +; ; ; ; ; ; ; ; ; ; ; ; ; ; +; ; ; ; ; ; ; ; ; ;; ; ; ; ; +; ;;;; ;;; ; ; ;;;; ;;; ;; ; ; ; ;;; ;;;; +; +; + +(define TEXT-SIZE 11) +(define HELP-TEXT + (text "↑ for larger numbers, ↓ for smaller ones" + TEXT-SIZE + "blue")) +(define HELP-TEXT2 + (text "Press = when your number is guessed; q to quit." + TEXT-SIZE + "blue")) +(define WIDTH (+ (image-width HELP-TEXT2) 10)) +(define HEIGHT 150) +(define COLOR "red") +(define SIZE 72) +(define TEXT-X 3) +(define TEXT-UPPER-Y 10) +(define TEXT-LOWER-Y 135) +(define MT-SC + (place-image/align + HELP-TEXT TEXT-X TEXT-UPPER-Y + "left" "top" + (place-image/align + HELP-TEXT2 + TEXT-X TEXT-LOWER-Y "left" "bottom" + (empty-scene WIDTH HEIGHT)))) + +; +; +; ; ; ;;; +; ; ; ; +; ; ; ; +; ; ;; ;;;; ; ;; ;; ; ; ;;; ; ;;; ;;;; +; ;; ; ; ;; ; ; ;; ; ; ; ;; ; ; +; ; ; ;;;; ; ; ; ; ; ;;;;; ; ;; +; ; ; ; ; ; ; ; ; ; ; ; ; +; ; ; ; ;; ; ; ; ;; ; ; ; ; +; ; ; ;; ; ; ; ;; ; ; ;;;; ; ;;;; +; +; + +;; GuessRange -> Boolean +;; Does the interval represent a single number? +;; > (single? (interval 1 1)) +;; #t +(define (single? w) + (= (interval-small w) (interval-big w))) + +;; GuessRange -> Number +;; Calculates a guess based on the given interval +;; > (guess (interval 0 100)) +;; 50 +(define (guess w) + (quotient (+ (interval-small w) (interval-big w)) 2)) + +;; GuessRange -> GuessRange +;; Recreates a GuessRange that lowers the upper bound +;; > (smaller (interval 0 100)) +;; (interval 0 50) +(define (smaller w) + (interval (interval-small w) + (max (interval-small w) + (sub1 (guess w))))) + +;; GuessRange -> GuessRange +;; Recreates a interval that raises the lower bound +;; > (bigger (0 100) +;; (interval 51 100) +(define (bigger w) + (interval (min (interval-big w) + (add1 (guess w))) + (interval-big w))) + +;; GuessRange Key -> GuessRange +;; Handles key input +;; > (key-handler (interval 0 100) "up") +;; (interval 51 100) +;; > (key-handler (interval 0 100) "q") +;; (stop-with (interval 0 100)) +(define (deal-with-guess w key) + (cond [(key=? key "up") (bigger w)] + [(key=? key "down") (smaller w)] + [(key=? key "q") (stop-with w)] + [(key=? key "=") (stop-with w)] + [else w])) + +; +; +; ; +; ; ; +; ; +; ; ;;; ;;; ; ;; ;; ; ;;; ; ;;; ;;; ; ;; ;; ; +; ;; ; ; ; ;; ; ; ;; ; ; ;; ; ; ;; ; ; ;; +; ; ;;;;; ; ; ; ; ;;;;; ; ; ; ; ; ; +; ; ; ; ; ; ; ; ; ; ; ; ; ; +; ; ; ; ; ; ;; ; ; ; ; ; ; ;; +; ; ;;;; ; ; ;; ; ;;;; ; ; ; ; ;; ; +; ; +; ;;;; + +;; GuessRange -> Scene +;; Visualize given interval as a scene +;; > (render (interval 0 100)) +;; (overlay (text "50" 72 "red") MT-SC) +(define (render w) + (overlay (text (number->string (guess w)) SIZE COLOR) MT-SC)) + +; +; +; +; +; ; ; +; ;;;;; ;;; ;;;; ;;;;; ;;;; +; ; ; ; ; ; ; +; ; ;;;;; ;; ; ;; +; ; ; ; ; ; +; ; ; ; ; ; +; ;;; ;;;; ;;;; ;;; ;;;; +; +; + +(module+ test + + ;; testing the 'model' functions for basic guesses + + (check-true (single? (interval 50 50))) + (check-false (single? (interval 50 51))) + + (check-equal? (guess (interval 0 100)) 50) + (check-equal? (guess (interval 50 100)) 75) + (check-equal? (guess (interval 0 50)) 25) + + (check-equal? (smaller (interval 0 100)) (interval 0 49)) + (check-equal? (smaller (interval 0 000)) (interval 0 0)) + (check-equal? (smaller (interval 0 50)) (interval 0 24)) + (check-equal? (smaller (interval 50 100)) (interval 50 74)) + (check-equal? (smaller (bigger (bigger (interval 0 100)))) + (interval 76 87)) + + (check-equal? (bigger (interval 0 100)) (interval 51 100)) + (check-equal? (bigger (interval 0 000)) (interval 0 0)) + (check-equal? (bigger (interval 0 100)) (interval 51 100)) + (check-equal? (bigger (interval 51 100)) (interval 76 100)) + (check-equal? (bigger (interval 0 50)) (interval 26 50)) + + (check-equal? (deal-with-guess (interval 0 100) "up") (interval 51 100)) + (check-equal? (deal-with-guess (interval 0 100) "down") (interval 0 49)) + (check-equal? (deal-with-guess (interval 0 100) "=") + (stop-with (interval 0 100))) + (check-equal? (deal-with-guess (interval 0 100) "q") + (stop-with (interval 0 100))) + (check-equal? (deal-with-guess (interval 0 100) "up") + (interval 51 100)) + (check-equal? (deal-with-guess (interval 50 100) "up") + (interval 76 100)) + (check-equal? (deal-with-guess (interval 0 100) "down") + (interval 0 49)) + (check-equal? (deal-with-guess (interval 0 50) "down") + (interval 0 24)) + (check-equal? (deal-with-guess (interval 50 100) "e") + (interval 50 100)) + (check-equal? (deal-with-guess (interval 0 100) "f") + (interval 0 100)) + (check-equal? (deal-with-guess (deal-with-guess (interval 1 10) "up") + "down") + (interval 6 7)) + + ;; testing the view functions + + (check-equal? (render (interval 0 100)) + (overlay (text "50" 72 "red") MT-SC)) + (check-equal? (render (interval 0 100)) + (overlay (text "50" SIZE COLOR) MT-SC)) + (check-equal? (render (interval 0 50)) + (overlay (text "25" SIZE COLOR) MT-SC)) + (check-equal? (render (interval 50 100)) + (overlay (text "75" SIZE COLOR) MT-SC)) + + "all tests run") +