abaris.lsp
 Version 1.00  31 October 2004
 Author Steven Jones

 Contact jones57@swbell.net include the word "nyquist" in subject line  

 The contents of this file are released under the terms of the GNU General
 Public License. See the file LICENSE.txt

 Instrument with resonant filter sweep.

wrapper

 (abaris plist dur [keywords...])
 Combination Sawtooth, FM and band limited noise instrument with 
 dynamic filter.
 
 plist  - list or flonum. MIDI key-number(s) to be palyed.
 dur    - flonum. Duration
 :vel   - flonum. MIDI velocity, default 64
 :pos   - flonum or sound. Pan position, Default 0.5
 :arpeg - flonum. Arpeggio interval, default 0
 :cr    - flonum. Relative FM carrier frequency.
 :mr    - flonum. Relative FM modulation frequency.
 :mi    - flonum. FM modulation index.
 :nse   - flonum. Noise mix level
 :nbw   - flonum. Noise band width
 :nenv  - sound. Noise envelope
 :menv  - sound. Modulation envelope
 :env   - sound. Amplitude envelope
 return - sound vector.

;; abaris.lsp
;; Version 1.00  31 October 2004
;; Author Steven Jones
;;
;; Contact jones57@swbell.net include the word "nyquist" in subject line  
;;
;; The contents of this file are released under the terms of the GNU General
;; Public License. See the file LICENSE.txt
;;
;; Instrument with resonant filter sweep.

(require 'definst)
(require 'rmband)
(require 'map)
(require 'xenvelope)

(provide 'abaris)
(current-file "abaris")


(defun abaris:noise  (pitch dur &key bw env)
  (mult (rmband pitch :dur dur :bw (or bw 10))
	(or env (percussion env))))


(defun abaris:fm  (pitch dur &key vel cr mr mi nse ncf nbw nenv menv env)
  (let (hz chz)
    (setq vel (map:ctrl 2.00 (or vel 64) 0.5))	  ;MIDI velocity
    (setq mr (or mr 1.005))		          ;Modulator frq ratio
    (setq mi  (map:ctrl 8.000 (or mi  64) 0.000)) ;Moduation index (MIDI)
    (setq nse (map:ctrl 128.0 (or nse 64) 0.000)) ;Noise modulation index (MIDI)
    (setq ncf (or ncf 1000))		          ;Noise center frequency
    (setq nbw (or nbw 10))		          ;Noise band width
    (setq nenv (or nenv (percussion (* dur 0.5))))      ;Noise envelope
    (setq menv (or menv (xadsr 0.07 0.20 0.00 0.33 0.50 dur))) ;Modulator envelope
    (setq env  (or env  (xadsr 0.07 0.30 0.00 0.20 0.75 dur))) ;Carrier envelope
    (setq hz (step-to-hz pitch))
    (setq chz (* hz (or cr 1.000)))
    (mult (fmosc (hz-to-step chz)
		 (sum 
		  (scale (* chz nse)(abaris:noise (hz-to-step ncf) dur :bw nbw :env nenv))
		  (scale (* chz mi vel)(mult (osc (hz-to-step (* mr hz)) dur) menv))))
	  env)))

(setq abaris:*saw-key-map* (map:linear-knee 0 0 -18 0 64 128))
(setq abaris:*fm-key-map*  (map:linear-knee 0 0 +06 0 64 128))


(defun abaris:voice (pitch dur &rest args)
  (sum (scale-db (send abaris:*saw-key-map* :get pitch)
		 (mult (osc pitch dur *saw-table*)
		       (xadsr 0.01 0.40 0.00 1.00 0.30 dur)))
       (scale-db (send abaris:*fm-key-map* :get pitch)
		 (apply #'abaris:fm (append (list pitch dur) args)))))


;; @doc wrapper abaris
;; (abaris plist dur [keywords...])
;; Combination Sawtooth, FM and band limited noise instrument with 
;; dynamic filter.
;; 
;; plist  - list or flonum. MIDI key-number(s) to be palyed.
;; dur    - flonum. Duration
;; :vel   - flonum. MIDI velocity, default 64
;; :pos   - flonum or sound. Pan position, Default 0.5
;; :arpeg - flonum. Arpeggio interval, default 0
;; :cr    - flonum. Relative FM carrier frequency.
;; :mr    - flonum. Relative FM modulation frequency.
;; :mi    - flonum. FM modulation index.
;; :nse   - flonum. Noise mix level
;; :nbw   - flonum. Noise band width
;; :nenv  - sound. Noise envelope
;; :menv  - sound. Modulation envelope
;; :env   - sound. Amplitude envelope
;; return - sound vector.
;;

(defwrapper abaris  
  #'abaris:voice
  #'(lambda (sig args)
      (let (vel floor mod bw)
	(setq vel (get-keyword-value ':vel args 64))
	(setq floor (get-keyword-value ':floor args 500))
	(setq mod (map:ctrl 5000 (get-keyword-value ':mod args 64)))
	(setq bw (get-keyword-value ':bw args 50))
	(reson sig (sum floor (scale mod (percussion dur))) bw 0))))