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

this creates a repeatable cored dump in drracket

Browse Source 
commit restricted to collects/2htdp/universe.rkt
(cherry-picked from commit 54c1f496e8)
This commit is contained in:
Ryan Culpepper 2012-01-16 18:15:57 -07:00
parent f7340ead45
commit 10c271e27e
1 changed files with 14 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
collects/2htdp/universe.rkt
View File

@ -266,7 +266,8 @@
[down DEFAULT #'(lambda (x) x) (function-with-arity 1)]
[left DEFAULT #'(lambda (x) x) (function-with-arity 1)]
[right DEFAULT #'(lambda (x) x) (function-with-arity 1)]
[space DEFAULT #'(lambda (x) x) (function-with-arity 1)]
; [space DEFAULT #'(lambda (x) x) (function-with-arity 1)]
#;
[shift DEFAULT #'(lambda (x) x) (function-with-arity 1)])
(define-syntax (pad-handler stx)
@ -279,12 +280,21 @@
[doms (map (lambda (x) (car (syntax->list x))) (syntax->list #'(clause ...)))])
(syntax-property
(stepper-syntax-property
#`(let ((quasi-object (make-immutable-hash (map cons '#,keys (list #,@args)))))
(lambda (world key-event)
((hash-ref quasi-object key-event) world)))
#`(produce-handler '#,keys (list #,@args))
'stepper-skip-completely #t)
'disappeared-use doms))]))
;; let ((quasi-object ))
;;
;; (define-higher-order-primitive the-handler the-handler* (world key-event))
;; the-handler
(define (produce-handler keys args)
(define quasi-object (make-immutable-hash (map cons keys args)))
(define (the-handler* world key-event)
((hash-ref quasi-object key-event (lambda (w) w)) world))
the-handler*)
(define (run-simulation f)
(check-proc 'run-simulation f 1 "first" "one argument")
(big-bang 0 (on-draw f) (on-tick add1)))