New upstream version 16.8

1 files changed, 37 insertions, 41 deletions

diff --git a/extensions.scm b/extensions.scm
index b78b379..ac262b7 100644
--- a/extensions.scm
+++ b/extensions.scm
@@ -57,11 +57,9 @@ two sounds open (indices 0 and 1 for example), and the second has two channels,
 	(let ((new-maxamp (maxamp snd chn)))
 	  (if (= original-maxamp new-maxamp)
 	      1.0
-	      (let ((scaler (/ original-maxamp new-maxamp))
-		    (old-sync (sync snd)))
-		(set! (sync snd) (+ (sync-max) 1))
-		(scale-by scaler snd chn)
-		(set! (sync snd) old-sync)
+	      (let ((scaler (/ original-maxamp new-maxamp)))
+		(let-temporarily (((sync snd) (+ (sync-max) 1)))
+		  (scale-by scaler snd chn))
 		scaler)))))))
 
 
@@ -420,10 +418,10 @@ connects them with 'func', and applies the result as an amplitude envelope to th
     (lambda* (off (beg 0) dur snd)
       (let ((index (or snd (selected-sound) (car (sounds)))))
 	(if (sound? index)
-	    (let ((out-chans (channels index)))
-	      (do ((chn 0 (+ 1 chn)))
-		  ((= chn out-chans))
-		(offset-channel off beg dur index chn)))
+	    (do ((out-chans (channels index))
+		 (chn 0 (+ 1 chn)))
+		((= chn out-chans))
+	      (offset-channel off beg dur index chn))
 	    (error 'no-such-sound "offset-sound: no such sound: ~A" snd))))))
 
 
@@ -434,10 +432,10 @@ connects them with 'func', and applies the result as an amplitude envelope to th
     (lambda* (beg dur snd) 
       (let ((index (or snd (selected-sound) (car (sounds)))))
 	(if (sound? index)
-	    (let ((out-chans (channels index)))
-	      (do ((chn 0 (+ 1 chn)))
-		  ((= chn out-chans))
-		(pad-channel beg dur index chn)))
+	    (do ((out-chans (channels index))
+		 (chn 0 (+ 1 chn)))
+		((= chn out-chans))
+	      (pad-channel beg dur index chn))
 	    (error 'no-such-sound "pad-sound: no such sound: ~A" snd))))))
 
 
@@ -447,24 +445,23 @@ connects them with 'func', and applies the result as an amplitude envelope to th
   (let ((documentation "(dither-channel (amount .00006) (beg 0) dur snd chn edpos) adds amount dither to each sample"))
     (lambda* ((amount .00006) (beg 0) dur snd chn edpos)
       (let ((len (if (number? dur) dur (- (framples snd chn) beg))))
-	(let ((dither (* .5 amount))
-	      (data (samples beg len snd chn edpos)))
-	  (do ((i 0 (+ i 1)))
-	      ((= i len))
-	    (float-vector-set! data i (+ (float-vector-ref data i) (mus-random dither) (mus-random dither))))
-	  (float-vector->channel data beg len snd chn current-edit-position
-				 (format #f "dither-channel ~,8F ~A ~A" amount beg dur)))))))
-
+	(do ((dither (* .5 amount))
+	     (data (samples beg len snd chn edpos))
+	     (i 0 (+ i 1)))
+	    ((= i len)
+	     (float-vector->channel data beg len snd chn current-edit-position
+				    (format #f "dither-channel ~,8F ~A ~A" amount beg dur)))
+	  (float-vector-set! data i (+ (float-vector-ref data i) (mus-random dither) (mus-random dither))))))))
 
 (define dither-sound 
   (let ((documentation "(dither-sound (amount .00006) beg dur snd) adds dithering to every channel of 'snd'"))
     (lambda* ((amount .00006) (beg 0) dur snd)
       (let ((index (or snd (selected-sound) (car (sounds)))))
 	(if (sound? index)
-	    (let ((out-chans (channels index)))
-	      (do ((chn 0 (+ 1 chn)))
-		  ((= chn out-chans))
-		(dither-channel amount beg dur index chn)))
+	    (do ((out-chans (channels index))
+		 (chn 0 (+ 1 chn)))
+		((= chn out-chans))
+	      (dither-channel amount beg dur index chn))
 	    (error 'no-such-sound "dither-sound: no such sound: ~A" snd))))))
 
 
@@ -473,24 +470,23 @@ connects them with 'func', and applies the result as an amplitude envelope to th
 (define contrast-channel 
   (let ((documentation "(contrast-channel index (beg 0) dur snd chn edpos) applies contrast enhancement to the sound"))
     (lambda* (index (beg 0) dur snd chn edpos)
-      (let* ((len (if (number? dur) dur (- (framples snd chn) beg)))
-	     (data (samples beg len snd chn edpos)))
-	(do ((i 0 (+ i 1)))
-	    ((= i len))
-	  (float-vector-set! data i (contrast-enhancement (float-vector-ref data i) index))) ; (sin (+ (* 0.5 pi y) (* index (sin (* 2.0 pi y))))))))
-	(float-vector->channel data beg len snd chn current-edit-position
-			       (format #f "contrast-channel ~A ~A ~A" index beg dur))))))
-
+      (let ((len (if (number? dur) dur (- (framples snd chn) beg))))
+	(do ((data (samples beg len snd chn edpos))
+	     (i 0 (+ i 1)))
+	    ((= i len)
+	     (float-vector->channel data beg len snd chn current-edit-position
+				    (format #f "contrast-channel ~A ~A ~A" index beg dur)))
+	  (float-vector-set! data i (contrast-enhancement (float-vector-ref data i) index))))))) ; (sin (+ (* 0.5 pi y) (* index (sin (* 2.0 pi y))))))))
 
 (define contrast-sound 
   (let ((documentation "(contrast-sound index beg dur snd) applies contrast-enhancement to every channel of 'snd'"))
     (lambda* (index (beg 0) dur snd)
       (let ((ind (or snd (selected-sound) (car (sounds)))))
 	(if (sound? ind)
-	    (let ((out-chans (channels ind)))
-	      (do ((chn 0 (+ 1 chn)))
-		  ((= chn out-chans))
-		(contrast-channel index beg dur ind chn)))
+	    (do ((out-chans (channels ind))
+		 (chn 0 (+ 1 chn)))
+		((= chn out-chans))
+	      (contrast-channel index beg dur ind chn))
 	    (error 'no-such-sound "contrast-sound: no such sound: ~A" snd))))))
 
 
@@ -503,10 +499,10 @@ connects them with 'func', and applies the result as an amplitude envelope to th
       ;; (map-sound (lambda (fr) (frame* fr scl)) beg dur snd))
       (let ((index (or snd (selected-sound) (car (sounds)))))
 	(if (sound? index)
-	    (let ((out-chans (channels index)))
-	      (do ((chn 0 (+ 1 chn)))
-		  ((= chn out-chans))
-		(scale-channel scl beg dur index chn)))
+	    (do ((out-chans (channels index))
+		 (chn 0 (+ 1 chn)))
+		((= chn out-chans))
+	      (scale-channel scl beg dur index chn))
 	    (error 'no-such-sound "scale-sound: no such sound: ~A" snd))))))