[CM] multiuser audio editing environment

[Bill Schottstaedt]

You can have the same sound open multiple times either in one Snd, or
multiple Snds; so if the net access was set up, you could have people
on different machines working on the same sound. Their edit sequences 
won't collide until someone saves his edits, changing the underlying
sound; then all the others get the exploding bomb icon -- each could
have the update-hook set up to grab their current edits via edit-list->function,
update to the new version of the sound, then reapply the saved edits, but
whether that is a sensible thing to do depends on the edits. 

I was about to write such an update-hook function, but got interested
in snddiff instead -- a first very simple-minded version:


(define (cross-correlate snd0 chn0 snd1 chn1)
  (let* ((len0 (frames snd0 chn0))
	 (len1 (frames snd1 chn1))
	 (ilen (max len0 len1))
	 (pow2 (inexact->exact (ceiling (/ (log ilen) (log 2)))))
	 (fftlen (inexact->exact (expt 2 pow2)))
	 (fftlen2 (/ fftlen 2))
	 (fftscale (/ 1.0 fftlen))
	 (rl1 (channel->vct 0 fftlen snd1 chn1))
	 (rl2 (channel->vct 0 fftlen snd0 chn0))
	 (im1 (make-vct fftlen))
	 (im2 (make-vct fftlen)))
    (fft rl1 im1 1)
    (fft rl2 im2 1)
    (let* ((tmprl (vct-copy rl1))
	   (tmpim (vct-copy im1))
	   (data3 (make-vct fftlen)))
      (vct-multiply! tmprl rl2)     ; (* tempr1 tempr2)
      (vct-multiply! tmpim im2)     ; (* tempi1 tempi2)
      (vct-multiply! im2 rl1)       ; (* tempr1 tempi2)
      (vct-multiply! rl2 im1)       ; (* tempr2 tempi1)
      (vct-add! tmprl tmpim)        ; add the first two
      (vct-subtract! im2 rl2)       ; subtract the 4th from the 3rd
      (vct-scale! (fft tmprl im2 -1) fftscale))))

(define (lag? snd0 chn0 snd1 chn1)
  ;; returns the probable lagtime between the two sounds (negative time means second sound is 
delayed)
  (let* ((corr (cross-correlate snd0 chn0 snd1 chn1))
	 (len (vct-length corr))
	 (pk (- (vct-peak corr) .000001))
	 (pos -1)
	 (lag (do ((i 0 (1+ i)))
		  ((or (= i len)
		       (>= pos 0))
		   pos)
		(if (>= (vct-ref corr i) pk)
		    (set! pos i)))))
    (if (= lag -1)
	0
	(if (< lag (/ len 2))
	    lag
	    (- (- len lag))))))

(define (snddiff snd0 chn0 snd1 chn1)
  ;; this can currently find initial delays, scaling differences, and scattered individual sample 
differences
  (let ((lag (lag? snd0 chn0 snd1 chn1)))
    (if (> lag 0)
	(pad-channel 0 lag snd1 chn1)
	(if (< lag 0)
	    (pad-channel 0 (- lag) snd0 chn0)))

    (let ((s0 (channel->vct 0 #f snd0 chn0))
	  (s1 (channel->vct 0 #f snd1 chn1)))
      (if (= (vct-peak (vct-subtract! s0 s1)) 0.0)
	  (if (= lag 0)                                      ; trailing zeros?
	      "no difference"
	      (format #f "no difference except ~A is delayed ~A samples" (if (> lag 0) "first" "second") (abs 
lag)))

	  (let* ((pos (maxamp-position snd0 chn0))
		 (mx0 (sample pos snd0 chn0))
		 (mx1 (sample pos snd1 chn1)) ; use actual values to keep possible sign difference
		 (scl (/ mx1 mx0)))
	    (scale-channel scl 0 #f snd0 chn0)
	    (set! s0 (channel->vct 0 #f snd0 chn0))
	    (if (< (vct-peak (vct-subtract! s0 s1)) 0.0001)
		(if (= lag 0)
		    (format #f "second is ~A * first" scl)
		    (format #f "~A is delayed ~A samples and multiplied by ~A" 
			    (if (> lag 0) "first" "second") 
			    (abs lag)
			    (if (> lag 0) (/ 1.0 scl) scl)))
		(begin
		  (if (not (= scl 1.0)) (undo 1 snd0 chn0))
		  (set! s0 (channel->vct 0 #f snd0 chn0))
		  (let ((diffs 0)
			(diff-data '())
			(len (min (vct-length s0) (vct-length s1))))
		    (do ((i 0 (1+ i)))
			((or (> diffs 10)
			     (= i len)))
		      (if (> (abs (- (vct-ref s0 i) (vct-ref s1 i))) .00001)
			  (begin
			    (set! diffs (1+ diffs))
			    (set! diff-data (cons (list i (vct-ref s0 i) (vct-ref s1 i)) diff-data)))))
		    (if (< diffs 10)
			(format #f "different sample~A: ~A" (if (= diffs 1) "" "s") (reverse diff-data))
			(begin
			  "giving up"))))))))))