From 910a0ff6775e23e06678122fa11940206f824308 Mon Sep 17 00:00:00 2001 From: Matthias Felleisen Date: Wed, 23 Apr 2008 23:12:03 +0000 Subject: [PATCH] svn: r9440 --- collects/teachpack/htdp/Docs/elevator.scrbl | 31 +++++ collects/teachpack/htdp/Docs/elevator.thtml | 32 ----- collects/teachpack/htdp/Docs/foot.tinc | 4 - collects/teachpack/htdp/Docs/head.tinc | 12 -- collects/teachpack/htdp/Docs/htdp.scrbl | 3 +- collects/teachpack/htdp/Docs/mkdocs | 133 -------------------- 6 files changed, 33 insertions(+), 182 deletions(-) create mode 100644 collects/teachpack/htdp/Docs/elevator.scrbl delete mode 100644 collects/teachpack/htdp/Docs/elevator.thtml delete mode 100644 collects/teachpack/htdp/Docs/foot.tinc delete mode 100644 collects/teachpack/htdp/Docs/head.tinc delete mode 100755 collects/teachpack/htdp/Docs/mkdocs diff --git a/collects/teachpack/htdp/Docs/elevator.scrbl b/collects/teachpack/htdp/Docs/elevator.scrbl new file mode 100644 index 0000000000..3ee614d364 --- /dev/null +++ b/collects/teachpack/htdp/Docs/elevator.scrbl @@ -0,0 +1,31 @@ +#lang scribble/doc + +@(require scribble/manual + (for-label scheme + teachpack/htdp/elevator)) + +@title[#:tag "elevator"]{Controlling an Elevator: elevator.ss} + +@declare-exporting[teachpack/htdp/elevator] + +The teachpack implements an elevator simulator. + +It displays an eight-floor elevator and accepts mouse clicks from the user, +which are translated into service demands for the elevator. + +@defproc[(run [NextFloor number?]) any/c]{Creates an elevator simulator +that is controlled by @scheme[NextFloor]. This function consumes the +current floor, the direction in which the elevator is moving, and the +current demands. From that, it computes where to send the elevator next.} + +Example: Define a function that consumes the current state of +the elevator (three arguments) and returns a number between 1 and 8. Here +is a non-sensical definition: + +@schemeblock[(define (controller x y z) 7)] + +It moves the elevator once, to the 7th floor. + +Second, set the teachpack to elevator.ss, click RUN, and +evaluate +@schemeblock[(run controller)] diff --git a/collects/teachpack/htdp/Docs/elevator.thtml b/collects/teachpack/htdp/Docs/elevator.thtml deleted file mode 100644 index ad740a7125..0000000000 --- a/collects/teachpack/htdp/Docs/elevator.thtml +++ /dev/null @@ -1,32 +0,0 @@ -{ (define LIBNAME "Elevator") - (include "head.tinc") } - -

The teachpack elevator.ss implements an elevator simulator. -It displays an eight-floor elevator and accepts mouse clicks from the user, -which are translated into service demands for the elevator. The teachpack -provides a single operation: -
-

-
  • {(idx run)} : NextFloor -> void -
    that is, it consumes an elevator controller and returns nothing . -
    •  - -
    -Sample session: First define a function that consumes the current state of -the elevator (three arguments) and returns a number between 1 and 8. Here -is a non-sensical definition: -
    (define (controller x y z) 7) -
    It moves the elevator once, to the 7th floor. - -
    - -
    Second, set the teachpack to elevator.ss execute and -run: - -
    -> (run controller)
->
-
    -
    - -{(include "foot.tinc")} diff --git a/collects/teachpack/htdp/Docs/foot.tinc b/collects/teachpack/htdp/Docs/foot.tinc deleted file mode 100644 index 454bc56343..0000000000 --- a/collects/teachpack/htdp/Docs/foot.tinc +++ /dev/null @@ -1,4 +0,0 @@ -
    -
    - - diff --git a/collects/teachpack/htdp/Docs/head.tinc b/collects/teachpack/htdp/Docs/head.tinc deleted file mode 100644 index d719284951..0000000000 --- a/collects/teachpack/htdp/Docs/head.tinc +++ /dev/null @@ -1,12 +0,0 @@ - - -Teachpack : {LIBNAME} - - - -Teachpacks for How to Design Programs - -

    {LIBNAME}

    - -

    {(idx ,FILENAME)}

    diff --git a/collects/teachpack/htdp/Docs/htdp.scrbl b/collects/teachpack/htdp/Docs/htdp.scrbl index ad3c62aaa6..5f4567685d 100644 --- a/collects/teachpack/htdp/Docs/htdp.scrbl +++ b/collects/teachpack/htdp/Docs/htdp.scrbl @@ -21,9 +21,10 @@ @include-section["graphing.scrbl"] @include-section["gui.scrbl"] @include-section["arrow-gui.scrbl"] +@include-section["elevator.scrbl"] @;include-section["guess-gui.scrbl"] -@;include-section["elevator.scrbl"] + @;include-section["Simplified Scheme Web Servlets"] @;include-section["Scheme Web Servlets"] diff --git a/collects/teachpack/htdp/Docs/mkdocs b/collects/teachpack/htdp/Docs/mkdocs deleted file mode 100755 index 2d0f9f4ead..0000000000 --- a/collects/teachpack/htdp/Docs/mkdocs +++ /dev/null @@ -1,133 +0,0 @@ -#!/bin/sh -#| -*- scheme -*- -if [ -x "$PLTHOME/bin/mzscheme" ]; then - exec "$PLTHOME/bin/mzscheme" -qgr "$0" "$@" -else - exec "mzscheme" -qgr "$0" "$@" -fi -|# - -(require (lib "etc.ss") (lib "dirs.ss" "setup")) -(current-directory (this-expression-source-directory)) - -; for john? - -;; This list determines the order of libraries in the index file: -(define libraries* - '(#"Images" - #"Animated Images, Simulating Worlds" - #"Testing" - #"Convert" - #"Guess" - #"Mastermind" - #"Simple Drawing Exercises" - #"Hangman" - #"Arrows" - #"Documents" - #"Directories" - #"Graphing Functions" - ;; #"Graphing Functions 2" - #"GUI" - #"Lkup GUI" - #"Arrows GUI" - #"Guess GUI" - #"Elevator" - #"Simplified Scheme Web Servlets" - #"Scheme Web Servlets" - #"Show Queen")) - -(define dest-dir (build-path (find-doc-dir) "teachpack")) -(printf "writing docs to ~s\n" (path->string dest-dir)) - -(require (lib "list.ss")) - -(define thtml-files - (filter (lambda (x) (regexp-match #rx#"[.]thtml$" (path->bytes x))) - (directory-list))) - -(unless (directory-exists? dest-dir) (make-directory dest-dir)) - -;; Get list of (list name file-basename) for library names -;; (assuming that foo.thtml is always the documentation for ../foo.ss) -(define lib-names - (let ([rx (regexp (string-append "\\(define +LIBNAME +\"(.*?)\"\\)"))]) - (map (lambda (s) - (let* ([m (or (regexp-match rx (open-input-file s)) - (error 'mkdocs "LIBNAME+FILENAME not found in ~s" s))] - [basename (regexp-replace #rx#"[.]thtml$" (path->bytes s) #"")] - [ss-name (bytes->path (bytes-append basename #".ss"))]) - (unless (file-exists? (build-path 'up ss-name)) - (error 'mkdocs "Found ~s but no ~s teachpack found" s ss-name)) - (list (cadr m) (bytes->path basename)))) - (filter (lambda (f) (not (equal? (path->bytes f) #"index.thtml"))) - thtml-files)))) -;; Check that `lib-names' exactly match `libraires': -(let ([file-libs (map car lib-names)]) - (define (test x) (and (pair? x) x)) - (cond - [(test (remove* libraries* lib-names (lambda (x y) (equal? x (car y))))) => - (lambda (libs) - (error 'mkdocs "found libraries unlisted in mkdocs: ~s" libs))] - [(test (remove* file-libs libraries*)) => - (lambda (libs) - (error 'mkdocs "non-existent libraries listed in mkdocs: ~s" libs))]) - (let loop ([libs lib-names]) - (cond [(null? libs) 'ok] - [(assoc (caar libs) (cdr libs)) => - (lambda (m) - (error 'mkdocs "library ~s has two .thtml files: ~s and ~s" - (caar libs) (cdar libs) (cdr m)))] - [else (loop (cdr libs))]))) - -;; Just like lib-names, but ordered according to libraries* -(define libraries (map (lambda (l) (assoc l lib-names)) libraries*)) - -(define LIBLINKS - (map (lambda (lib) - (format "
  • ~a (~a)
    • \n" - (string-append (bytes->string/utf-8 (path->bytes (cadr lib))) ".html") - (car lib) - (string-append (bytes->string/utf-8 (path->bytes (cadr lib))) ".ss"))) - libraries)) - -;; Stuff for the preprocessed files -(require (lib "mzpp.ss" "preprocessor")) -(beg-mark "{") (end-mark "}") -(define index-entries '()) -(define FILENAME #f) -(define LIBNAME #f) -(define HTMLNAME #f) -(define-syntax idx - (syntax-rules () - [(_ x) - (begin (set! index-entries (cons (list FILENAME LIBNAME HTMLNAME `x) - index-entries)) - (list ""`x""))])) - -;; Make html files -(for-each (lambda (thtml) - (define html (bytes->path (regexp-replace #rx#"[.]thtml" (path->bytes thtml) #".html"))) - (printf "Processing ~a...\n" thtml) - (set! HTMLNAME html) - (set! FILENAME (bytes->path (regexp-replace #rx#"[.]thtml" (path->bytes thtml) #".ss"))) - (with-output-to-file (build-path dest-dir html) - (lambda () (preprocess thtml)) - 'replace)) - thtml-files) - -;; Make hdindex file: -(let ([ifile (build-path dest-dir "hdindex")]) - (printf "Writing hdindex...\n") - (with-output-to-file ifile - (lambda () - (define (writeln x) (printf "~s\n" x)) - (define (do-entry filename libname html entry) - (let ([entry (format "~a" entry)] - [title (format "~a teachpack" libname)]) - (writeln `(,entry ,(bytes->string/utf-8 (path->bytes html)) ,entry ,title)))) - (printf "(\n") - (let ([title "Teachpacks for \"How to Design Programs\""]) - (writeln `(,title "index.html" "HtDP" ,title))) - (for-each (lambda (x) (apply do-entry x)) (reverse index-entries)) - (printf ")\n")) - 'truncate))