From 77bff11a142fc8d2f3bfafd3928e46756927bccb Mon Sep 17 00:00:00 2001 From: Matthias Felleisen Date: Sat, 24 Apr 2010 10:18:20 -0400 Subject: [PATCH] clean up from svn --- collects/2htdp/universe-request.txt | 77 ++++++++++++++++ collects/2htdp/universe-syntax-parse.ss | 117 ++++++++++++++++++++++++ collects/2htdp/universe.ss | 2 - 3 files changed, 194 insertions(+), 2 deletions(-) create mode 100644 collects/2htdp/universe-request.txt create mode 100644 collects/2htdp/universe-syntax-parse.ss diff --git a/collects/2htdp/universe-request.txt b/collects/2htdp/universe-request.txt new file mode 100644 index 0000000000..23f508eacd --- /dev/null +++ b/collects/2htdp/universe-request.txt @@ -0,0 +1,77 @@ +From: Robby Findler +Date: June 16, 2009 5:16:50 PM EDT +To: Matthias Felleisen +Subject: Fwd: Universe key handler request + +I was cleaning out my inbox and found this. Probably too late, but I +thought I'd still pass it on in case you'd forgotten. + +Robby + +Forwarded conversation +Subject: Universe key handler request +------------------------ + +From: Robby Findler +Date: Tue, Feb 24, 2009 at 9:22 AM +To: matthias@ccs.neu.edu + + +Can you make the key handlers in universe take 3 arguments instead of +2? That is, it takes a world, a key-event and a boolean where the key +event does not include 'release and the Boolean indicates if the key +was pressed down or not. + +Robby + +---------- +From: Matthias Felleisen +Date: Tue, Feb 24, 2009 at 9:24 AM +To: Robby Findler + + + +I guess. Why is this useful? + + +---------- +From: Matthias Felleisen +Date: Tue, Feb 24, 2009 at 9:25 AM +To: Robby Findler + + + +P.S. and how would you signal the release of a key? + + +---------- +From: Robby Findler +Date: Tue, Feb 24, 2009 at 9:29 AM +To: Matthias Felleisen + + +the Boolean! + +It is useful for multiple key presses that overlap but it is also +useful that it matches what you think when you look at a keyboard. + +Robby + + +---------- +From: Matthias Felleisen +Date: Tue, Feb 24, 2009 at 10:19 AM +To: Robby Findler + + + + +Wait. Say I press a key + +Ê*------------------------------||-------------------------------------* +Êkey-press Ê Êholding it down Êthe event handler is called with #t Ê more key presses, no release? + +when does the program find out that I have released the key? + + + diff --git a/collects/2htdp/universe-syntax-parse.ss b/collects/2htdp/universe-syntax-parse.ss new file mode 100644 index 0000000000..5e8031a701 --- /dev/null +++ b/collects/2htdp/universe-syntax-parse.ss @@ -0,0 +1,117 @@ +#lang scheme/load + +(module auxs scheme + (define (world->world> proc0) + (printf "a world to world function\n") + proc0) + + (define (positive-number> rate0) + (printf "a positive number") + rate0) + + ;; String String Syntax[id] -> Syntax + (define (pre-post-name pre post name) + (datum->syntax + name (string->symbol (string-append pre (symbol->string (syntax-e name)) post)))) + + (provide (all-defined-out))) + +(module clauses scheme + + (require syntax/parse (for-syntax scheme 'auxs unstable/syntax) + (for-template scheme/base 'auxs)) + + + (define-syntax (define-clause stx) + (syntax-case stx () + [(_ name (proc p-ctc) (rate r-ctc) ...) + (with-syntax ([name-clause (pre-post-name "" "-clause" #'name)] + [(rate0 ...) (generate-temporaries #'(rate ...))]) + (with-syntax ([((thing ...) ...) #'((#:with rate #'(r-ctc rate0)) ...)]) + #` + (begin + (provide name name-clause) + + (define-syntax (name . x) + (raise-syntax-error 'name "used out of context" x)) + + (define-syntax-class name-clause + #:description (format "~a" 'name) + #:literals (name) + #:attributes (proc rate ...) + (pattern (name proc0:expr) + #:with (rate0 ...) (map (lambda (x) #'0) '(rate0 ...)) + #:with proc #'(world->world proc0) + thing ... ...) + (pattern (on-tick proc0:expr (~var rate0 expr) ...) + #:with proc #'(world->world> proc0) + thing ... ...)) + )))])) + + (define-clause on-mouse (proc world-nat-nat-mouse->world)) + (define-clause on-tick (proc world->world) (rate (lambda (x) 1/28))) + + ;; --- on-tick --- + #| + (define-syntax (on-tick . x) + (raise-syntax-error 'on-tick "used out of context" x)) + + (define-syntax-class on-tick-clause + #:description "on tick" + #:literals (on-tick) + #:attributes (proc rate) + (pattern (on-tick proc0:expr) + #:with proc #'(world->world proc0) + #:with rate #'1/28) + (pattern (on-tick proc0:expr rate0:expr) + #:with proc #'(world->world> proc0) + #:with rate #'(positive-number> rate0))) + + (provide on-tick on-tick-clause) + |# + ;; --- on-draw --- + (define-syntax (on-draw . x) + (raise-syntax-error 'on-draw "used out of context" x)) + + (define-syntax-class on-draw-clause + #:description "on draw" + #:literals (on-draw) + #:attributes (proc width height) + (pattern (on-draw proc0:expr) + #:with proc #'(wrap worldxkey->world proc0) + #:with width #'#f + #:with height #'#f) + (pattern (on-draw proc0:expr width0:expr height0:expr) + #:with proc #'(worldxkey->world> proc0) + #:with width #'(natural-number> width0) + #:with height #'(natural-number> height0))) + + (provide on-draw on-draw-clause)) + +(module utest scheme + (require (for-syntax syntax/parse 'clauses)) + + (define-syntax (big-bang stx) + (syntax-parse stx + [(big-bang world0:expr + (~or (~optional otc:on-tick-clause) + ; (~optional omc:on-mouse-clause) + (~optional odc:on-draw-clause)) + ...) + #`(printf "~s\n" + '(bb world0 + #,(if (attribute otc) + #'otc.rate + #'1/28) + #,(if (attribute odc) + #'odc.proc + #''not-draw)))])) + + (big-bang 0) + (big-bang 1 (on-tick add1)) + (big-bang 2 (on-tick add1 1/2)) + (big-bang 3 (on-draw add1 1/2 1/3)) + (big-bang 4 (on-mouse add1 1 2)) + ) + +(require 'utest) \ No newline at end of file diff --git a/collects/2htdp/universe.ss b/collects/2htdp/universe.ss index 4e71f1a4c2..e652bee7be 100644 --- a/collects/2htdp/universe.ss +++ b/collects/2htdp/universe.ss @@ -7,8 +7,6 @@ -- take out counting; replace by 0.25 delay -- make window resizable :: why - -- what if clauses are repeated in world and/or universe descriptions? - -- what if the initial world or universe state is omitted? the error message is bad then. |# (require (for-syntax "private/syn-aux.ss" scheme/function)