documentation for old teachpacks, stubs for error module, redirect for Kathy's testing module; fixes for redirects

collects/htdp/hangman-world-play.rkt

@@ -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))

collects/htdp/hangman-world.rkt

@@ -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)))
-

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")))

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/servlet2) #:skip legacy-module)
-(check-docs (quote htdp/servlet))
+(check-docs (quote htdp/servlet) #:skip legacy-module)
 (check-docs (quote htdp/matrix))
-(check-docs (quote htdp/matrix-unit))
+(check-docs (quote htdp/matrix-unit) #:skip private-module)
-(check-docs (quote htdp/matrix-sig))
+(check-docs (quote htdp/matrix-sig) #:skip private-module)
-(check-docs (quote htdp/matrix-render-sig))
+(check-docs (quote htdp/matrix-render-sig) #:skip private-module)
-(check-docs (quote htdp/matrix-invisible))
+(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) #:skip comes-from-draw?)
-(check-docs (quote htdp/hangman-world))
-(check-docs (quote htdp/hangman-world-play))
 (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)
-(check-docs (quote htdp/draw-sig))
+  #: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))

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[draw-] operation:
-@scheme[clear-rectangle] instead of @scheme[clear-string] for now.
+
-The color argument for all @scheme[clear-] functions are optional.
+@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}

collects/teachpack/htdp/scribblings/graphing.scrbl

@@ -1,13 +1,11 @@
 #lang scribble/doc
 
-@(require scribble/manual "shared.ss"
+@(require scribble/manual "shared.ss" (for-label scheme teachpack/htdp/graphing))
-          (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. 
+

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)))))
+))
+@;%

collects/teachpack/htdp/scribblings/guess-gui.thtml

@@ -1,27 +0,0 @@
-{ (define LIBNAME "Guess GUI")
-  (include "head.tinc") }
-
-<p>The teachpack <code>guess-gui.ss</code> implements three functions:
-<menu>
-<li> <code>{(idx control)} : N -> symbol</code>
-     <br> to read out the i-th guess choice, starting with 0
-
-<li> <code>{(idx view)} : (union string symbol) -> true </code>
-     <br> to display its argument in the message panel
-
-<li> <code>modelT = (button% event% -> true)</code>
-     <br>
-     <code>{(idx connect)} : modelT -> true</code>
-     <br> to connect a controller with the Check button
-     <br> displays frame
-</menu>
-
-<p>Example:
-<pre>
-(connect (lambda (e b)
-           (begin
-             (printf "0th digit: ~s~n" (control 0))
-             (view (control 0)))))
-</pre>
-
-{(include "foot.tinc")}

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.}

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. 

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"]
 

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.

collects/teachpack/htdp/scribblings/lkup-gui.thtml

@@ -1,25 +0,0 @@
-{ (define LIBNAME "Lkup GUI")
-  (include "head.tinc") }
-
-<p>The teachpack <code>lkup-gui.ss</code> implements three functions:
-<menu>
-<li> <code>{(idx control)} : -> symbol</code> <br>
-     to read out the name that a user typed into the query field
-
-<li> <code>{(idx view)} : (union string symbol) -> true</code> <br>
-     to display its argument in the message panel
-
-<li> <code>modelT = (button% event% -> true)</code> <br>
-     <code>{(idx connect)} : modelT -> true</code> <br>
-     to connect a controller with the Check button displays frame
-</menu>
-
-<p>Example:
-<pre>
-(connect
- (lambda (e b)
-   (view (control))))
-</pre>
-This example simply mirrors what the user types in to the message field.
-
-{(include "foot.tinc")}

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.}