1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
|
;;; backwards compatibility for snd 11
;;; -------- with-mix --------
;;;
;;; weird syntax = with-mix (with-sound-args) file-name start-in-output &body body
;;;
;;; (with-sound ()
;;; (with-mix () "section-1" 0 (fm-violin 0 1 440 .1)
;;; (fm-violin 1 2 660 .1))
;;; ...)
(define (with-mix-find-file-with-extensions file extensions)
"(with-mix-find-file-with-extensions file extensions) helps the with-mix macro find checkpoint files"
(if (file-exists? file)
file
(call-with-exit
(lambda (found-one)
(for-each
(lambda (ext)
(let ((new-file (string-append file "." ext)))
(if (file-exists? new-file)
(found-one new-file))))
extensions)
#f))))
(define (with-mix-file-extension file default)
"(with-mix-file-extension file default) is a helper function for the with-mix macro"
(let ((len (string-length file)))
(call-with-exit
(lambda (ok)
(do ((i (- len 1) (- i 1)))
((= i 0))
(if (char=? (string-ref file i) #\.)
(ok (substring file (+ 1 i) len))))
default))))
(defmacro with-mix (options ur-chkpt-file ur-beg . body)
`(let ((chkpt-file ,ur-chkpt-file)
(beg-1 ,ur-beg))
(if (not (list? ',options))
(throw 'with-sound-interrupt (format #f "with-mix options list (arg 1) is ~A?~%;" ',options))
(if (not (string? chkpt-file))
(throw 'with-sound-interrupt (format #f "with-mix file (arg 2) is ~A?~%;" ,ur-chkpt-file))
(if (not (number? beg-1))
(throw 'with-sound-interrupt (format #f "with-mix begin time (arg 3) for ~S = ~A?~%;" chkpt-file beg-1))
(let ((beg (round (* (mus-srate) beg-1))))
(if (null? ',body)
(mus-mix *output* chkpt-file beg)
(let* ((call-str (object->string ',body))
(option-str (object->string ',options))
(sndf (with-mix-find-file-with-extensions chkpt-file (list (with-mix-file-extension *clm-file-name* "snd") "snd")))
(revf (and sndf *reverb* (with-mix-find-file-with-extensions chkpt-file (list "rev"))))
(mix-values (and sndf
(or (not *reverb*)
revf)
(let ((comment (mus-sound-comment sndf)))
(and (string? comment)
(catch #t
(lambda ()
(eval-string comment))
(lambda args #f))))))) ; any error means we lost
(if (and sndf
(or (not *reverb*)
revf)
(list? mix-values)
(= (length mix-values) 2)
(string? (car mix-values))
(string? (cadr mix-values))
(string=? (car mix-values) option-str)
(string=? (cadr mix-values) call-str))
(begin
(if *clm-verbose* (snd-print (format #f "mix ~S at ~,3F~%" sndf beg)))
(mus-mix *output* sndf beg)
(if revf (mus-mix *reverb* revf beg)))
;; else recompute
(let ((old-to-snd *to-snd*))
(set! *to-snd* #f)
(if *clm-verbose* (snd-print (format #f "remake ~S at ~,3F~%" chkpt-file beg)))
(let ((new-sound
(apply with-sound-helper
(lambda () ,@body)
(append (list :output
(string-append chkpt-file "." (with-mix-file-extension *clm-file-name* "snd")))
(list :comment
(format #f "(begin~%;; written ~A (Snd: ~A)~%(list ~S ~S))~%"
(strftime "%a %d-%b-%Y %H:%M %Z" (localtime (current-time)))
(snd-version)
option-str
call-str))
(if (and (> (channels *output*) 1)
(not (member :channels ',options)))
(list :channels (channels *output*))
'())
',options))))
(set! *to-snd* old-to-snd)
(mus-mix *output* new-sound beg)
(if revf (mus-mix *reverb* revf beg)))))))))))))
#|
;;; this is the with-mix documentation:
<br>
<table border=0 bordercolor="lightgreen" width=50% cellpadding=1 cellspacing=0><tr><td bgcolor="lightgreen">
<table width=100% border=0><tr><td bgcolor="#EEFDEE" valign="middle"><h4>with-mix</h4></td></tr></table>
</td></tr></table>
<p><a name="with-mix">with-mix</a> is a "checkpointing" version of with-sound, more useful in the bad old days when computers
were incredibly slow, but lingering on...
It is a macro, callable within <a href="#wsdoc">with-sound</a> or <a href="#clmload">clm-load</a>,
which saves the computation in its body in a separate file, and
then upon a subsequent recomputation, tries to tell (via a string comparison) when that file's data is up to date
and does not need to be recomputed.
</p>
<table border=0 hspace=40 cellpadding=8 cellspacing=3><tr><td>
<pre>
(<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> ()
(fm-violin 0 .1 440 .1)
(<em class=red>with-mix</em> () "sec1" .5
(fm-violin 0 .1 550 .1)
(fm-violin .1 .1 660 .1))
(<em class=red>with-mix</em> (:reverb jc-reverb) "sec2" 1.0
(fm-violin 0 .1 880 .1 :reverb-amount .2)
(fm-violin .1 .1 1320 .1 :reverb-amount .2))
(fm-violin 2 .1 220 .1)
(<em class=red>mix</em> "/zap/slow.snd"))
</pre>
</td></tr></table>
<p>Now, if we change just the first note in the with-mix call, the
second with-mix section will not be recomputed, but will be mixed in from the
saved file "sec2.snd".
In the old days, when notes took hours to compute, this was a big deal,
but not anymore.
</p>
|#
;;; --------------------------------------------------------------------------------
(define (focus-follows-mouse) (set! (with-pointer-focus) #t))
(define (make-current-window-display) (set! (with-inset-graph) #t))
(define load-from-path load)
;(define def-optkey-fun define*)
;(define def-optkey-instrument definstrument)
(define spectro-cutoff spectrum-start)
(define spectro-end spectrum-end)
(define* (play-region reg wait stop-func)
(play (if (integer? reg) (integer->region reg) reg) :wait wait :stop stop-func))
(define* (play-selection wait stop-func)
(play (selection) :wait wait :stop stop-func))
(define* (play-mix id (beg 0))
(play (if (integer? id) (integer->mix id) id) beg))
(define* (play-and-wait (start 0) snd chn syncd end (pos -1) stop-proc)
(if (string? start)
(play start (or snd 0) :end (or chn -1) :wait #t)
(play (if (integer? snd) (integer->sound snd)
(if (sound? snd) snd
(or (selected-sound) (car (sounds)))))
:channel (or chn -1) :wait #t :with-sync syncd :start start :end (or end -1)
:stop stop-proc :edit-position pos)))
(define* (old-play (start 0) snd chn syncd end (pos -1) stop-proc (out-chan -1))
(play (if (integer? snd) (integer->sound snd)
(if (sound? snd) snd
(or (selected-sound) (car (sounds)))))
:channel (or chn -1) :with-sync syncd :start start :end (or end -1)
:stop stop-proc :out-channel out-chan :edit-position pos))
(define* (play-channel (beg 0) dur snd chn (pos -1) stop-proc (out-chan -1))
(play (if (integer? snd) (integer->sound snd)
(if (sound? snd) snd
(or (selected-sound) (car (sounds)))))
:channel (or chn -1) :with-sync #f :start beg :end (if dur (+ beg dur) -1)
:stop stop-proc :out-channel out-chan :edit-position pos))
|
