;nyquist plug-in
;version 4
;type generate
;name "Random Piecewise Linear..."
;action "Generating..."
;author "dm"
;copyright "Released under terms of the GNU General Public License version 2"
;release 1.1

;control duration "Duration" time "" 3 0 nil
;control fund-freq "Frequency (Hz)" float "" 50 1 300
;control locks "Parameter Lock (Table Duration)" string "" "(5 3.5) (7 1.1)"
;control text "Timbral Parameters:"
;control seed "Random Seed" int "" 12532 1 134455
;control num-tables "Number of Key Tables" int "" 5 1 50
;control num-breakpoints "Max. Segments Per Key Table" int "" 5 1 15
;control vary-breakpoints "Vary Segments Per Key Table" choice "No,Yes" 0
;control table-type "Table In" choice "Sine,Saw,Fifth,Triangle,Random" 0

(defun rnd ()
  ;;;pseudorandom number between -1 and 1
  (setq seed (rem (sum (mult 8121 seed) 28411) 134456))
  (- (/ (float seed) 134456 0.5) 1))

;;;GENERATE LIST OF WAVETABLES AND BREAKPOINTS FOR SIOSC

(defun build-shaper (num-breaks)
  ;;;pseudorandom piecewise linear function on [0,2] with num-breaks pieces
  (if (zerop num-breaks)
      (pwlv -1 2.01 1)
      (do* ((i 1 (+ i 1))
            (new-time 0 (sum (rnd) 1 new-time))
            (point-list (list (rnd)) (cons (rnd) (cons new-time point-list))))
           ((> i num-breaks) 
            (stretch-abs (/ 2.01 new-time) (pwlv-list (reverse point-list)))))))

(defun get-num-breaks (max-breaks)
  ;;;decide how many breakpoints build-shaper should create
  (case vary-breakpoints
    (0 max-breaks)
    (1 (truncate (* max-breaks (+ 1 (rnd)))))))

(defun gen-table (raw-table max-breaks)
  (shape raw-table (build-shaper (get-num-breaks max-breaks)) 1))

(defun get-raw-table ()
  ;;;decide which raw table to use
  (case table-type
    (0 (build-harmonic 1 2048))
    (1 (pwlv -1 1 1))
    (2 (scale 0.49 (sum (build-harmonic 2 2048) (build-harmonic 3 2048))))
    (3 (pwlv -1 1 1 2 -1))
    (4 (scale 0.49 (build-shaper num-breakpoints)))))

(defun wav-list (duration num-tables breaks-per-table slock-list)
  (if (= num-tables 1)
      (let ((cur-table (gen-table (get-raw-table) breaks-per-table)))
        (list cur-table duration cur-table))
      (let ((interval (/ duration num-tables))
            (raw-table (get-raw-table)))
        (do* ((ind 1 (+ 1 ind))
              (cur-time interval (sum interval cur-time))
              (cur-table (gen-table raw-table breaks-per-table)
                (gen-table raw-table breaks-per-table))
              (breakpoints-list (list cur-table)
                (cons cur-table (cons cur-time breakpoints-list))))
             ((= ind num-tables) (reverse breakpoints-list))
	     ;;locks: continue to use current wavetable for specified time
          (if (and slock-list (= ind (caar slock-list)))
              (progn
                (setf cur-time (sum (cadar slock-list) cur-time))
                (setf breakpoints-list (cons cur-table (cons cur-time breakpoints-list)))
                (setf slock-list (cdr slock-list))))))))

;;;VALIDATE AND PROCESS USER INPUT

(defun sort-by-car (lst)
  (sort lst
    (lambda (x y) (< (car x) (car y)))))

(defun validate-pairs (pair)
  (if (and (listp pair) (= 2 (length pair)))
      (if (and (integerp (car pair)) 
            (> (car pair) 0)
            (<= (car pair) num-tables))
          (if (and (numberp (cadr pair)) (plusp (cadr pair)))
              pair
              (throw 'err 
                (format nil "Lock duration ~s not a positive number." 
                  (cadr pair))))
          (throw 'err (format nil
            "Lock table ~s not between 1 and ~s inclusive." (car pair) num-tables)))
      (throw 'err (format nil 
        "Lock ~s not a pair of the form (Table Duration)." pair))))

;;;When 2.3.1 is out, replace with eval-string
(defun string-to-list (string)
  (read (make-string-input-stream (format nil "(~a)" string))))

(defun process-locks (str)
  (sort-by-car (mapcar #'validate-pairs (string-to-list str))))

;;;PROCESS OUTPUT

(defun pch-mod (dur)
  ;;placeholder
  (s-rest dur))

(defun normalize (sig)
  (let ((ac (highpass8 sig 25)))
    (scale (/ 0.95 (peak ac ny:all)) ac)))

;;;main
(catch 'err (normalize (siosc 
  (hz-to-step fund-freq)
  (pch-mod duration)
  (wav-list duration num-tables num-breakpoints (process-locks locks)))))