this creates a repeatable cored dump in drracket
This commit is contained in:
parent
ea68677d2f
commit
54c1f496e8
|
@ -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))
|
||||
|
|
|
@ -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)))
|
||||
|
|
Loading…
Reference in New Issue
Block a user