svn: r9440
This commit is contained in:
Matthias Felleisen
parent
b2e6252d5c
commit
910a0ff677
31
collects/teachpack/htdp/Docs/elevator.scrbl
Normal file
31
collects/teachpack/htdp/Docs/elevator.scrbl
Normal file
|
|
@ -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 <code>elevator.ss</code>, click RUN, and
|
||||
evaluate
|
||||
@schemeblock[(run controller)]
|
||||
|
|
@ -1,32 +0,0 @@
|
|||
{ (define LIBNAME "Elevator")
|
||||
(include "head.tinc") }
|
||||
|
||||
<p>The teachpack <code>elevator.ss</code> 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:
|
||||
<br>
|
||||
<menu>
|
||||
<li><code>{(idx run)} : NextFloor -> void</code>
|
||||
<br>that is, it consumes an elevator controller and returns nothing .
|
||||
</menu>
|
||||
|
||||
<br>
|
||||
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:
|
||||
<br> <code> (define (controller x y z) 7) </code>
|
||||
<br>It moves the elevator once, to the 7th floor.
|
||||
|
||||
<br>
|
||||
|
||||
<br>Second, set the teachpack to <code>elevator.ss</code> execute and
|
||||
run:
|
||||
|
||||
<pre>
|
||||
> (run controller)
|
||||
>
|
||||
</pre>
|
||||
<br>
|
||||
|
||||
{(include "foot.tinc")}
|
||||
|
|
@ -1,4 +0,0 @@
|
|||
<br>
|
||||
<br>
|
||||
</body>
|
||||
</html>
|
||||
|
|
@ -1,12 +0,0 @@
|
|||
<html>
|
||||
<head>
|
||||
<title>Teachpack : {LIBNAME}</title>
|
||||
</head>
|
||||
<body bgcolor="#ffffff" text="#000000"
|
||||
link="#009900" vlink="#007700" alink="#cc0000">
|
||||
|
||||
<a href="index.html">Teachpacks for How to Design Programs</a>
|
||||
|
||||
<h1>{LIBNAME}</h1>
|
||||
|
||||
<hr> <h3>{(idx ,FILENAME)}</h3> <!-- DOCNOTE="teach={FILENAME}" -->
|
||||
|
|
@ -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"]
|
||||
|
|
|
|||
|
|
@ -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 "<li><a href=~s>~a (<tt>~a</tt>)</a></li>\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 "<a name=\""`x"\">"`x"</a>"))]))
|
||||
|
||||
;; 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))
|
||||
Loading…
Reference in New Issue
Block a user