diff --git a/collects/frtime/demos/push-pull-ball.ss b/collects/frtime/demos/push-pull-ball.ss index aa6e64215d..16a87f5463 100644 --- a/collects/frtime/demos/push-pull-ball.ss +++ b/collects/frtime/demos/push-pull-ball.ss @@ -6,28 +6,26 @@ (define pos1 (rec pos (until (make-posn 200 200) - (delay-by + (inf-delay (let ([brnch (posn+ pos (posn* (normalize (posn- mouse-pos pos)) (- (posn-diff pos mouse-pos) (sub1 radius))))]) (if (> (posn-diff pos mouse-pos) radius) brnch - pos)) - 0)))) + pos)))))) (define pos2 (rec pos (until (make-posn 100 100) - (delay-by + (inf-delay (let ([brnch (posn+ pos (posn* (normalize (posn- pos1 pos)) (- (posn-diff pos pos1) (add1 (* 2 radius)))))]) (if (< (posn-diff pos pos1) (* 2 radius)) brnch - pos)) - 0)))) + pos)))))) (display-shapes (list (make-circle pos1 radius "blue") - (make-circle pos2 radius "blue"))) + (make-circle pos2 radius "gray"))) diff --git a/collects/frtime/lang-ext.ss b/collects/frtime/lang-ext.ss index adee360eac..a746b6019b 100644 --- a/collects/frtime/lang-ext.ss +++ b/collects/frtime/lang-ext.ss @@ -82,24 +82,26 @@ (define switch (opt-lambda (e [init undefined]) (let* ([init (box init)] - [e-b (hold e (unbox init))]) - (rec ret - (proc->signal:switching - (case-lambda - [() - (when (not (eq? (unbox init) (signal-value e-b))) - (unregister ret (unbox init)) - (set-box! init (value-now/no-copy e-b)) - (register ret (unbox init)) - (set-signal-producers! ret (list e-b (unbox init))) - (set-signal-depth! ret (max (signal-depth ret) - (add1 (safe-signal-depth (unbox init))))) - (iq-resort)) - (value-now/no-copy (unbox init))] - [(msg) e]) - init - e-b - e-b (unbox init)))))) + [e-b (hold e (unbox init))] + [ret (proc->signal:switching + (case-lambda [() undefined] + [(msg) e]) + init e-b e-b (unbox init))]) + (set-signal-thunk! + ret + (case-lambda + [() + (when (not (eq? (unbox init) (signal-value e-b))) + (unregister ret (unbox init)) + (set-box! init (value-now e-b)) + (register ret (unbox init)) + (set-signal-producers! ret (list e-b (unbox init))) + (set-signal-depth! ret (max (signal-depth ret) + (add1 (safe-signal-depth (unbox init))))) + (iq-resort)) + (value-now/no-copy (unbox init))] + [(msg) e])) + ret))) ; event ... -> event (define (merge-e . args)