;nyquist plug-in
;version 1
;type process
;preview enabled
;categories "http://audacityteam.org/namespace#NoiseRemoval"
;name "Clip Fix..."
;action "Reconstructing clips..."
;; 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 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.
(setf drange 4)
(defun declip-one (r high t1 t2)
(let* ((delta (- t2 t1))
(r1 (aref r t1))
(r2 (aref r t2))
(mean-slope (/ (- r2 r1) delta))
(raw-exit-slope (/ (- r1 (aref r (- t1 (1- drange)))) (1- drange)))
;slope at exit
(raw-return-slope (/ (- (aref r (+ t2 (1- drange))) r2) (1- drange)))
;slope at return
(exit-slope (if high (max 0 raw-exit-slope) (min 0 raw-exit-slope)))
(return-slope (if high (min 0 raw-return-slope) (max 0 raw-return-slope)))
(d1 (- exit-slope mean-slope))
(d2 (- return-slope mean-slope))
(m (/ (+ d2 d1) (* delta delta)))
(b (- (/ d2 delta) (* m delta))))
(do ((j 1 (1+ j)))
((= j delta))
;; evaluate the cubic that equals r1 when j = 0 and r2 at delta
;; and has slope exit-slope at 0 and slope return-slope at delta
(setf (aref r (+ t1 j))
(+ r1
(* j mean-slope)
(* j (- j delta) (+ (* m j) b)))))))
(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
(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
(declip-one r t (pop exithigh) (pop returnhigh)))
(while (and exitlow returnlow) ;;Same for bottom
(declip-one r nil (pop exitlow) (pop returnlow)))
r)
(defun declip (sin) ;;Central function
(let* ((threshold (* (peak sin ny:all) thresh 0.01))
(s2 (snd-copy sin))
(samplerate (snd-srate s2))
(s2length (snd-length s2 ny:all)))
(seqrep (i (1+ (/ s2length blocksize)))
(let ((l (min blocksize (- s2length (* i blocksize)))))
(snd-from-array 0 samplerate
(workhorse
(snd-fetch-array s2 l l)
threshold))))))
(multichan-expand #'declip s)