;;; -*- syntax: common-lisp; base: 10; mode: lisp -*- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; File: convolve.ins ;;; ;;; Purpose: Convolution of one sound file by another for ;;; cross-synthesis/morphing purposes. ;;; ;;; Author: Michael Edwards - m@michael-edwards.org ;;; ;;; $$ Last modified: 14:34:49 Wed Mar 27 2013 GMT ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (in-package :clm) ;;; Bill has now incorporated my constant power panning routine into the CLM ;;; distribution but we'll still need to load it, so change path as required: (load "/lisp/clm-4/panning.lsp") (defun get-start-and-end-times (file start end) (let ((snd-dur (sound-duration file))) (when (> start end) (error "Start time > end time? Start = ~a, End = ~a" start end)) (when (< start 0) (error "Start time < 0? Start = ~a" start)) (when (> end snd-dur) (error "End > file duration? End = ~a, Duration of file ~a = ~a secs." end file snd-dur)) (list start (if (zerop end) snd-dur end)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (definstrument convins (file1 file2 time &key (duration 0) (start1 0) (end1 0) (start2 0) (end2 0) (amp 1.0) (amp-env '(0 1 100 1)) ;; MDE Wed Mar 27 11:26:11 2013 -- prescaler no longer exists for ;; open-input so can't prescale the filter file. But using amp to ;; scale should do us just as well. ;; (file2-amp 1.0) (degree 45) (rev-amt 0) (fft-size 128) (printing t)) (let* ((st (floor (* time *srate*))) (start-end1 (get-start-and-end-times file1 start1 end1)) (start-end2 (get-start-and-end-times file2 start2 end2)) (start-sample1 (floor (* *srate* (first start-end1)))) (start-sample2 (floor (* *srate* (first start-end2)))) (stereo-file1 (= 2 (sound-chans file1))) (stereo-file2 (= 2 (sound-chans file2))) (stereo-out (= 2 (mus-channels *output*))) (stereo-reverb (and *reverb* (= 2 (mus-channels *reverb*)))) (f1L (open-input file1 :start start-sample1)) (f1R (when stereo-file1 (open-input file1 :start start-sample1 :channel 1))) (f2L (open-input file2 :start start-sample2)) (f2R (when stereo-file1 (open-input file2 :start start-sample2 :channel (if stereo-file2 1 0)))) (file1-available-dur (- (second start-end1) (first start-end1))) (dur (cond ((zerop duration) file1-available-dur) ((<= duration file1-available-dur) duration) (t (warn "Requested duration longer than available ~ duration (using latter): ~a ~a" duration file1-available-dur) file1-available-dur))) (ampf (make-env :envelope amp-env :scaler amp :duration dur)) ;; get-cpp-scalers comes from panning.lsp in the clm distribution. (cpp-scalers (get-cpp-scalers degree)) (scalerA (first cpp-scalers)) (scalerB (second cpp-scalers)) (filter-size (- (floor (* *srate* (second start-end2))) start-sample2)) (convA (make-convolve :input f1L :filter f2L :fft-size fft-size :filter-size filter-size)) (convB (when stereo-file1 (make-convolve :input f1R :filter f2R :fft-size fft-size :filter-size filter-size))) (count 0) (sampA 0.0) (sampB 0.0) (amp-val 0.0) (nd (+ st (floor (* *srate* dur))))) (when printing (format t "~&Start time ~a~%" time)) (run (loop for i from st to nd do (when (= count *srate*) (setf count 0) (print (round (/ i *srate*)))) (incf count) (setf amp-val (env ampf) sampA (* amp-val (convolve convA)) sampB (if stereo-file1 (* amp-val (convolve convB)) sampA)) ;; use the constant power panning scalers only with mono input (when (and stereo-out (not stereo-file1)) (setf sampA (* sampA scalerA) sampB (* sampB scalerB))) ;; stereo input but mono output (when (and stereo-file1 (not stereo-out)) (setf sampA (/ (+ sampA sampB) 2.0))) (outa i sampA) (when *reverb* (outa i (* rev-amt sampA) *reverb*)) (when stereo-out (outb i sampB) (when stereo-reverb (outb i (* rev-amt sampB) *reverb*))))) (close-input f1L) (close-input f2L) (when stereo-file1 (close-input f1R) (close-input f2R)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; #| (with-sound (:statistics t :scaled-to .99) (convins "/snd/samples/slippery/clarinet/bass/bass-fs3-g4-cresc.wav" "/snd/samples/slippery/perc/tam-tam-brushes-roll-mp.wav" 0 :printing nil :amp .1 :duration 20)) |# ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; EOF convolve.ins