;;; -*- Mode: LISP; Syntax: Common-lisp -*-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Copyright (c) 92, 93, 94 Fernando Lopez Lezcano.  All rights reserved.
;;; Use and copying of this software and preparation of derivative works
;;; based upon this software are permitted and may be copied as long as 
;;; no fees or compensation are charged for use, copying, or accessing
;;; this software and all copies of this software include this copyright
;;; notice.  Suggestions, comments and bug reports are welcome.  Please 
;;; address email to: nando@ccrma.stanford.edu
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;
;;; Cut and Paste instrument
;;;

;;;
;;; Parameters
;;;

(defparameter cut-soundfile nil)
(defparameter cut-sound-start 0.0)
(defparameter cut-sound-end 1.0)
(defparameter cut-sound-start-time nil)
(defparameter cut-sound-end-time nil)
(defparameter cut-segment nil)
(defparameter cut-segment-slice nil)
(defparameter cut-duration nil)
(defparameter cut-sample-rate 1.0)
(defparameter cut-sample-rate-dev 1.0)
(defparameter cut-srt-func '(0 0 100 1))
(defparameter cut-amp-func '(0 0 5 1 95 1 100 0))
(defparameter cut-vib-osc-freq 6.0)
(defparameter cut-vib-osc-freq-dev 3.0)
(defparameter cut-vib-osc-amp 0.1)
(defparameter cut-vib-noi-freq 15)
(defparameter cut-vib-noi-amp 0.1)
(defparameter cut-vib-osc-amp-func '(0 0 50 0.2 100 1))
(defparameter cut-vib-noi-amp-func '(0 0.2 50 1 100 0))
(defparameter cut-vib-osc-freq-func '(0 1 50 2.0 100 0.8))
(defparameter cut-filter-q 0.707)
(defparameter cut-filter-freq nil)
(defparameter cut-reverb-amount 0.015)
(defparameter cut-degree 45)
(defparameter cut-distance 1.0)

;;;
;;; one-cut instrument
;;;

(definstrument one-cut
    (start-time amp
       &key
       (soundfile cut-soundfile)
       (sound-start cut-sound-start)
       (sound-end cut-sound-end)
       (sound-start-time cut-sound-start-time)
       (sound-end-time cut-sound-end-time)
       (segment cut-segment)
       (segment-slice cut-segment-slice)
       (duration cut-duration)
       (sample-rate cut-sample-rate)
       (sample-rate-dev cut-sample-rate-dev)
       (srt-func cut-srt-func)
       (amp-func cut-amp-func)
       (vib-osc-freq cut-vib-osc-freq)
       (vib-osc-freq-dev cut-vib-osc-freq-dev)
       (vib-osc-amp cut-vib-osc-amp)
       (vib-noi-freq cut-vib-noi-freq)
       (vib-noi-amp cut-vib-noi-amp)
       (vib-osc-amp-func cut-vib-osc-amp-func)
       (vib-noi-amp-func cut-vib-noi-amp-func)
       (vib-osc-freq-func cut-vib-osc-freq-func)
       (filter-q cut-filter-q)
       (filter-freq cut-filter-freq)
       (reverb-amount cut-reverb-amount)
       (degree cut-degree))

  (let* ((ifile (open-input soundfile))
	 (sr-ratio (/ (snd-srate ifile) sampling-rate))
	 (ifile-dur (if segment
			(* (- (second segment)(first segment)) sr-ratio
			   (if segment-slice
			       (- (second segment-slice)(first segment-slice))
			     1.0))
		      (if (and sound-start-time sound-end-time)
			  (* (- sound-end-time sound-start-time) sr-ratio)
			(* (- sound-end sound-start)(snd-duration ifile)))))
	 (ifile-start (if segment
			  (* (+ (first segment)
				(if segment-slice
				    (* (first segment-slice)
				       (- (second segment)(first segment)))
				  0.0))
				sr-ratio)
			(if sound-start-time
			    (* sound-start-time sr-ratio)
			  (* sound-start (snd-duration ifile)))))
	 (sample-rate (* sample-rate sr-ratio))
	 (average-rate (+ sample-rate
			  (* sample-rate sample-rate-dev
			     (let ((ox (car srt-func))
				   (oy (cadr srt-func)))
			       (loop for x in srt-func by #'cddr and
				         y in (cdr srt-func) by #'cddr 
				 sum (+ (- (* x y)(* ox y))(- (* x oy)(* ox oy))) into s
				 do (setf ox x oy y)
				 finally (return (/ s 2 x)))))))
	 (ofile-dur (let ((estimated (/ ifile-dur average-rate)))
		      (if (and duration (< duration estimated))
			  duration
			estimated)))
	 (src-gen (make-src :file ifile 
			    :start-time ifile-start
			    :srate sample-rate))
	 (amp-env (make-env :envelope amp-func
			    :start-time start-time
			    :duration ofile-dur
			    :scaler amp))
	 (srate-env (make-env :envelope srt-func 
			      :scaler (* sample-rate sample-rate-dev)
			      :start-time start-time
			      :duration ofile-dur))
	 (vib-osc (make-oscil :frequency vib-osc-freq))
	 (vib-noi (make-randi :frequency vib-noi-freq))
	 (vib-osc-amp-env (make-env :envelope vib-osc-amp-func
				    :scaler (* sample-rate vib-osc-amp)
				    :start-time start-time
				    :duration ofile-dur))
	 (vib-noi-amp-env (make-env :envelope vib-noi-amp-func
				    :scaler (* sample-rate vib-noi-amp)
				    :start-time start-time
				    :duration ofile-dur))
	 (vib-osc-freq-env (make-env :envelope vib-osc-freq-func
				     :scaler (in-Hz vib-osc-freq-dev)
				     :start-time start-time
				     :duration ofile-dur))
	 (filter (if filter-freq
		     (make-ppolar filter-q (min (/ sampling-rate 2.2)
						(* filter-freq average-rate)))
		   nil))
	 (loc (make-locsig :degree degree
			   :distance cut-distance
			   :revscale reverb-amount))
	 (beg (floor (* start-time sampling-rate)))
	 (end (+ beg (floor (* sampling-rate ofile-dur)))))

    (format t "<~,3F-~,3F>~10Tone-cut rate: ~,3F dur: ~,3F~%" start-time (+ start-time ofile-dur) average-rate ofile-dur)
      (Run
       (loop for i from beg to end do
	     (let ((sample (* (env amp-env) 
			      (src src-gen (+ (env srate-env)
					      (* (env vib-osc-amp-env)
						 (oscil vib-osc (env vib-osc-freq-env)))
					      (* (env vib-noi-amp-env)
						 (randi vib-noi)))))))
	       (locsig loc i (if filter
				 (ppolar filter sample)
			       sample)))))
      (close-input ifile)))