You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 
 
 
 

141 lines
5.2 KiB

;nyquist plug-in
;version 1
;type process
;preview enabled
;categories "http://audacityteam.org/namespace#NoiseRemoval"
;name "Clip Fix..."
;action "Reconstructing clips..."
;author "Benjamin Schwartz"
;copyright "Licensing confirmed under terms of the GNU General Public License version 2"
;; clipfix.ny by Benjamin Schwartz.
;; Licensing confirmed under terms of the GNU General Public License version 2:
;; http://www.gnu.org/licenses/old-licenses/gpl-2.0.html
;; with kind agreement of Benjamin Schwartz, December 2011.
;; GUI updated by Steve Daulton July 2012
;;
;; For information about writing and modifying Nyquist plug-ins:
;; http://wiki.audacityteam.org/wiki/Nyquist_Plug-ins_Reference
;control thresh "Threshold of Clipping (%)" real "" 95 0 100
(setf largenumber 100000000) ;;Largest number of samples that can be imported
(setf blocksize 100000)
;;Clip Fix is a simple, stupid (but not blind) digital-clipping-corrector
;;The algorithm is fairly simple:
;;1. Find all clipped regions
;;2. Get the slope immediately on either side of the region
;;3. Do a cubic spline interpolation.
;;4. Go to next region
;;Coded from start (didn't know lisp (well, scheme, but not not lisp and certainly not
;;some XLISP 2.0 derivative)) to finish
;;(fully working, more or less) in one afternoon (and some evening).
;;Written by Benjamin Schwartz, MIT class of 2006, on May 25, 2004.
;;Explanatory text added by Gale Andrews, May 2008.
(defun declip (sin) ;;Central function
(let* ((threshold (* (peak sin largenumber) thresh 0.01))
(s2 (snd-copy sin))
(samplerate (snd-srate s2))
(s2length (snd-length s2 largenumber)))
(seqrep (i (1+ (/ s2length blocksize)))
(let ((l (min blocksize (- s2length (* i blocksize)))))
;;(print (list i t0 l samplerate))
(snd-from-array 0 samplerate
(workhorse
;;(let () (print (list s2 (type-of s2) l (type-of l)))
(snd-fetch-array s2 l l)
;;)
threshold))))
;;(setf r (snd-fetch-array (snd-copy s) (snd-length s largenumber) 1)) ;;Create a sound array
;;(snd-from-array (snd-t0 s) (snd-srate s) (workhorse r threshold))
))
(defun workhorse (r threshold)
(setf n (length r)) ;; Record its length
(setf exithigh ()) ;;Times when the wavefrom left the allowed region
(setf returnhigh ()) ;;Times when it returned to the allowed region
(setf drange 4)
(let ((i drange) (max (- n drange))) ;;Leave room at ends for derivative processing
(while (< i max)
(if (>= (aref r i) threshold)
(if (< (aref r (- i 1)) threshold)
(setq exithigh (cons (- i 1) exithigh))) ;;We just crossed the threshold up
(if (>= (aref r (- i 1)) threshold)
(setq returnhigh (cons i returnhigh)))) ;;We just crossed the threshold down
(setq i (1+ i))))
(setq exithigh (reverse exithigh)) ;;List comes out backwards
(setq returnhigh (reverse returnhigh))
(if (>= (aref r (1- drange)) threshold) ;;If the audio begins in a clipped region, ignore
(setq returnhigh (cdr returnhigh))) ;the extra return from threshold
(setf exitlow ()) ;; Same as above, but for the bottom threshold
(setf returnlow ())
(setf threshlow (* -1 threshold)) ;;Assumes your digital range is zero-centered
(let ((i drange) (max (- n drange)))
(while (< i max)
(if (<= (aref r i) threshlow)
(if (> (aref r (- i 1)) threshlow)
(setq exitlow (cons (- i 1) exitlow)))
(if (<= (aref r (- i 1)) threshlow)
(setq returnlow (cons i returnlow))))
(setq i (1+ i))))
(setq exitlow (reverse exitlow))
(setq returnlow (reverse returnlow))
(if (<= (aref r (1- drange)) threshlow)
(setq returnlow (cdr returnlow)))
(while (and exithigh returnhigh) ;;If there are more clipped regions
(let* ((t1 (car exithigh)) ;;exit time
(t2 (car returnhigh)) ;;return time
(d1 (max 0 (/ (- (aref r t1) (aref r (- t1 (1- drange)))) (1- drange)))) ;;slope at exit
(d2 (min 0 (/ (- (aref r (+ t2 (1- drange))) (aref r t2)) (1- drange)))) ;;slope at return
(m (/ (+ d2 d1) (* (- t2 t1) (- t2 t1)))) ;;interpolation is by (t-t1)(t-t2)(mx+b)
(b (- (/ d2 (- t2 t1)) (* m t2))) ;;These values of m and b make the cubic seamless
(j (1+ t1))) ;; j is the index
(while (< j t2)
(setf (aref r j) (+ (aref r t1) (* (- j t1) (- j t2) (+ (* m j) b))))
(setf (aref r j) (+ (* (- t2 j) (/ (aref r t1) (- t2 t1))) (* (- j t1) (/ (aref r t2) (- t2 t1))) (* (- j t1) (- j t2) (+ (* m j) b))))
(setq j (1+ j))))
(setq exithigh (cdr exithigh))
(setq returnhigh (cdr returnhigh)))
(while (and exitlow returnlow) ;;Same for bottom
(let* ((t1 (car exitlow))
(t2 (car returnlow))
(d1 (min 0 (/ (- (aref r t1) (aref r (- t1 (1- drange)))) (1- drange)))) ;;slope at exit
(d2 (max 0 (/ (- (aref r (+ t2 (1- drange))) (aref r t2)) (1- drange)))) ;;slope at return
(m (/ (+ d2 d1) (* (- t2 t1) (- t2 t1))))
(b (- (/ d2 (- t2 t1)) (* m t2)))
(a (/ (+ (aref r t1) (aref r t2)) 2))
(j (1+ t1)))
(while (< j t2)
(setf (aref r j) (+ (* (- t2 j) (/ (aref r t1) (- t2 t1))) (* (- j t1) (/ (aref r t2) (- t2 t1))) (* (- j t1) (- j t2) (+ (* m j) b))))
(setq j (1+ j))))
(setq exitlow (cdr exitlow))
(setq returnlow (cdr returnlow)))
r)
(if (arrayp s)
(dotimes (j (length s))
(setf (aref s j) (declip (aref s j))))
(setq s (declip s)))
s