clean up from svn
This commit is contained in:
parent
72431fda2d
commit
77bff11a14
77
collects/2htdp/universe-request.txt
Normal file
77
collects/2htdp/universe-request.txt
Normal file
|
@ -0,0 +1,77 @@
|
||||||
|
From: Robby Findler <robby@eecs.northwestern.edu>
|
||||||
|
Date: June 16, 2009 5:16:50 PM EDT
|
||||||
|
To: Matthias Felleisen <matthias@ccs.neu.edu>
|
||||||
|
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 <robby@eecs.northwestern.edu>
|
||||||
|
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 <matthias@ccs.neu.edu>
|
||||||
|
Date: Tue, Feb 24, 2009 at 9:24 AM
|
||||||
|
To: Robby Findler <robby@eecs.northwestern.edu>
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
I guess. Why is this useful?
|
||||||
|
|
||||||
|
|
||||||
|
----------
|
||||||
|
From: Matthias Felleisen <matthias@ccs.neu.edu>
|
||||||
|
Date: Tue, Feb 24, 2009 at 9:25 AM
|
||||||
|
To: Robby Findler <robby@eecs.northwestern.edu>
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
P.S. and how would you signal the release of a key?
|
||||||
|
|
||||||
|
|
||||||
|
----------
|
||||||
|
From: Robby Findler <robby@eecs.northwestern.edu>
|
||||||
|
Date: Tue, Feb 24, 2009 at 9:29 AM
|
||||||
|
To: Matthias Felleisen <matthias@ccs.neu.edu>
|
||||||
|
|
||||||
|
|
||||||
|
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 <matthias@ccs.neu.edu>
|
||||||
|
Date: Tue, Feb 24, 2009 at 10:19 AM
|
||||||
|
To: Robby Findler <robby@eecs.northwestern.edu>
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
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?
|
||||||
|
|
||||||
|
|
||||||
|
|
117
collects/2htdp/universe-syntax-parse.ss
Normal file
117
collects/2htdp/universe-syntax-parse.ss
Normal file
|
@ -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)
|
|
@ -7,8 +7,6 @@
|
||||||
-- take out counting; replace by 0.25 delay
|
-- take out counting; replace by 0.25 delay
|
||||||
|
|
||||||
-- make window resizable :: why
|
-- 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)
|
(require (for-syntax "private/syn-aux.ss" scheme/function)
|
||||||
|
|
Loading…
Reference in New Issue
Block a user