;;; LPC demo 1
;;; Pedro J. Morales.
;;; February, 04
;;; Roger B. Dannenberg
;;; July, 04

; PLEASE config   ====================================================== 


; where is the file lpc-example.dat
(setf *lpc-data* "d:/rbd/nyquist/lpc/lpc-exmpl.dat")


; this file generated by Nyquist will be loaded by Octave (or Matlab)
(setf *default-octave-file* 
       "d:/rbd/temp/nyquist.dat")

; config END ===========================================================



; file-io tools ========================================================


(defun octave-1 (outf data varname datatype &optional (n 1000))
  (prog ((points (case datatype
                       (SND (snd-samples data (1+ n)))
                       (ARR data)))
         len)
    (setf len (length points))
    (cond ((> len n)
       (setf len n)
       (format t "WARNING: DATA TRUNCATED TO ~A POINTS~%" len)))
    (format outf  "# name: ~A\n" varname)
    (format outf  "# type: matrix\n# rows: 1\n# columns: ~A\n " len)
    (dotimes (i len)
         (format outf  "~A " (aref points i)))
    (format outf "\n")))

(defun octave (data-lists)   ; (data varname datatype &optional (n 1000))
  (prog ((filename *default-octave-file*)
         outf)
    (setf outf (open filename :direction :output))
    (cond ((null outf)
       (format t "octave: could not open ~A!~%" filename)
       (return nil)))
    (format t "octave: writing ~A ... ~%" filename)
     (cond ((null outf)
           (format t "octave: could not open  ~A!~%" filename)
           (return nil)))
    ;(format t "octave: writing ~A ... ~%" filename)
    (dolist (l data-lists)
      (apply #'octave-1 (cons outf l)))
    (close outf)))


;   LPANAL  ======================================================
 
; get lpc data ---------------------------------------------------


(defun do-lpc-analysis ()
  (setf *myfile* "d:/rbd/nyquist/voice.wav")
  (save-lpc-file (make-lpanal-iterator (s-read *myfile*) 0.08 0.04 50) 
                 "temp.dat"))

;(if (not (boundp 'lpc-example))
;    (do-lpc-analysis))

;(if (not (boundp 'lpc-example))
;    (setf lpc-example  (load-file-data *lpc-data*)))

;-----------------------------------------------------------------


;  SHOW-LPC-DATA  ------------------------------------------------
; show values of LPC analysis frames  ----------------------------

 
(defun ex-1 () 
  ; do not show filter coefs
  (show-lpc-data (make-lpc-file-iterator *lpc-data*) 100 120 NIL))


; -------   SAVE-FILE-DATA ---------------------------------------
(defun ex-2 ()
  (save-lpc-file (make-lpc-file-iterator *lpc-data*) "temp.dat"))


;-----------   LPC-FREQ ------------------------------------------
; LPC-FREQ. Show frequency response of ALLPOLES filter.
;           NEEDS MATLAB or OCTAVE
;

(defun ex-3 ()
   (lpc-freq "frm70" (make-lpc-file-iterator *lpc-data*) 70))


; in MATLAB/OCTAVE:
; >> load -force nyquist.dat
; >> [H,W] = freqz(1, frm70, 512);
; >> plot(W,20*log10(abs(H)));


;-------------------------------------------------------------------------
; LPC-STABILITY  Check for Stability of LPC filters
;                NEEDS MATLAB/OCTAVE

; EXAMPLE

; (ex-3)

; in MATLAB/OCTAVE:
; >> load -force nyquist.dat
; >> find(abs(roots(frm70)) > 1)
; if any abs root is > 1.0 then UNSTABLE

;--------------------------------------------------------------------------
; ALLPOLES    LPC allpoles filter
;             WARNING: this is a static filter
;                      for LPC resynthesis a dynamic LPC filter is needed
   

; EXAMPLE

(defun ex-4 () 
  (play (seq
          (allpoles-from-lpc (buzz 12 f2 (lfo 5.0 4.0)) 
                             (nth-frame (make-lpc-file-iterator *lpc-data*)
                                        30))
          (allpoles-from-lpc (buzz 12 f2 (lfo 5.1 4.0)) 
                             (nth-frame (make-lpc-file-iterator *lpc-data*)
                                        60))
          (allpoles-from-lpc (buzz 12 g2 (lfo 5.3 4.0))  
                             (nth-frame (make-lpc-file-iterator *lpc-data*)
                                        100)) )))


(setf a-lpcdata
'(63.2144 0.674387 0.103287
 #(-0.0381026 0.00804115 0.0109905 0.0145117 0.00199174 -0.00129314 0.0171826 
    0.0181176 0.00179391 -0.0114089 -0.0120949 -0.000410595 -0.0122539
   -0.0209354 -0.00804976 -0.00345041 -0.00409532 -0.00227011 0.014224 0.0135451
    0.0056023 -0.00651142 -0.00564953 -0.0168921 -0.0377939 -0.0449506 -0.0355592
   -0.0339316 -0.0454434 1.19336)))

(setf e-lpcdata
'(40.7157 0.149753 0.0606467 
 #(0.0244574 -0.0225545 -0.0172724 -0.0122709 -0.0042946 0.00886974 0.0121516 0.0120936
   0.00197545 -0.00582163 -0.018367 -0.0201546 -0.00440599 0.00638936 0.0166275 0.0185066
   0.00890464 -0.00158013 -0.00494974 -0.00479037 0.0130814 0.0138648 -0.0022018 -0.021368
 -0.0343532 -0.0312712 -0.0574975 -0.0918824 -0.112016 1.31398)))


(setf i-lpcdata
'(5.5391 0.0321825 0.0762238 #(-0.0341124 -0.0149688 -0.00585657 -0.0111572
  0.00769712 0.0190367 0.00885366 0.0112762 0.0118286 -0.00059044 -0.0140864 -0.0123688
 -0.0151128 0.00214354 -0.00810219 -0.00538188 0.00631382 0.020771 0.0356498 0.0295531
  0.0242797 0.0124296 0.00445127 -0.013062 -0.0387178 -0.0527783 -0.0685511 -0.076575 
 -0.0846335 1.24521)))

(defun noise-vocal (lpcdata dur)
  (allpoles-from-lpc (noise dur) lpcdata))

(defun ex-5 ()
  (play
    (seq (noise-vocal a-lpcdata 1)
         (noise-vocal e-lpcdata 1)
         (noise-vocal i-lpcdata 1))))

(defun buzz-vocal (lpcdata dur)
  (allpoles-from-lpc (buzz 16 e2 (const 0.0 dur))
                     lpcdata))

(defun ex-6 ()
  (play
     (seq (buzz-vocal a-lpcdata 1)
          (buzz-vocal e-lpcdata 1)
          (buzz-vocal i-lpcdata 1))))


; ---- LPRESON ------------------------------------------------------------
; 
(defun ex-7a ()
  ;; parameters are sound, lpc-iterator, skiptime
  (lpreson (noise 6.5) (make-lpc-file-iterator *lpc-data*) 0.04))

(defun ex-7 ()
  (play (ex-7a)))

(defun ex-8a (p dur)
  (lpreson (buzz 16 p (scale 1.5 (lfo 3.0 dur))) 
               (make-lpc-file-iterator *lpc-data*)
               0.04))

(defun ex-8 ()
  (play
    (sim (seq (ex-8a c4 1) (ex-8a g3 1) (ex-8a a3 1) (ex-8a b3 1) (ex-8a c4 1))
         (seq (ex-8a c2 2) (ex-8a f2 1) (ex-8a g2 1) (ex-8a e2 1)))))

(defun noalias-buzz (p nmax)
  (min
    (round (/ *sound-srate* (* 2.0 (step-to-hz p))))
    nmax))

(defun ex-9a (p dur skiptime)
  (mult (env 0.01 0.01 0.1 1.0 1.0 1.0 dur)
        (lpreson (buzz (noalias-buzz p 16) p (scale 1.5 (lfo 3.0 dur))) 
                 (make-lpc-file-iterator *lpc-data*)
                 skiptime)))


(defun ex-9b (stretch skiptime)
  (play
   (sim (seq (ex-9a c4 (* 1 stretch) skiptime)
             (ex-9a g3 (* 1 stretch) skiptime)
             (ex-9a a3 (* 1 stretch) skiptime)
             (ex-9a b3 (* 1 stretch) skiptime)
             (ex-9a c4 (* 1 stretch) skiptime))
        (seq (ex-9a c2 (* 2 stretch) skiptime)
             (ex-9a f2 (* 1 stretch) skiptime)
             (ex-9a g2 (* 1 stretch) skiptime)
             (ex-9a e2 (* 1 stretch) skiptime)))))
  

(defun ex-9 ()
  (ex-9b 1.0 0.04))

(defun ex-10 ()
  (ex-9b 1.0 0.02))

(defun ex-11 ()
  (ex-9b 2.0 0.04))

(defun ex-12 ()
  (ex-9b 0.5 0.02))

(defun ex-13 ()
  (ex-9b 4 0.02))

(defun ex-14a (p dur skiptime)
  (mult (env 0.01 0.01 0.1 1.0 1.0 1.0 dur)
        (lpreson (osc-saw (sim (step-to-hz (+ p 0)) (scale 1.5 (lfo 3.0 dur))))
                 (make-lpc-file-iterator *lpc-data*)
                 skiptime)))

(defun ex-14b (stretch skiptime)
  (play
   (sim (seq (ex-14a c4 (* 1 stretch) skiptime)
             (ex-14a g3 (* 1 stretch) skiptime)
             (ex-14a a3 (* 1 stretch) skiptime)
             (ex-14a b3 (* 1 stretch) skiptime)
             (ex-14a c4 (* 1 stretch) skiptime))
        (seq (ex-14a c2 (* 2 stretch) skiptime)
             (ex-14a f2 (* 1 stretch) skiptime)
             (ex-14a g2 (* 1 stretch) skiptime)
             (ex-14a e2 (* 1 stretch) skiptime)))))
  

(defun ex-14 ()
  (ex-14b 1 0.04))

(defun ex-15 ()
  (ex-14b 4 0.02))

(defun ex-16 ()
  (ex-14b 8 0.08))
 




   


