;; OSC reciever (for both client and server)
(define topclock-receive
(let ((oldbpm (*metro* 'get-tempo))
(oldcycle 4)
(broadcast *topclock-broadcast*))
(lambda (timestamp address srcip srcport . args)
(cond ((string=? address "/clock/master/q")
;; if current master send reponse
;; srcport need not be same as *topclock-port*
(if *topclock-master*
(io:osc:send (now) (cons srcip srcport) "/clock/master/r")))
((string=? address "/clock/master/r")
;; if we get a message it must be from master
;; so we can set the *mastersip* to whatever the srcip is
(set! *mastersip* srcip)) ;; master port must be *topclock-port*
((string=? address "/clock/election/q")
;; someone has asked for an election!
;; if we have a higher election-val OR we are allready the master
;; then send a message back, otherwise don't!
(let ((election-val (car args)))
(if (or *topclock-master*
(> *topclock-election-val* election-val))
(io:osc:send (now) (cons srcip srcport) "/clock/election/r"))))
((string=? address "/clock/election/r")
;; if we receive an election reply
;; then we are definitely NOT the master
;; also don't try for re-election again
;; for AT LEAST 5 seconds!
(set! *topclock-lastmsg* (+ 5. (clock:clock)))
(set! *topclock-election-winner* #f))
((string=? address "/clock/sync/q")
;; if someone asks for a clocksync (from any IP and any PORT)
;; and we are the master then send a reply
;; first arg is t1 (from client) we add t2 to reply
(if *topclock-master*
(osc_send_two_double srcip 5555 "/clock/sync/r" (car args) (1970->1900 (clock:clock)))))
((string=? address "/clock/sync/r")
;; clock syncs come from current master
(let* ((t1 (1900->1970 (car args)))
(t2 (1900->1970 (cadr args))) ;; t2
(t3 (1900->1970 (cadr args))) ;; and t3 the same
(t4 (clock:clock))
(msg-delay (- t4 t1))
(offset (/ (+ (- t2 t1) (- t3 t4)) 2.0)))
(if (and (< (abs msg-delay) .01) (not *topclock-master*))
(clock:adjust-offset offset))))
((string=? address "/clock/bpm/set")
;; bpm changes are sent to master only (i.e. not broadcast)
;; to ensure that we don't have the problem where some
;; clients GET the message but the master DOESN'T!
(if *topclock-master*
(let ((time (1900->1970 (car args)))
(bpm (cadr args))
(beat-n (caddr args))
(beat-d (cadddr args))
(cycle (car (cddddr args))))
(set! oldbpm bpm)
(set! oldcycle cycle)
(*metro* 'set-cycle cycle (/ beat-n beat-d))
(*metro* 'set-tempo bpm (clock->samples time) (/ beat-n beat-d))
;; broadcast new bpm details as bpm/update
(io:osc:send (now) *topclock-broadcast* "/clock/bpm/update"
(1970->1900 time) bpm beat-n beat-d cycle))))
((string=? address "/clock/bpm/update")
;; bpm/update is same as bpm/set but is a broadcast
;; call from the master
;; (i.e. we don't care so much if this UDP packet gets lost
(let ((time (1900->1970 (car args)))
(bpm (cadr args))
(beat-n (caddr args))
(beat-d (cadddr args))
(cycle (car (cddddr args))))
(if (and (not *topclock-master*) (or (<> bpm oldbpm) (<> oldcycle cycle)))
(begin
(set! oldbpm bpm)
(set! oldcycle cycle)
(*metro* 'set-cycle cycle (/ beat-n beat-d))
(*metro* 'set-tempo bpm (clock->samples time) (/ beat-n beat-d))))))
((string=? address "/clock/bpm/q")
;; ask what the current bpm is
;; when it was set
;; and what the running beat total was when set
(let* ((mark (*metro* 'get-mark))
(time (1970->1900 (samples->clock (car mark))))
(bpm (*metro* 'get-tempo))
(cycle (*metro* 'get-cycle))
(total-beats (cdr mark)))
(io:osc:send (now) (cons srcip srcport) "/clock/bpm/update"
time bpm (rational->n total-beats) (rational->d total-beats) cycle)))
((string=? address "/clock/variable/set")
(if *topclock-master*
(let ((time (1900->1970 (car args)))
(variable (cadr args))
(beat-n (caddr args))
(beat-d (cadddr args))
(data (cddddr args)))
(callback (*metro* (/ beat-n beat-d))
(lambda ()
(eval `(define
,(string->symbol variable)
,(if (= (length data) 1)
(car data)
`(list ,@data)))
(interaction-environment)))))))
((string=? address "/clock/variable/update")
(if (not *topclock-master*)
(let ((time (1900->1970 (car args)))
(variable (cadr args))
(beat-n (caddr args))
(beat-d (cadddr args))
(data (cddddr args)))
(callback (*metro* (/ beat-n beat-d))
(lambda ()
(eval `(define
,(string->symbol variable)
,(if (= (length data) 1)
(car data)
`(list ,@data)))
(interaction-environment)))))))
((string=? address "/clock/variable/q")
(let* ((mark (*metro* 'get-mark))
(time (1970->1900 (samples->clock (car mark))))
(variable (string->symbol (car args)))
(total-beats (cdr mark))
(data (or (defined? variable)
(eval variable))))
(apply io:osc:send (now) (cons srcip srcport) "/clock/variable/set"
time variable (rational->n total-beats) (rational->d total-beats)
data)))
((string=? address "/clock/stream")
;; stream sends out at a rate of 1/16 the current tempo
;; bpmt is the time that the bpm change occured
(let ((time (1900->1970 (car args)))
(bpm (cadr args))
(beat-n (caddr args))
(beat-d (cadddr args))
(cycle (car (cddddr args))))
(if *topclock-print-stream* (println 'clock 'stream: srcip time bpm (/ beat-n beat-d) cycle))
;; update masterip and lastmsg time
(set! *topclock-master-ip* srcip)
(if (not (string=? *topclock-master-ip* *topclock-old-master-ip*))
(begin
(print "There's a ")
(print-with-colors 'magenta 'default #f
(print "new topclock"))
(print " in town at ")
(print-with-colors 'blue 'default #f
(print srcip "\n"))
(set! *topclock-master* #f)
(set! *topclock-old-master-ip* *topclock-master-ip*)))
(set! *topclock-lastmsg* (clock:clock))
;; check for bpm updates (redundancy for missed bpm/update events)
(if (and (not *topclock-master*) (or (<> bpm oldbpm) (<> cycle oldcycle)))
(io:osc:send (now) (cons *topclock-master-ip* *topclock-port*) "/clock/bpm/q"))))
(else (println 'bad 'osc 'message: address))))))