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

under 3m, letrec doesn't seem to work the way I want for signal structures, so

Browse Source 
I've switched to manual set!

also, cleaned up the push-pull-ball demo

svn: r4803
This commit is contained in:
Greg Cooper 2006-11-07 22:14:40 +00:00
parent 4ef5d8acd5
commit f89d241e6b
2 changed files with 25 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
collects/frtime/demos/push-pull-ball.ss
View File

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

38
collects/frtime/lang-ext.ss
View File

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