suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

made to-draw/on-draw in big-bang mandatory; Closes PR 11663

Browse Source
This commit is contained in:
Matthias Felleisen 2011-01-22 12:06:18 -05:00
parent 9c4c0b0848
commit 814a847323
6 changed files with 70 additions and 67 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

40
collects/2htdp/private/syn-aux.rkt
View File

@ -7,7 +7,8 @@
->args
function-with-arity expr-with-check except err
->kwds-in
clauses-use-kwd)
clauses-use-kwd
contains-clause?)
(require
(for-syntax "syn-aux-aux.rkt" syntax/parse)
@ -45,21 +46,7 @@
[(_ para (... ...))
(let*-values
([(kwds defs)
(values (map car the-list) '())
#;
(let L ([the-list the-list][kwds '()][defs '()])
(if (null? the-list)
(values kwds defs)
(let* ([kw-alt-c-d (car the-list)]
[kw0 (car kw-alt-c-d)]
[kw1 (cadr kw-alt-c-d)]
[coe (caddr kw-alt-c-d)]
[def (cadddr kw-alt-c-d)])
(if (eq? (syntax-e kw0) (syntax-e kw1))
(L (cdr the-list) (cons kw0 kwds) (cons def defs))
(L (cdr the-list)
(list* kw0 kw1 kwds)
(list* def def defs))))))]
(values (map car the-list) '())]
;; the defaults list defs is no longer needed
[(args) (lambda (para*)
(append para* (foldr cons '() kwds)))]
@ -102,20 +89,11 @@
(syntax->list (cdar spec))]
[else (loop (cdr spec))])))
(if r ((third s) r) (fourth s)))
Spec)
#;
(apply append
(map (lambda (x)
(define kw (car x))
(define-values (key coercion)
(let loop ([kwds kwds][Spec Spec])
(if (free-identifier=? (car kwds) kw)
;; -- the original keyword, which is also the init-field name
;; -- the coercion that comes with it
(values (cadar Spec) (caddar Spec))
(loop (cdr kwds) (cdr Spec)))))
(list (mk-kwd key) (coercion (cdr x))))
spec)))
Spec))
(define (contains-clause? kw clause-list)
(memf (lambda (clause) (free-identifier=? kw (car (syntax->list clause)))) clause-list))
;; Syntax -> Syntax
;; eventually: convert syntax to keyword
@ -147,7 +125,7 @@
(raise-syntax-error tag (format "duplicate ~a clause" id) (cdar x))
(duplicates? (rest lox))))])))
;; check whether rec? occurs, produce list of keywords
;; check whether rec? occurs, produce list of keyword x clause pairs
(define (clauses-use-kwd stx:list ->rec? legal-clause kwds)
(define kwd-in? (->kwds-in kwds))
(define double (string-append legal-clause ", ~a has been redefined"))

8
collects/2htdp/tests/server-rename.rkt Normal file
View File

@ -0,0 +1,8 @@
#lang racket
(require (prefix-in uni: 2htdp/universe))
(define (server)
(uni:universe 0
(uni:on-new cons)
(uni:on-msg list)
(uni:on-tick add1)))

7
collects/2htdp/tests/world0-stops.rkt
View File

@ -3,11 +3,14 @@
#reader(lib "htdp-intermediate-lambda-reader.ss" "lang")((modname world0-stops) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f ())))
(require 2htdp/universe)
(require 2htdp/image)
(define draw (lambda (x) (circle 3 'solid 'red)))
"does big-bang stop when the initial world is already a final world?"
(big-bang 0 (stop-when zero?) (on-tick add1))
(big-bang 0 (stop-when zero?) (on-tick add1) (to-draw draw))
"does big bang stop when the initial world is a stop world?"
(big-bang (stop-with 0) (on-tick add1))
(big-bang (stop-with 0) (on-tick add1) (to-draw draw))
(define-struct stop (x))

2
collects/2htdp/tests/xtest
View File

@ -28,6 +28,8 @@ gracket test-image.rkt
echo "done:--- test-image.rkt ---" echo ""
gracket ufo-rename.rkt
echo "done:--- ufo-rename.rkt ---" echo ""
gracket server-rename.rkt
echo "done:--- server-rename.rkt ---" echo ""
gracket world0-stops.rkt
echo "done:--- world0-stops.rkt ---" echo ""
gracket record.rkt

19
collects/2htdp/universe.rkt
View File

@ -226,10 +226,15 @@
[(V) (set! rec? #'V)]
[_ (err '#'record? stx)])))]
[args
(->args 'big-bang stx #'w #'(clause ...) WldSpec ->rec? "world")])
(stepper-syntax-property
#`(run-it ((new-world (if #,rec? aworld% world%)) w #,@args))
'stepper-skip-completely #t))]))
(->args 'big-bang stx #'w #'(clause ...) WldSpec ->rec? "world")]
[dom (syntax->list #'(clause ...))])
(cond
[(and (not (contains-clause? #'to-draw dom)) (not (contains-clause? #'on-draw dom)))
(raise-syntax-error #f "missing to-draw clause" stx)]
[else
(stepper-syntax-property
#`(run-it ((new-world (if #,rec? aworld% world%)) w #,@args))
'stepper-skip-completely #t)]))]))
(define (run-simulation f)
(check-proc 'run-simulation f 1 "first" "one argument")
@ -310,11 +315,11 @@
[(universe u bind ...)
(let* ([args
(->args 'universe stx #'u #'(bind ...) UniSpec void "universe")]
[dom (map (compose car syntax->datum) (syntax->list #'(bind ...)))])
[dom (syntax->list #'(bind ...))])
(cond
[(not (memq 'on-new dom))
[(not (contains-clause? #'on-new dom))
(raise-syntax-error #f "missing on-new clause" stx)]
[(not (memq 'on-msg dom))
[(not (contains-clause? #'on-msg dom))
(raise-syntax-error #f "missing on-msg clause" stx)]
[else ; (and (memq #'on-new dom) (memq #'on-msg dom))
#`(run-it ((new-universe universe%) u #,@args))]))]))

61
collects/teachpack/2htdp/scribblings/universe.scrbl
View File

@ -189,6 +189,40 @@ The design of a world program demands that you come up with a data
closes the canvas.
}
The only mandatory clause of a @scheme[big-bang] description is
@scheme[to-draw] (or @scheme[on-draw] for backwards compatibility):
@itemize[
@item{
@defform[(to-draw render-expr)
#:contracts
([render-expr (-> (unsyntax @tech{WorldState}) scene?)])]{
tells DrRacket to call the function @scheme[render-expr] whenever the
canvas must be drawn. The external canvas is usually re-drawn after DrRacket has
dealt with an event. Its size is determined by the size of the first
generated @tech{scene}.}
@defform/none[#:literals (to-draw)
(to-draw render-expr width-expr height-expr)
#:contracts
([render-expr (-> (unsyntax @tech{WorldState}) scene?)]
[width-expr natural-number/c]
[height-expr natural-number/c])]{
tells DrRacket to use a @scheme[width-expr] by @scheme[height-expr]
canvas instead of one determine by the first generated @tech{scene}.
}
For compatibility reasons, the teachpack also supports the keyword
@defidform/inline[on-draw] in lieu of @scheme[to-draw] but the latter is preferred
now.
}
]
All remaining clauses are optional:
@itemize[
@item{
@ -393,33 +427,6 @@ All @tech{MouseEvent}s are represented via strings:
signals most of them.}
}
@item{
@defform[(to-draw render-expr)
#:contracts
([render-expr (-> (unsyntax @tech{WorldState}) scene?)])]{
tells DrRacket to call the function @scheme[render-expr] whenever the
canvas must be drawn. The external canvas is usually re-drawn after DrRacket has
dealt with an event. Its size is determined by the size of the first
generated @tech{scene}.}
@defform/none[#:literals (to-draw)
(to-draw render-expr width-expr height-expr)
#:contracts
([render-expr (-> (unsyntax @tech{WorldState}) scene?)]
[width-expr natural-number/c]
[height-expr natural-number/c])]{
tells DrRacket to use a @scheme[width-expr] by @scheme[height-expr]
canvas instead of one determine by the first generated @tech{scene}.
}
For compatibility reasons, the teachpack also supports the keyword
@defidform/inline[on-draw] in lieu of @scheme[to-draw] but the latter is preferred
now.
}
@item{
@defform[(stop-when last-world?)