[CM] Clean Exit (san-dysth)

Esben Stien b0ef@esben-stien.name
Mon, 09 Apr 2007 01:07:08 +0200


I'm having problems doing a clean exit out of my modified san-dysth.

It's looking for the volume function, but no matter where I put it,
it's not liking it.

I've attached the code below. 

Any pointers as to what I can try?

(definstrument 
  (a_new_gnu_order start-time duration frequency amplitude #:key
		   (middlenote 60)
		   (polyphony 32)
		   (check-overruns #t)
		   
		   (das-vol 0.344)
		   (pitch 0.794)
		   (octave 6)
		   (period 920)
		   (maximum-drunk-change (/ 8.226 10000))
		   (unrandom 0.0)
		   (maximum-add-val (/ 1.545 100))
		   (a1 0.698)
		   (a2 0)
		   (a3 0)
		   (b1 0.474)
		   (b2 0.723)
		   (b3 0.426)								
		   (attack 0.093)
		   (attack-peak 3.699)
		   (sustain 0.05)
		   (release 0.05)
		   (src-width 20)
		   (regular #f)
		   (partial0 1.0)(partial-amplitude0 0.8)
		   (partial1 1.593)(partial-amplitude1 0.6)
		   (partial2 2.135)(partial-amplitude2 0.6)
		   (partial3 2.295)(partial-amplitude3 0.35)
		   (partial4 2.917)(partial-amplitude4 0.3)
		   (partial5 3.598)(partial-amplitude5 0.2)
		   (amplitude-envelope-list '(0 0 .04 1 .4 1 1 0))
		   ;;(amplitude-envelope '(0 0.5 1 0 1 0)))
		   #:allow-other-keys)
  
  (define (filename-without-path path)
    (let ((chars (reverse! (string->list path)))
	  (result '()))
      (while (and (not (null? chars))
		  (not (char=? (car chars) #\/)))
	     (set! result (cons (car chars) result))
	     (set! chars (cdr chars)))
      (list->string result)))

  (define presetpath (string-append (getenv "HOME") "/.san_dysth/presets/"))
  
  (system (string-append "mkdir -p " presetpath " >/dev/null 2>/dev/null"))
  (system (string-append "mkdir -p " presetpath "/backup >/dev/null 2>/dev/null"))
  (system (string-append "mkdir -p " presetpath "/tmp >/dev/null 2>/dev/null"))
  (system (string-append "mkdir -p " presetpath "/examples >/dev/null 2>/dev/null"))
  (if (defined? '*san-dysth-example-presets*)
      (system (string-append "cp -u " *san-dysth-example-presets* "/* " presetpath "/examples/ >/dev/null 2>/dev/null")))

  (primitive-eval '(define synth-load-save-parameters '(polyphony
							attack attack-peak sustain release
							das-vol pitch octave period maximum-drunk-change unrandom maximum-add-val
							a1 a2 a3 b1 b2 b3
							src-width 
							min-release)))
  (letrec* 
   (
    (start (floor (* start-time (mus-srate))))
    (len (floor (* duration (mus-srate))))
					;wtf?
    (foundit 1)
    (face 100.0)
    ;;base oscillator
    (sine0 (make-oscil :frequency frequency))
    (sine1 (make-oscil :frequency (* partial0 frequency)))
    (sine2 (make-oscil :frequency (* partial1 frequency)))
    (sine3 (make-oscil :frequency (* partial2 frequency)))
    (sine4 (make-oscil :frequency (* partial3 frequency)))
    (sine5 (make-oscil :frequency (* partial4 frequency)))
    (sine6 (make-oscil :frequency (* partial5 frequency)))
    ;;modulating oscillator
    (mod (make-oscil :frequency 50))
    (indenv '(0 2 100 1))
    ;;snare   
;    (indenv '(0 100 50 0))
    ;(indenv '(0 0 50 50 100 100 150 0))
    (devf (make-env :envelope indenv
		    :scaler (in-hz 75)
		    :start start
		    :end len))
    (amplitude-envelope (make-env :envelope amplitude-envelope-list
				  :scaler amplitude
				  :start start
				  :end len))
    (output (make-vct len))
    ;;(osc (make-oscil))
    ;;(vol 4/6)
    (face 0.5)    
    (filename (<-> presetpath "tmp/preset.scm"))
    
    (num-synths polyphony)
    (num-playing 0)
    (all-isplaying (make-vct 16))

    (reverb-bus (make-bus 2))

    (min-release 0.000001)

    (osc (make-oscil :frequency 200))

    (freq 200)    


    (reverb-glide-vol (make-glide-var 1.0 0.001))

    (autopan (make-var 1))
    
    (notes (make-vct (1+ num-synths)))
    (volumes (make-vct (1+ num-synths)))

    (a4 (make-oscil :frequency 440))

    (get-attack-inc (lambda (attack-peak attack)
		      (/ (* attack-peak 256)
			 (* (mus-srate) attack))))
    (get-sustain-dec (lambda (attack-peak sustain)
		       (/ (- attack-peak 1)
			  (* (mus-srate) sustain))))
    (get-release-mul (lambda (release)
		       (expt min-release (/ 1 (* (mus-srate) release)))))

    (make-synths 
     (lambda ()
       (let ((ins 
	      (map
	       (lambda (synth-num)
		 (let* (
			(note-vol 0)
			(note 0)
					;			(freq 400)
			(pan_left 1)
			(pan_right 1)


			
			(sr (make-src :srate 0 :width src-width))
			
			;;(attack (make-env  `(0 0    0.7 1.9    1.0 1.0) #:duration attack))
			
			(attack-val 0)
			(attack-inc (get-attack-inc attack-peak attack))
			
			(sustain-val attack-peak)
			(sustain-dec (get-sustain-dec attack-peak sustain))
			
			(release-val 1.0)
			(release-mul (get-release-mul release))
			;;(release-dec (/ 256 (* (mus-srate) release)))
			
			(is-playing #f)
			(src-val 0)			       
			(is-attacking #t)
			(is-sustaining #f)
			(is-releasing #f)

			(val 0)
			(addval 0)
			(period period)
			(periodcounter period)
			(inc-addval #f)
			(maximum-add-val maximum-add-val)
			(maximum-drunk-change maximum-drunk-change)

			(last-time 0)
			(regular-periods regular)
			
			(volume (make-glide-var das-vol 0.01))
			(rate (* 0.1 (expt 2 (+ octave pitch))))

			(das-filter (make-filter 4 (vct 1 b1 b2 b3) (vct 1 (- a1) (- a2) (- a3))))
			(das-delay (make-delay 500))

			(instrument 
			 (<rt> 
			  (lambda ()
			    (declare (<double> release-val release-mul)
				     (<int> last-time synth-num note is-playing is-releasing is-attacking))
			    (define (scale x x1 x2 y1 y2)
			      (+ y1
				 (/ (* (- x x1)
				       (- y2 y1))
				    (- x2 x1))))
			    (define (get-pan-vals pan)
			      (let ((scale ,(- 2 (* 2 (sqrt 2))))
				    (x (scale pan -1 1 0 1)))
				(vct (* (- 1 x)
					(+ (* scale (- 1 x))
					   (- 1 scale)))
				     (* x (+ (* scale x)
					     (- 1 scale))))))
			    (define (synthesize)
			      (* face
				 (env amplitude-envelope)
				 (+ (* partial-amplitude0 (oscil sine1 (* (env devf) (oscil mod))))
				    (* partial-amplitude1 (oscil sine2 (* (env devf) (oscil mod))))
				    (* partial-amplitude2 (oscil sine3))
				    (* partial-amplitude3 (oscil sine4))
				    (* partial-amplitude4 (oscil sine5))
				    (* partial-amplitude5 (oscil sine6))
				    
				    )
				 ))

			    (if (not is-playing)
				(if (not (= (rt-get-time) last-time))
				    (let ((notes-note (the <int> (vct-ref notes synth-num))))
				      (set! last-time (rt-get-time))
				      (if (> notes-note 0)
					  (begin
					    (set! is-playing #t)
					    (set! note (vct-ref notes synth-num))
					    (let* ((mi 20)
						   (ma 107)

						   (val (max mi (min ma note)))
						   (vals (get-pan-vals (scale val mi ma -1 1))))
					      (set! pan_left (* ,(sqrt 2) (vct-ref vals 0)))
					      (set! pan_right (* ,(sqrt 2) (vct-ref vals 1))))
					    (set! is-attacking #t)
					    (set! is-releasing #f)
					    (set! is-sustaining #f)
					    
					    (mus-reset das-delay)
					    
					    (set! attack-val 0.0)
					    (set! sustain-val attack-peak)
					    (set! release-val 1.0)
					    
					    (mus-reset amplitude-envelope)
					    (mus-reset devf)
					    
					    (set! src-val (let ((middlenote (midi-to-freq middlenote))
								(srcval (midi-to-freq note)))
							    (set! srcval (- srcval middlenote))
							    (set! srcval (/ srcval middlenote))
							    (1+ srcval)))
					    (set! note-vol (vct-ref volumes synth-num))
					    (set! num-playing (1+ num-playing))
					    )
					  (if (< notes-note 0) ;; Did not get time to play.
					      (vct-set! notes synth-num 0)))))
				
				(begin
				  (if (not is-releasing)
				      (if (not (= (rt-get-time) last-time))
					  (begin
					    (set! last-time (rt-get-time))
					    (if (< (vct-ref notes synth-num) 1)
						(begin
						  ;;(printf "Starting to release %d/%d\\n" synth-num note)
						  (set! is-releasing #t))))))
				  
				  (let ((outval (* 0.2 note-vol (synthesize)))
					(my-out (lambda (a b)
						  (declare (<double> a b))
						  (if (> (read-var autopan) 0)
						      (begin
							(set! a (* a pan_left))
							(set! b (* b pan_right))))
						  (out (vct a b)))))
				    (declare (<double> outval))
				    (cond (is-attacking
					   (set! outval (* outval (/ attack-val 256)))
					   (my-out outval
						   (delay das-delay outval))
					   (set! attack-val (+ attack-val attack-inc))
					   (if (>= attack-val (* attack-peak 256))
					       (begin
						 (set! is-attacking #f)
						 (set! is-sustaining #t))))
					  
					  (is-sustaining
					   (set! outval (* outval sustain-val))
					   (my-out outval
						   (delay das-delay outval))
					   (set! sustain-val (- sustain-val sustain-dec))
					   (if (<= sustain-val 1.0)
					       (set! is-sustaining #f)))
					  
					  (is-releasing
					   
					   (my-out (* release-val outval)
						   (* release-val (delay das-delay outval)))
					   (set! release-val (* release-val release-mul))
					   (if (<= release-val min-release) ;; check for (min-relase * reverb-val) as well?
					       (begin
						 (set! is-playing #f)
						 (vct-set! notes synth-num 0)
						 (set! num-playing (1- num-playing)))))
					  (else
					   (my-out outval
						   (delay das-delay outval)))))))))))
		   instrument))
	       (iota (1+ num-synths)))))
	 (for-each (lambda (instr)
		     (-> instr play #:position 'last))
		   (c-butlast ins))
	 ins)))
    
    (make-midi-input 
     (lambda ()
       (<rt-play> #:position 'first
		  (lambda ()
		    (receive-midi 
		     (lambda (control data1 data2)
		       (set! control (logand #xf0 control))
		       (if (and (< num-playing num-synths)
				(= control #x90)
				(> data2 0))
			   (let loop ((synth-num 0))
			     (declare (<int> synth-num))
			     
			     (if (= (vct-ref notes synth-num) 0)
				 (begin
				   (vct-set! volumes synth-num (/ data2 128.0))
				   (vct-set! notes synth-num data1))
				 (if (< synth-num (1- num-synths))
				     (loop (1+ synth-num)))))
			   
			   (if (or (= control #x80)
				   (and (= control #x90)
					(= data2 0)))
			       (let loop ((synth-num 0))
				 (if (= (vct-ref notes synth-num) data1)
				     (vct-set! notes synth-num (- data1))
				     (if (< synth-num (1- num-synths))
					 (loop (1+ synth-num)))))))))))))
    
    (synths (make-synths))
    (midi-input (make-midi-input))
    
    (stop-all (lambda (restfunc)
		(for-each (lambda (instrument)
			    (write-glide-var (-> instrument volume) 0.0))
			  (c-butlast synths))
		(write-glide-var reverb-glide-vol 0.0)
		(in 10
		    (lambda ()
		      (for-each (lambda (instrument) (-> instrument stop)) (c-butlast synths))
		      (set! notes (make-vct (1+ num-synths)))
		      (-> midi-input stop)
		      (if restfunc
			  (restfunc))))))
    
    (start-all (lambda (stop?)
		 (let ((doit (lambda ()
			       (set! synths  (make-synths))
			       (write-glide-var reverb-glide-vol 1.0)
			       (set! midi-input (make-midi-input))
)))
		   (if stop?
		       (stop-all doit)
		       (doit)))))
    
    (get-filename 
     (lambda (func)
       (let ((dialog (GTK_FILE_SELECTION (gtk_file_selection_new "aiai"))))
	 (gtk_file_selection_set_filename dialog presetpath)
	 (c-g_signal_connect (.ok_button dialog)
			     "clicked"
			     (lambda (w d)
			       (func (gtk_file_selection_get_filename dialog))
			       (gtk_widget_hide (GTK_WIDGET dialog))))
	 (c-g_signal_connect (.cancel_button dialog)
			     "clicked"
			     (lambda (w d)
			       (gtk_widget_hide (GTK_WIDGET dialog))))
	 (gtk_widget_show (GTK_WIDGET dialog)))))
    
    (save-preset 
     (begin
       (primitive-eval '(define-macro (make-varlist-macro)
			  `(list ,@(map (lambda (var)
					  `(list ',var ,var))
					synth-load-save-parameters))))
       (lambda (preset-filename)			   
	 (let ((fd (open-file preset-filename "w")))
	   (pretty-print `(define synth-preset-temp ',(make-varlist-macro))
			 fd)
	   (close fd)))))
    
    (load-preset 
     (begin
       (primitive-eval 
	'(define-macro (read-varlist-macro)
	   `(begin ,@(map 
		      (lambda (var)
			`(let ((a (assoc ',var synth-preset-temp)))
			   (if a
			       (set! ,var (cadr a)))))
		      synth-load-save-parameters))))

       (lambda (preset-filename)
	 (stop-all (lambda ()
		     (gtk_window_set_title (GTK_WINDOW (-> d dialog)) preset-filename)
		     (for-each (lambda (slider)
				 (-> slider delete!))
			       sliders)
		     (load preset-filename)
		     (set! a2 0)(set! a3 0)
		     (read-varlist-macro)
		     (set! sliders (make-sliders))
		     (start-all #f))))))
    
    (save-backup (lambda (backup-filename)
		   (system (<-> "cp -f \"" backup-filename "\" \"" presetpath "/backup/"
				(filename-without-path backup-filename) "-"(string-append (string #\`)) "date -Iseconds" (string-append (string #\`)) "\""
				" >/dev/null 2>/dev/null"))))

    (preset-A (<-> presetpath "tmp/synth-preset-A"))
    (preset-B (<-> presetpath "tmp/synth-preset-B"))

    (load-here (lambda ()
		 (get-filename (lambda (preset-filename)
				 (save-backup filename)
				 (load-preset preset-filename)
				 (save-preset preset-A)
				 (save-preset preset-B)
				 (gtk_window_set_title (GTK_WINDOW (-> d dialog)) preset-filename)
				 (set! filename preset-filename)))))
    
    (save (lambda ()
	    (save-backup filename)
	    (save-preset filename)))
    
    (save-as 
     (lambda ()
       (get-filename 
	(lambda (preset-filename)
	  (save-backup preset-filename)
	  (save-preset preset-filename)
	  (gtk_window_set_title (GTK_WINDOW (-> d dialog)) preset-filename)
	  (set! filename preset-filename)))))
    
    (exit-synth 
     (lambda ()
       (stop-all #f)
       (-> d hide)
       (set! check-overruns #f)
       ;(exit)
       ))
    
    (d (<dialog> "Pungie 0.1" exit-synth
		 "Save As" save-as
		 "Save" save
		 "Load" load-here
		 "Close" exit-synth))

    (for-all-instruments (lambda (func)
			   (lambda (val)
			     (for-each (lambda (instrument)
					 (func instrument val))
				       synths))))
    (<checkbutton2> (lambda args
		      (let ((ret (apply <checkbutton> args)))
			(-> ret add-method 'delete! (<- ret remove))
			ret)))

    (make-sliders (lambda ()

		    (list
		     (<slider> d "Amplitude" 0 das-vol 2.0 (for-all-instruments (lambda (instrument val) 
										  (set! das-vol val)
											(write-glide-var (-> instrument volume) (* (if (> unrandom 0) 0.01 1) das-vol))))
			       1000)
		     (<slider> d "Pitch" 0 pitch 1 (for-all-instruments (lambda (instrument val)
									  (set! pitch val)
									  (set! (-> instrument rate) (* 0.1 (expt 2 (+ octave pitch))))))
			       1000)

)))
    (sliders (make-sliders)))
   
   (save-preset preset-A)
   (save-preset preset-B)
   
   (-> d show)
   
   (letrec 
       ((check-overrun 
	 (let ((lastval (last (rte-info))))
	   (lambda ()
	     (let ((newval (last (rte-info))))
	       (if (> newval lastval)
		   (begin
		     (c-display "Excessive Resource Usage. Skipping. (" newval "skips since start (try lowering period+pitch/octave, src-width and/or polyphony))")
		     (set! lastval newval))))
	     (if check-overruns
		 (in 1000 check-overrun))))))
     (check-overrun))
   
   midi-input))

;(define i 
  (a_new_gnu_order 0 0.1 45 0.3)
 ; )
;//END

-- 
Esben Stien is b0ef@e     s      a             
         http://www. s     t    n m
          irc://irc.  b  -  i  .   e/%23contact
           sip:b0ef@   e     e 
           jid:b0ef@    n     n