diff --git a/collects/htdp/hangman-world-play.rkt b/collects/htdp/hangman-world-play.rkt deleted file mode 100644 index 05507a00e9..0000000000 --- a/collects/htdp/hangman-world-play.rkt +++ /dev/null @@ -1,57 +0,0 @@ -#lang scheme/gui - -(require "hangman-world.ss" "world.ss") - -#| ------------------------------------------------------------------------ - add-next-part : - { 'noose 'head 'right-arm 'left-arm 'body 'right-leg 'left-leg } scene -> scene - result: #t if things went okay - effect: to add the specified body part in a canvas of size W x H - credit: John Clements - |# -(define (add-next-part body-part s) - (cond [(eq? body-part 'body) - (scene+line s 100 60 100 130 'black)] - [(eq? body-part 'right-leg) - (scene+line s 100 130 30 170 'black)] - [(eq? body-part 'left-leg) - (scene+line s 100 130 170 170 'black)] - [(eq? body-part 'right-arm) - (scene+line s 100 75 40 65 'black)] - [(eq? body-part 'left-arm) - (scene+line s 100 75 160 65 'black)] - [(eq? body-part 'head) - (place-image (circle 10 'outline 'black) 100 50 s)] - [(eq? body-part 'noose) - (local [(define s1 (scene+line s 100 30 100 10 'black)) - (define s2 (scene+line s1 100 10 0 10 'black)) - (define s3 (scene+line s2 115 35 123 43 'black)) - (define s4 (scene+line s3 123 35 115 43 'black)) - (define s5 (scene+line s4 131 40 139 48 'black)) - (define s6 (scene+line s5 139 40 131 48 'black))] - (place-image (circle 30 'outline 'red) 120 50 s6))] - [else (error 'ouch)])) - -;; reveal-list : list-of-letters list-of-letters letter -> list-of-letters -(define (reveal-list l1 l2 gu) - (map (lambda (x1 x2) - (cond - [(symbol=? x1 gu) gu] - [else x2])) - l1 l2)) - -(define (go-list x) (hangman-list reveal-list add-next-part)) - -;; reveal : Word Words Letter -> Word -(define (reveal l1 l2 gu) - (make-word - (reveal1 (word-one l1) (word-one l2) gu) - (reveal1 (word-two l1) (word-two l2) gu) - (reveal1 (word-three l1) (word-three l2) gu))) - -(define (reveal1 x1 x2 gu) - (cond - [(symbol=? x1 gu) gu] - [else x2])) - -(define (go x) (hangman reveal add-next-part)) diff --git a/collects/htdp/hangman-world.rkt b/collects/htdp/hangman-world.rkt deleted file mode 100644 index 18b6e74101..0000000000 --- a/collects/htdp/hangman-world.rkt +++ /dev/null @@ -1,159 +0,0 @@ -#| TODO - 1. use chars for letters; admit letters only - 2. write new exercises - 3. compare error messages for word to beginner language - 4. change messages at end to just display the word -|# -#lang scheme - - (require htdp/world - htdp/error - lang/prim - mzlib/contract - mzlib/etc - mzlib/list) - - (define (letter? s) (and (symbol? s) (pair? (member s LETTERS)))) - (define LETTERS '(a b c d e f g h i j k l m o p q r s t u v w x y z _)) - - (define-struct word (one two three)) - - (provide/contract - [letter? (any/c . -> . boolean?)] - [word? (any/c . -> . boolean?)] - [make-word (letter? letter? letter? . -> . word?)] - [word-one (word? . -> . letter?)] - [word-two (word? . -> . letter?)] - [word-three (word? . -> . letter?)]) - - (provide-higher-order-primitive - ;; Letter = Symbol - ;; type Word - - ;; (Letter Letter Letter -> Word) - ;; (Word Word Letter -> Word) - ;; (Symbol Scene -> Scene) - ;; -> - ;; true - ;; given a function that makes letters from words, and - ;; a function that compares the chosen word to the status word with current guess, - ;; and a function that adds a body part to a Scene, start the world and set up - ;; an event handler to play hangman - hangman (reveal draw-body)) - - (define (hangman rv dr) - (check-proc 'hangman rv 3 'first "3 arguments") - (check-proc 'hangman dr 2 'second "2 arguments") - (local ((define (reveal-list ch st gu) - (local ((define w ; status @ t+1 - (rv (apply make-word ch) (apply make-word st) gu))) - (list (word-one w) (word-two w) (word-three w))))) - (hangman-list reveal-list dr))) - - (provide-higher-order-primitive - ;; Word = [Listof Symbol] - - ;; (Word Word Symbol -> Symbol) (Symbol Scene -> Scene) -> true - ;; given a function that compares the chosen word, the status word, and - ;; the current guess, start the world and install a event handler for - ;; characters that plays hangman - hangman-list (reveal add-body-part)) - - (provide - ;; [Listof Symbols] - body-parts) - - (define body-parts - {list 'noose 'head 'right-arm 'left-arm 'body 'right-leg 'left-leg}) - - (define (hangman-list reveal-list add-next-part) - (check-proc 'hangman-list reveal-list 3 'first "3 arguments") - (check-proc 'hangman-list add-next-part 2 'second "2 arguments") - (local ((define chosen (list-ref WORDS (random (length WORDS)))) - (define status (build-list (length chosen) (lambda (x) '_))) - (define world0 (list chosen status body-parts)) - ;; World KeyEvent -> World - (define (click world ke) - (define pcs (third world)) - (define wrd (first world)) - (define sta (second world)) - (define cmp (reveal-list wrd sta (char->symbol ke))) - (cond - [(symbol? ke) world] - [(equal? sta cmp) (list wrd sta (rest pcs))] - [else (list wrd cmp pcs)])) - ;; World -> Scene - (define (image world) - (define wrd (first world)) - (define cmp (second world)) - (define pcs (third world)) - (define scn - (place-image (text (list-word->string (second world)) 18 'red) 20 100 - (add-up-to body-parts pcs (empty-scene 200 200)))) - (cond - [(equal? wrd cmp) - (place-image (text "Congratulations!" 11 'red) 10 10 scn)] - [(empty? pcs) - (place-image - (text (string-append "This is the end, my friend: " - (list-word->string chosen)) - 11 'red) - 10 10 scn)] - [else scn])) - ;; World -> Boolean - (define (stop? world) - (or (empty? (third world)) (equal? (first world) (second world)))) - ;; [Listof Symbol] [Listof Symbol] Scene -> Scene - (define (add-up-to parts pcs s) - (cond - [(empty? parts) s] - [(and (cons? pcs) (eq? (first parts) (first pcs))) s] - [else (add-up-to (rest parts) pcs (add-next-part (first parts) s))]))) - ;; --- go world go --- - (and - (big-bang 200 200 .1 world0) - (on-redraw image) - (on-key-event click) - (stop-when stop?)))) - - ;; Char -> Symbol - (define (char->symbol c) (string->symbol (format "~a" c))) - - ;; Symbol -> Char - (define (symbol->char c) (string-ref (symbol->string c) 0)) - - ;; Symbol -> Word - (define (word->list s) (map char->symbol (string->list (symbol->string s)))) - - ;; Word -> String - (define (list-word->string w) (list->string (map symbol->char w))) - - ;; a list of symbolic words - (define WORDS - (map word->list - '(and - are - but - cat - cow - dog - eat - fee - gal - hat - inn - jam - kit - lit - met - now - owl - pet - rat - sea - the - usa - vip - was - zoo))) - diff --git a/collects/htdp/info.rkt b/collects/htdp/info.rkt index 8dc150611c..61b3f7014e 100644 --- a/collects/htdp/info.rkt +++ b/collects/htdp/info.rkt @@ -7,3 +7,5 @@ ;; "matrix.ss" "matrix-client.ss" "matrix-invisible.ss" ;; "matrix-render-sig.ss" "matrix-sig.ss" "matrix-unit.ss" "tests")) + +(define scribblings '(("htdp.scrbl"))) diff --git a/collects/htdp/tests/test-docs-complete.rkt b/collects/htdp/tests/test-docs-complete.rkt index 798616d178..dcf5c98e99 100644 --- a/collects/htdp/tests/test-docs-complete.rkt +++ b/collects/htdp/tests/test-docs-complete.rkt @@ -1,34 +1,48 @@ #lang racket/base (require rackunit/docs-complete) + +(define (private-module s) #true) +(define (legacy-module s) #true) + +(require htdp/draw) +(define index-for-htdp/draw (car (identifier-binding #'draw-solid-rect))) +(define (comes-from-draw? h) + (not (module-provide-protected? index-for-htdp/draw h))) + (check-docs (quote htdp/world)) (check-docs (quote htdp/testing)) (check-docs (quote htdp/show-queen)) -(check-docs (quote htdp/servlet2)) -(check-docs (quote htdp/servlet)) +(check-docs (quote htdp/servlet2) #:skip legacy-module) +(check-docs (quote htdp/servlet) #:skip legacy-module) (check-docs (quote htdp/matrix)) -(check-docs (quote htdp/matrix-unit)) -(check-docs (quote htdp/matrix-sig)) -(check-docs (quote htdp/matrix-render-sig)) -(check-docs (quote htdp/matrix-invisible)) +(check-docs (quote htdp/matrix-unit) #:skip private-module) +(check-docs (quote htdp/matrix-sig) #:skip private-module) +(check-docs (quote htdp/matrix-render-sig) #:skip private-module) +(check-docs (quote htdp/matrix-invisible) #:skip private-module) (check-docs (quote htdp/master)) (check-docs (quote htdp/master-play)) (check-docs (quote htdp/lkup-gui)) (check-docs (quote htdp/image)) -(check-docs (quote htdp/hangman)) -(check-docs (quote htdp/hangman-world)) -(check-docs (quote htdp/hangman-world-play)) +(check-docs (quote htdp/hangman) #:skip comes-from-draw?) (check-docs (quote htdp/hangman-play)) (check-docs (quote htdp/gui)) (check-docs (quote htdp/guess)) (check-docs (quote htdp/guess-gui)) -(check-docs (quote htdp/graphing)) +(check-docs (quote htdp/graphing) #:skip comes-from-draw?) (check-docs (quote htdp/error)) (check-docs (quote htdp/elevator)) -(check-docs (quote htdp/draw)) -(check-docs (quote htdp/draw-sig)) +(check-docs (quote htdp/draw) + #:skip (lambda (h) + ;; These identifiers are useful in some tests. They are like + ;; 'friend' in C++ classes. If this weren't a legacy module, I'd + ;; revise the architecture. -- Matthias + (define *hidden + '(draw begin-draw-sequence end-draw-sequence get-@VP get-mouse-event start-and-export)) + (memq h *hidden))) +(check-docs (quote htdp/draw-sig) #:skip private-module) (check-docs (quote htdp/docs)) (check-docs (quote htdp/dir)) (check-docs (quote htdp/convert)) -(check-docs (quote htdp/big-draw)) +(check-docs (quote htdp/big-draw) #:skip private-module) (check-docs (quote htdp/arrow)) (check-docs (quote htdp/arrow-gui)) diff --git a/collects/teachpack/htdp/scribblings/draw.scrbl b/collects/teachpack/htdp/scribblings/draw.scrbl index afab9bc46f..86c5307154 100644 --- a/collects/teachpack/htdp/scribblings/draw.scrbl +++ b/collects/teachpack/htdp/scribblings/draw.scrbl @@ -60,9 +60,32 @@ Draws @scheme[s] at @scheme[p].} Suspends evaluation for @scheme[s] seconds.} The teachpack also provides @scheme[clear-] operations for each -@scheme[draw-] operation. The arguments are the same. Note: use -@scheme[clear-rectangle] instead of @scheme[clear-string] for now. -The color argument for all @scheme[clear-] functions are optional. +@scheme[draw-] operation: + +@defproc[(clear-circle [p posn?] [r number?] [c (unsyntax @tech{DrawColor})]) + true]{ +clears a @scheme[c] circle at @scheme[p] with radius @scheme[r].} + +@defproc[(clear-solid-disk [p posn?] [r number?] [c (unsyntax @tech{DrawColor})]) + true]{ +clears a @scheme[c] disk at @scheme[p] with radius @scheme[r].} + +@defproc[(clear-solid-rect [ul posn?] [width number?] [height number?] + [c (unsyntax @tech{DrawColor})]) + true]{ +clears a @scheme[width] x @scheme[height], @scheme[c] rectangle with the +upper-left corner at @scheme[ul].} + +@defproc[(clear-solid-line [strt posn?] [end posn?] + [c (unsyntax @tech{DrawColor})]) + true]{ +clears a @scheme[c] line from @scheme[strt] to @scheme[end].} + +@defproc[(clear-solid-string [p posn?] [s string?]) true]{ + clears @scheme[s] at @scheme[p].} + +@defproc[(clear-all) true]{ + clears the entire screen.} @;----------------------------------------------------------------------------- @section[#:tag "interaction"]{Interactions with Canvas} diff --git a/collects/teachpack/htdp/scribblings/graphing.scrbl b/collects/teachpack/htdp/scribblings/graphing.scrbl index d4bb711d97..bc9dbd1f09 100644 --- a/collects/teachpack/htdp/scribblings/graphing.scrbl +++ b/collects/teachpack/htdp/scribblings/graphing.scrbl @@ -1,13 +1,11 @@ #lang scribble/doc -@(require scribble/manual "shared.ss" - (for-label scheme - teachpack/htdp/graphing)) +@(require scribble/manual "shared.ss" (for-label scheme teachpack/htdp/graphing)) @teachpack["graphing"]{Graphing Functions} @;declare-exporting[teachpack/htdp/graphing] -@defmodule[#:require-form beginner-require htdp/graphing] +@defmodule[#:require-form beginner-require htdp/graphing #:use-sources (htdp/draw)] The teachpack provides two operations for graphing functions in the regular (upper right) quadrant of the Cartesian plane (between 0 and 10 in both @@ -22,3 +20,6 @@ color.} For color symbols, see @secref{draw}. +In addition, the teachpack re-exports the entire functionality of the +drawing library; see @secref{draw} for documentation. + diff --git a/collects/teachpack/htdp/scribblings/guess-gui.scrbl b/collects/teachpack/htdp/scribblings/guess-gui.scrbl new file mode 100644 index 0000000000..9597e60df1 --- /dev/null +++ b/collects/teachpack/htdp/scribblings/guess-gui.scrbl @@ -0,0 +1,30 @@ +#lang scribble/doc + +@(require scribble/manual "shared.ss" (for-label scheme teachpack/htdp/guess-gui)) + +@teachpack["guess-gui"]{Guess GUI} + +@defmodule[#:require-form beginner-require htdp/guess-gui] + +The teachpack provides three functions: + +@defproc[(control [index natural-number?]) symbol?]{ + reads out the @scheme[index]th guess choice, starting with 0} + +@defproc[(view [msg (or/c string? symbol?)]) true/c]{ + displays its @scheme[msg] argument in the message panel} + +@defproc[(connect [handler (-> button% event% true/c)]) true/c]{ + connects a controller (@scheme[handler]) with the Check button displays frame} + +Example: +@;% +@(begin +#reader scribble/comment-reader +(schemeblock +(connect (lambda (e b) + (begin + (printf "0th digit: ~s~n" (control 0)) + (view (control 0))))) +)) +@;% diff --git a/collects/teachpack/htdp/scribblings/guess-gui.thtml b/collects/teachpack/htdp/scribblings/guess-gui.thtml deleted file mode 100644 index 7764fb2fa6..0000000000 --- a/collects/teachpack/htdp/scribblings/guess-gui.thtml +++ /dev/null @@ -1,27 +0,0 @@ -{ (define LIBNAME "Guess GUI") - (include "head.tinc") } - -
The teachpack guess-gui.ss
implements three functions:
-
Example: -
-(connect (lambda (e b) - (begin - (printf "0th digit: ~s~n" (control 0)) - (view (control 0))))) -- -{(include "foot.tinc")} diff --git a/collects/teachpack/htdp/scribblings/hangman-play.scrbl b/collects/teachpack/htdp/scribblings/hangman-play.scrbl new file mode 100644 index 0000000000..f30faad075 --- /dev/null +++ b/collects/teachpack/htdp/scribblings/hangman-play.scrbl @@ -0,0 +1,16 @@ +#lang scribble/doc + +@(require scribble/manual "shared.ss" + (for-label scheme + teachpack/htdp/hangman)) + +@teachpack["hangman-play"]{Playing Hangman} + +@defmodule[#:require-form beginner-require htdp/hangman-play] + +The teachpack implements the Hangman game so that students can play the +game and get an understanding of what we expect from them. + +@defproc[(go [name symbol?]) true]{ +chooses a ``secret'' three-letter word, opens a canvas and a menu, +and asks the player to guess the word.} diff --git a/collects/teachpack/htdp/scribblings/hangman.scrbl b/collects/teachpack/htdp/scribblings/hangman.scrbl index c00ebd411d..1a50d96cb6 100644 --- a/collects/teachpack/htdp/scribblings/hangman.scrbl +++ b/collects/teachpack/htdp/scribblings/hangman.scrbl @@ -6,7 +6,6 @@ @teachpack["hangman"]{Hangman} -@;declare-exporting[teachpack/htdp/hangman] @defmodule[#:require-form beginner-require htdp/hangman] The teachpack implements the callback functions for playing a @@ -14,9 +13,6 @@ The teachpack implements the callback functions for playing a guesses a letter and the program responds with an answer that indicates how many times, if at all, the letter occurs in the secret word. -The teachpack provides all the drawing operations from @secref{draw} for -managing a canvas into which the ``hangman'' is drawn. - @defproc[(hangman [make-word (-> symbol? symbol? symbol? word?)][reveal (-> word? word? word?)][draw-next-part (-> symbol? true)]) true]{ Chooses a ``secret'' three-letter word and uses the given functions to manage the @emph{Hangman} game.} @@ -32,3 +28,6 @@ in the secret word; @scheme[draw-next-part] is given the symbolic name of a body part and draws it on a separately managed canvas. } + +In addition, the teachpack re-exports the entire functionality of the +drawing library; see @secref{draw} for documentation. diff --git a/collects/teachpack/htdp/scribblings/htdp.scrbl b/collects/teachpack/htdp/scribblings/htdp.scrbl index 7f8f880942..effee3f60b 100644 --- a/collects/teachpack/htdp/scribblings/htdp.scrbl +++ b/collects/teachpack/htdp/scribblings/htdp.scrbl @@ -13,8 +13,10 @@ @include-section["convert.scrbl"] @include-section["guess.scrbl"] @include-section["master.scrbl"] +@include-section["master-play.scrbl"] @include-section["draw.scrbl"] @include-section["hangman.scrbl"] +@include-section["hangman-play.scrbl"] @include-section["arrow.scrbl"] @include-section["docs.scrbl"] @include-section["dir.scrbl"] @@ -22,16 +24,14 @@ @include-section["gui.scrbl"] @include-section["arrow-gui.scrbl"] @include-section["elevator.scrbl"] +@include-section["lkup-gui.scrbl"] +@include-section["guess-gui.scrbl"] @include-section["show-queen.scrbl"] @include-section["matrix.scrbl"] @;-- what do those do? -- -@;include-section["guess-gui.scrbl"] -@;include-section["lkip-gui.scrbl"] - - @;include-section["Simplified Scheme Web Servlets"] @;include-section["Scheme Web Servlets"] diff --git a/collects/teachpack/htdp/scribblings/lkup-gui.scrbl b/collects/teachpack/htdp/scribblings/lkup-gui.scrbl new file mode 100644 index 0000000000..ae16a69f18 --- /dev/null +++ b/collects/teachpack/htdp/scribblings/lkup-gui.scrbl @@ -0,0 +1,30 @@ +#lang scribble/doc + +@(require scribble/manual "shared.ss" (for-label scheme teachpack/htdp/lkup-gui)) + +@teachpack["lkup-gui"]{Lookup GUI} + +@defmodule[#:require-form beginner-require htdp/lkup-gui] + +The teachpack provides three functions: + +@defproc[(control [index natural-number?]) symbol?]{ + reads out the @scheme[index]th guess choice, starting with 0} + +@defproc[(view [msg (or/c string? symbol?)]) true/c]{ + displays its @scheme[msg] argument in the message panel} + +@defproc[(connect [event-handler (-> button% event% true/c)]) true/c]{ + connects a controller (@scheme[handler]) with the Check button displays frame} + +Example: +@;% +@(begin +#reader scribble/comment-reader +(schemeblock +(connect + (lambda (e b) + (view (control)))) +)) +@;% +This example simply mirrors what the user types in to the message field. diff --git a/collects/teachpack/htdp/scribblings/lkup-gui.thtml b/collects/teachpack/htdp/scribblings/lkup-gui.thtml deleted file mode 100644 index eeaffdbb9d..0000000000 --- a/collects/teachpack/htdp/scribblings/lkup-gui.thtml +++ /dev/null @@ -1,25 +0,0 @@ -{ (define LIBNAME "Lkup GUI") - (include "head.tinc") } - -
The teachpack lkup-gui.ss
implements three functions:
-
Example: -
-(connect - (lambda (e b) - (view (control)))) --This example simply mirrors what the user types in to the message field. - -{(include "foot.tinc")} diff --git a/collects/teachpack/htdp/scribblings/master-play.scrbl b/collects/teachpack/htdp/scribblings/master-play.scrbl new file mode 100644 index 0000000000..09c980a55d --- /dev/null +++ b/collects/teachpack/htdp/scribblings/master-play.scrbl @@ -0,0 +1,14 @@ +#lang scribble/doc + +@(require scribble/manual "shared.ss" (for-label scheme teachpack/htdp/master)) + +@teachpack["master-play"]{Playing MasterMind} + +@defmodule[#:require-form beginner-require htdp/master-play] + +The teachpack implements the MasterMind game so that students can play the +game and get an understanding of what we expect from them. + +@defproc[(go [name symbol?]) true]{ +chooses a ``secret'' three-letter word, opens a canvas and a menu, +and asks the player to guess the word.}