[CM] Clean Exit (san-dysth)
Esben Stien
b0ef@esben-stien.name
Mon, 09 Apr 2007 21:57:48 +0200
"Kjetil S. Matheussen" <k.s.matheussen@notam02.no> writes:
> Can you post the error you get, or describe the problem you have?
This is probably unrelated, but this message pops up when I launch the
gui:
#<procedure this ((name . rest) (apply (or (hashq-ref methods name) (any (lambd\a (super) (-> super get-method name)) supers) (lambda x (format #t "No such met\hod: \"~A\" in class \"~A\".~%" name this->class-name))) rest))>
I get this error, hitting the "Close" button:
No such method: "volume" in class "<realtime>".
snd-error!
vct-ref: wrong-type-arg: Wrong type argument in position 1 (expecting "a vct"): #t (#t)
In unknown file:
?: 0* [#<procedure #f ((w data) (callback))> (GtkWidget_ 150339272) #f]
In /usr/local/snd-ls/snd-8/gui.scm:
1500: 1* [exit-synth]
In unknown file:
?: 2* [stop-all #f]
?: 3* [for-each #<procedure #f # #]
?: 4* [#<procedure #f (# #)> #<procedure this (# #)>]
?: 5* [write-glide-var #t 0.0]
In /usr/local/snd-ls/snd-8/rt-compiler.scm:
6388: 6* [vct-set! #t 2 ...
6389: 7* (if (> val (vct-ref var 0)) (vct-ref var 3) (- (vct-ref var 3)))
6389: 8* [> 0.0 ...
6389: 9* [vct-ref #t 0]
; gxg_func2
vct-ref: wrong-type-arg: Wrong type argument in position 1 (expecting "a vct"): #t (#t)
In unknown file:
?: 0* [#<procedure #f ((w data) (callback))> (GtkWidget_ 150339272) #f]
In /usr/local/snd-ls/snd-8/gui.scm:
1500: 1* [exit-synth]
In unknown file:
?: 2* [stop-all #f]
?: 3* [for-each #<procedure #f # #]
?: 4* [#<procedure #f (# #)> #<procedure this (# #)>]
?: 5* [write-glide-var #t 0.0]
In /usr/local/snd-ls/snd-8/rt-compiler.scm:
6388: 6* [vct-set! #t 2 ...
6389: 7* (if (> val (vct-ref var 0)) (vct-ref var 3) (- (vct-ref var 3)))
6389: 8* [> 0.0 ...
6389: 9* [vct-ref #t 0]
; gxg_func2
..and the window does not close. If I comment out (stop-all #f) it
does close, but then it's still active.
The code is still the same, but here it is, again:
(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