this creates a repeatable cored dump in drracket

This commit is contained in:
Matthias Felleisen 2012-01-16 15:41:35 -05:00
parent ea68677d2f
commit 54c1f496e8
2 changed files with 19 additions and 6 deletions

View File

@ -22,5 +22,8 @@
(tst (= (handler 8 "right") 9))
(tst (= (handler 8 "up") 8-i))
(tst (= (handler 8 "down") 8+i))
(tst (= (handler 7 "shift") 0))
(tst (equal? (handler 6 "space") (stop-with 6)))
(tst (= (handler 9 "a") 8))
(tst (= (handler 8 "d") 9))
(tst (= (handler 8 "w") 8-i))
(tst (= (handler 8 "s") 8+i))

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)))