"Fossies" - the Fresh Open Source Software Archive

Member "snd-20.9/bandedwg.cms" (15 Nov 2019, 6671 Bytes) of package /linux/misc/snd-20.9.tar.gz:


As a special service "Fossies" has tried to format the requested text file into HTML format (style: standard) with prefixed line numbers. Alternatively you can here view or download the uninterpreted source code file.

    1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    2 ;;;;
    3 ;;;  Banded Waveguide Instrument based on
    4 ;;;  ====== =========
    5 ;;;
    6 ;;;    Essl, G. and Cook, P. "Banded
    7 ;;;    Waveguides: Towards Physical Modelling of Bar
    8 ;;;    Percussion Instruments", Proceedings of the
    9 ;;;    1999 International Computer Music Conference.
   10 ;;;
   11 ;;;    Also, Essl, Serafin, Cook, and Smith J.O., 
   12 ;;;    "Theory of Banded Waveguides", CMJ, 28:1,
   13 ;;;    pp37-50, Spring 2004.    
   14 ;;;
   15 ;;;  NOTES:
   16 ;;;        As with all physical models, initial conditions matter.
   17 ;;;        Frequency range is not too broad. 220Hz. is a good
   18 ;;;        starting point.
   19 ;;;
   20 ;;;
   21 ;;;  Tuned bar, Glass Harmonica and Uniform Bar for now.
   22 ;;;
   23 ;;;  08/22/2013  update bandpass filters with CLM's filter generator (juanig)
   24 ;;;  08/24/2013  replaced delay line macros with DelayL using clm's delay ug  
   25 ;;;  08/29/2014  fixed waveguide with feed and reflections
   26 ;;;  08/30/2014  Try different delay line lengths. Fixing bandpass radius param.
   27 ;;;  09/04/2014  This SND's S7 version
   28 ;;;
   29 
   30 
   31 (define* (make-bowtable (offset 0.0) (slope 1.0))
   32   (float-vector offset slope))
   33 
   34 (define (bowtable b samp)
   35   (max 0.0 (- 1.0 (abs (* (b 1) (+ samp (b 0)))))))
   36 
   37 
   38 (define (make-bandpassbq freq radius)
   39   (let ((arra (make-float-vector 3))
   40 	(arrb (make-float-vector 3)))
   41     (set! (arra 1) (* -1.998 radius (cos (hz->radians freq)))) 
   42     (set! (arra 2) (*  radius radius))
   43     ;;;
   44     ;;; gain gets normalized 
   45     ;;;
   46     (set! (arrb 0) (- 0.5 (* 0.5 (arra 2))))
   47     (set! (arrb 2) (- (arrb 0) )) 
   48     (make-filter 3 arra arrb) ))
   49 
   50 
   51 
   52 ;;;  To handle bandpass filter
   53 
   54 (define (bandpassbq f sample0)
   55   (filter f sample0))
   56 
   57 ;;; Delay line structures and functions using SND's delay generator (as per prc95.scm)
   58 
   59 (defgenerator dlya (outp 0) (input #f))
   60 
   61 (define (make-delayl len lag)
   62   (make-dlya :input (make-delay len :max-size (ceiling (+ len lag 1)))
   63 	     :outp (- lag len)))
   64 
   65 (define (delayl d samp)
   66   (delay-tick (d 'input) samp)
   67   (tap (d 'input) (d 'outp)))
   68 
   69 
   70 ;;;;;;;;;;;;;;;;;;;;
   71 
   72 (definstrument (bandedwg beg dur freq amplitude 
   73                         			     ;; vibration modes
   74 			                             ;; 1=tuned Bar; 2=Glass Harmonica; 
   75 			                             ;; 3= Uniform bar
   76 			     (mode 3) 
   77 			     (maxa 0.9998)           ;; max bow velocity
   78 			     (bv 1.0)                ;; bow velocity scaler
   79 			                             ;; velocity envelope
   80 			     (vel-env '(0 1.0 .95 1.1 1 1.0))
   81 			     (amp-env '(0 1 1 1))    ;;'(0 0.0  .95 1.0 .99 0.00))
   82 			     (rev-amount .08) )
   83   (let ((nrmodes 4))
   84     (cond ((= mode 1)
   85 	   (set! nrmodes 4))
   86 	  ((= mode 2)
   87 	   (set! nrmodes 6))
   88 	  (else
   89 	   (set! nrmodes 4))
   90 	  )
   91     (let* ((start (seconds->samples beg))
   92 	   (baselen (/ *clm-srate* freq))          ;; original Stk delayl length
   93 	   (baselag (- (/ *clm-srate* freq) 0.5))
   94 	   (dtapoffs 0.0)                          ;; tap offset is 0.0 in StK's version 
   95 	   (bandpass    (make-vector nrmodes))
   96 	   (delayslft   (make-vector nrmodes))
   97 	   (delaysrfl   (make-vector nrmodes))
   98 	   (modes       (make-float-vector nrmodes))
   99 	   (gains       (make-float-vector nrmodes))
  100 	   (basegains   (make-float-vector nrmodes))
  101 	   (excitations (make-float-vector nrmodes))
  102 	   (delastout   (make-float-vector nrmodes))
  103 	   ;;
  104 	   (fradius 0.0)   ;; radius for bandpass filter
  105 	   (dlength 0.0)   ;; delay-line length
  106 	   (dlag 0.0)      ;; delay lag (for tap)
  107 	   ;;
  108 	   (bowtab (make-bowtable :slope 3.0 :offset 0.001))  
  109 	   (ampenv (make-env amp-env :scaler amplitude :duration dur))
  110 	   ;; (vel-env (make-env vel-env :scaler bv :duration dur))
  111 	   ;;
  112 	   (maxvelocity maxa)
  113 	   (end (+ start (seconds->samples dur)))
  114 	   )
  115       ;;
  116       ;;
  117       (cond ((= mode 1) ;; Tuned Bar
  118 	     (begin
  119 	       (set! (modes 0) 1.000)
  120 	       (set! (modes 1) 4.0198391420)
  121 	       (set! (modes 2) 10.7184986595)
  122 	       (set! (modes 3) 18.0697050938)
  123 	       (do ((i 0 (+ i 1)))
  124 		   ((= i nrmodes))
  125 		 (set! (basegains i) (expt 0.998 (+ i 1)))
  126 		 (set! (excitations i) 1.0) )
  127 	       ))
  128 	    ((= mode 2) ;; Glass Harmonica
  129 	     (begin 
  130 	       (set! (modes 0) 1.000)
  131 	       (set! (modes 1) 2.32)
  132 	       (set! (modes 2) 4.25)
  133 	       (set! (modes 3) 6.63)
  134 	       (set! (modes 4) 9.38)
  135 	       (set! (modes 5) 12.22)
  136 	       (do ((i 0 (+ i 1)))
  137 		   ((= i nrmodes))
  138 		 (set! (basegains i ) (expt 0.988 (+ i 1)))
  139 		 (set! (excitations i) 1.0))
  140 	       ))
  141 	    (else ;; Uniform Bar
  142 	     (begin
  143 	       (set! (modes 0) 1.000)
  144 	       (set! (modes 1) 2.756)
  145 	       (set! (modes 2) 5.404)
  146 	       (set! (modes 3) 8.933)
  147 	       (do ((i 0 (+ i 1)))
  148 		   ((= i nrmodes))
  149 		 (set! (basegains i ) (expt 0.9 (+ i 1)))
  150 		 (set! (excitations i) 1.0))
  151 	       ))
  152 	    )
  153 
  154       ;;
  155       ;; set-frequency method in STK's BandedWG
  156       ;;
  157 
  158       ;; (set! fradius (- 1.0 (* pi (/ 32 *clm-srate*))))
  159       (set! fradius (- 0.3998 (* pi (/ 32 *clm-srate*))))
  160 
  161       (do ((i 0 (+ i 1)))
  162 	  ((= i nrmodes))
  163 	(set! dlength (floor  (/ baselen (modes i))))
  164 	(set! dlag    (floor  (/ baselag (modes i))))  ;; (- lag len) --> tap offset
  165 	(set! (delayslft i) (make-delayl dlength dlag))
  166 	(set! (delaysrfl i) (make-delayl dlength dlag))
  167 
  168 	(set! (gains i) (basegains i))
  169 	(set! (bandpass i) 
  170 	      (make-bandpassbq (* freq (modes i)) fradius)) )
  171       
  172       ;;
  173 ;;;;;;;;;;;;
  174       ;;
  175       
  176       (do ((i start (+ i 1)))
  177 	    ((= i end))
  178 	;;
  179 	    (let ((input 0.0)
  180 		  (velinput  0.0)
  181 		  (bowvelocity 0.0)
  182 		  (bplastout 0.0)
  183 		  (dlastsampl 0.0)
  184 		  (outsampl 0.0)
  185 		  )
  186 	      
  187 	      (do ((k 0 (+ k 1)))
  188 		  ((= k nrmodes))
  189 		(set! velinput (+ velinput (* (basegains k)  (delastout k))) )
  190 		)
  191 	      ;;
  192 	      ;; (set! bowvelocity (* 0.3 (env vel-env) maxvelocity))
  193 	      (set! bowvelocity (* 0.3  maxvelocity))
  194 	      (set! input  (- bowvelocity velinput))
  195 	      (set! input (* input (bowtable bowtab input)))
  196 	      (set! input (/ input nrmodes ))
  197 	      ;;
  198 	      ;; Here the waveguide
  199 	      ;;
  200 	      (do ((j 0 (+ j 1)))
  201 		  ((= j nrmodes))
  202 		(set! bplastout (+ bplastout (bandpassbq (bandpass j) 
  203 					    (delayl (delayslft j) 
  204 						    (+ input (* (gains j) dlastsampl)) ))))
  205 		(set! dlastsampl (+ dlastsampl (delayl (delaysrfl j) bplastout)))
  206 		(set! (delastout j) dlastsampl)
  207 		)
  208 	      ;;
  209 	      ;;
  210 	      (set! outsampl (*  4.0 (env ampenv)  bplastout)) 
  211 	      (outa i outsampl)
  212 	      ;;
  213 	      (if *reverb*
  214 		  (begin
  215 		    (outa i (* outsampl rev-amount)  *reverb*)))
  216 	      )))
  217       ))
  218 
  219 ;;; (with-sound () (bandedwg 0 1 220 0.4))
  220 ;;; (with-sound () (bandedwg 0 1 220 0.4 :mode 1))
  221 ;;; (with-sound () (bandedwg 0 1 220 0.4 :mode 2))
  222 ;;; (with-sound () (bandedwg 0 1.0 220 0.7 :mode 1 :maxa 0.497))