Merge branch 'master' of https://scm.cri.ensmp.fr/git/Faustine
[Faustine.git] / interpreter / preprocessor / faust-0.9.47mr3 / tools / faust2pd / faust2pd.pure
1 #! /usr/local/bin/pure -x
2
3 /* Copyright (c) 2009 by Albert Graef.
4
5 This is free software; you can redistribute it and/or modify it under the
6 terms of the GNU General Public License as published by the Free Software
7 Foundation; either version 3, or (at your option) any later version.
8
9 This software is distributed in the hope that it will be useful, but
10 WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
11 or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
12 more details.
13
14 You should have received a copy of the GNU General Public License along
15 with this program. If not, see <http://www.gnu.org/licenses/>. */
16
17 // This is set at build time.
18 let version = "@version@";
19
20 using dict, faustxml, getopt, regex, system;
21 using namespace faustxml;
22
23 /* Constructors to represent Pd messages and objects. */
24
25 public obj msg text connect coords send receive route
26 bng tgl nbx hsl vsl hradio vradio;
27
28 send = s;
29 receive = r;
30
31 /* Merge subpatches. */
32
33 merge a b = a+map (shift (nobjs a)) b with
34 shift n (connect x i y j)
35 = connect (x+n) i (y+n) j;
36 shift _ x = x otherwise;
37 nobjs objs = #filter isobj objs;
38 isobj (f@_ x) = isobj f;
39 isobj x = any ((===)x) [obj,msg,text] otherwise;
40 end;
41
42 /* Move subpatches on the canvas. */
43
44 move dx dy objs = map (move dx dy) objs if listp objs;
45 move dx dy (obj x y)
46 = obj (x+dx) (y+dy);
47 move dx dy (msg x y)
48 = msg (x+dx) (y+dy);
49 move dx dy (f@_ x)
50 = move dx dy f x;
51 move dx dy x = x otherwise;
52
53 /* Write dsp and synth patches to a file. */
54
55 write_dsp info outname
56 = fputs "#N canvas 0 0 450 300 10;\n" f $$
57 do (write_obj f) objs
58 when name,_ = info;
59 outname = if null outname then name+".pd" else outname;
60 f = fopen outname "w";
61 if pointerp f then ()
62 else throw $ outname+strerror errno;
63 objs = make_dsp info;
64 end;
65
66 write_synth n info outname
67 = fputs "#N canvas 0 0 450 300 10;\n" f $$
68 do (write_obj f) objs
69 when name,_ = info;
70 outname = if null outname then name+".pd" else outname;
71 f = fopen outname "w";
72 if pointerp f then ()
73 else throw $ outname+strerror errno;
74 objs = make_synth n info;
75 end;
76
77 write_obj f x = fprintf f "#X %s;\n" $ obj_str x;
78
79 obj_str (f@_ x::string)
80 = obj_str f if null x;
81 = obj_str f+" \\"+x if x!0 == "$";
82 = obj_str f+" "+x otherwise;
83 obj_str (f@_ x::int)
84 = obj_str f+sprintf " %d" x otherwise;
85 obj_str (f@_ x::double)
86 = obj_str f+sprintf " %g" x otherwise;
87 obj_str (f@_ x) = obj_str f+" "+str x;
88 obj_str f = str f otherwise;
89
90 /* Construct dsp and synth patches. */
91
92 comment y = [text 0 (y+10) $ sprintf "Generated %s by faust2pd v%s. \
93 See http://faust.grame.fr and http://pure-lang.googlecode.com."
94 (strftime "%c" (localtime time),version)];
95
96 make_dsp (name,descr,version,in,out,layout)
97 = merge dsp controls +
98 (if null controls then []
99 else [coords 0 (-1) 1 1 x (y-10) 1 0 0]) +
100 comment y
101 when controls = filter is_dsp_control $
102 pdcontrols layout; k = #controls;
103 x,y,controls = make_controls layout controls;
104 dsp = move 10 (y+60) $
105 make_simple (name+"~") in out;
106 end;
107
108 make_synth n (name,descr,version,in,out,layout)
109 = merge voices controls +
110 (if null controls then []
111 else [coords 0 (-1) 1 1 x (y-10) 1 0 0]) +
112 comment y
113 when controls = filter is_voice_control $
114 pdcontrols layout; k = #controls;
115 x,y,controls = make_controls layout controls;
116 voices = move 10 (y+60) $
117 make_voices (name+"~") out n;
118 end;
119
120 // check for the "active" control which is treated specially
121 is_dsp_control c
122 = name~="active"
123 when name = last $ split "/" $ control_label c end;
124
125 // check for "active" and special voice controls (freq/gain/gate) which
126 // shouldn't be exposed in the GUI
127 is_voice_control c
128 = ~any ((==)name) ["active","freq","gain","gate"]
129 when name = last $ split "/" $ control_label c end;
130
131 /* Create the dsp subpatch. */
132
133 make_simple dsp in out
134 = // -- objects --
135
136 [obj (i*60) 0 "inlet~" | // 0..in-1 inlet~
137 i = 1..in] +
138 [obj 0 0 "inlet", // in inlet
139 obj (max 2 (in+1)*60) 0 receive "$0-read", // in+1 receive $0-read
140 obj (max 2 (in+1)*60) 30 "faust-control" "$0",
141 // in+2 faust-control $0
142 obj (max 2 (in+1)*60) 60 send "$0-write", // in+3 s $0-write
143 obj 0 60 receive "$0-in", // in+4 receive $0-in
144 obj 0 90 dsp, // in+5 dsp
145 obj 0 120 send "$0-out"] + // in+6 s $0-out
146 [obj (i*60) 150 "outlet~" | // in+7..in+7+out-1
147 i = 1..out] + // outlet~
148 [obj 0 150 "outlet"] + // in+7+out outlet
149
150 // -- connections --
151
152 [connect in 0 (in+2) 0, // inlet -> faust-control
153 connect (in+1) 0 (in+2) 0, // receive $0-read -> faust-control
154 connect (in+2) 0 (in+3) 0, // faust-control -> s $0-write
155 connect (in+5) 0 (in+6) 0, // dsp -> s $0-out
156 connect in 0 (in+7+out) 0, // inlet -> outlet
157 connect (in+4) 0 (in+5) 0] + // receive $0-in -> dsp
158 [connect (i-1) 0 (in+5) i | // inlet~ -> dsp
159 i = 1..in] +
160 [connect (in+5) i (in+7+i-1) 0 | // dsp -> outlet~
161 i = 1..out];
162
163 /* Create the synth subpatch. */
164
165 make_voices dsp out n
166 = // -- objects --
167
168 [obj 0 0 "inlet", // 0 inlet #1
169 obj 120 0 "inlet", // 1 inlet #2
170 obj 180 0 receive "$0-read", // 2 r $0-read
171 obj 120 30 receive "$0-all", // 3 r $0-all
172 obj 180 30 "faust-control" "$0", // 4 faust-control $0
173 obj 180 60 send "$0-write", // 5 s $0-write
174 obj 120 60 receive "$0-in", // 6 r $0-in
175 obj 120 ((n+1)*30+60) send "$0-out"] + // 7 s $0-out
176 cat [[obj 0 (i*30+60) "faust-gate" i, // 8,10..2*n+6 faust-gate 1..n
177 obj 120 (i*30+60) dsp] | // 9,11..2*n+7 dsp #1..n
178 i = 1..n] +
179 [obj (i*60+120) ((n+1)*30+90) "outlet~" | // 2*n+8..2*n+8+out-1
180 i = 0..out-1] + // outlet~ #1..n
181 [obj 0 ((n+1)*30+90) "outlet"] + // 2*n+8+out outlet
182
183 // -- connections --
184
185 [connect 1 0 4 0, // inlet #2 -> faust-control
186 connect 2 0 4 0, // r $0-read -> faust-control
187 connect 4 0 5 0, // faust-control -> s $0-write
188 connect 1 0 (2*n+8+out) 0, // inlet #2 -> outlet
189 connect 6 0 9 0, // r $0-in -> dsp #1
190 connect 9 0 7 0] + // dsp #1 -> s $0-out
191 cat [[connect 0 0 (2*i+8) 0, // inlet #1 -> faust-gate 1..n
192 connect (2*i+8) 0 (2*i+9) 0, // faust-gate 1..n -> dsp #1..n
193 connect 3 0 (2*i+9) 0] | // r $0-all -> dsp #1..n
194 i = 0..n-1] +
195 [connect (2*i+9) (j+1) (2*n+8+j) 0 | // dsp #1..n -> outlet~ #1..n
196 i = 0..n-1; j = 0..out-1];
197
198 /* Create the GUI+controls subpatch. */
199
200 const black = -1;
201 const white = -0x40000;
202 const gray = -0x38e39;
203
204 /* FIXME: The following is mostly guesswork, so you might have to customize
205 this. Maybe these values should be configurable from the command line, or a
206 better layout algorithm should be designed which also takes into account
207 the widget labels. */
208
209 const button_x,button_y = 50,30;
210 const nentry_x,nentry_y = 75,30;
211 const hslider_x,hslider_y = 150,30;
212 const vslider_x,vslider_y = 50,150;
213
214 make_controls layout controls
215 = x,y,c
216 if ~null gui
217 when x,y,gui = make_gui layout;
218 c = move (max 450 (x+30)) 10 $
219 make_control_objs controls;
220 c = merge gui c;
221 end;
222 = 0,0,[] otherwise;
223
224 /* Create the GUI subpatch. */
225
226 let fn1,fn2 = 10,10; // default GUI font sizes, adapt as needed
227
228 make_gui layout = x,y,c+
229 [obj (x-38) 3 bng 15 250 50 1 "$0-init" "$0-ignore"
230 "empty" 0 (-6) 0 fn1 white black black,
231 obj (x-18) 3 tgl 15 1 "$0-active" "$0-active"
232 "empty" 0 (-6) 0 fn1 white black black 1 1]
233 if ~null c
234 when x,y,c = make_group "" (10,30) layout end;
235 = 0,0,[] otherwise;
236
237 make_group path (x,y) (tgroup g)
238 = make_group path (x,y) (hgroup g);
239 make_group path (x,y) (hgroup (name,items))
240 = //printf "end %s\n" $ join2 path $ mangle name $$
241 x,y,cat (reverse c)
242 when _,_,_,_,x,y,c =
243 //printf "hgroup %s\n" $ join2 path $ mangle name $$
244 foldl (hstep (make_group (join2 path (mangle name))))
245 (x,y,x,y,x,y,[]) items;
246 end;
247 make_group path (x,y) (vgroup (name,items))
248 = //printf "end %s\n" $ join2 path $ mangle name $$
249 x,y,cat (reverse c)
250 when _,_,_,_,x,y,c =
251 //printf "vgroup %s\n" $ join2 path $ mangle name $$
252 foldl (vstep (make_group (join2 path (mangle name))))
253 (x,y,x,y,x,y,[]) items;
254 end;
255 make_group path (x,y) item
256 = //printf "%s [%s] item %s\n" (str (x,y),path,str item) $$
257 add_widget path (x,y) item;
258
259 hstep f (x0,y0,x1,y1,x2,y2,c) item
260 = hbreak f (x0,y0,x1,y1,x2,y2,c) item (x,y,c1)
261 when x,y,c1 = f (x1,y1) item end;
262 hbreak f (x0,y0,x1,y1,x2,y2,c) item (x,y,c1)
263 = x0,y0,x,y1,max x2 x,max y2 y,c1:c
264 if width<=0 || x<=width || x1<=x0;
265 = hbreak f (x0,y0,x0,y2,x2,y2,c) item (f (x0,y2) item);
266 vstep f (x0,y0,x1,y1,x2,y2,c) item
267 = vbreak f (x0,y0,x1,y1,x2,y2,c) item (x,y,c1)
268 when x,y,c1 = f (x1,y1) item end;
269 vbreak f (x0,y0,x1,y1,x2,y2,c) item (x,y,c1)
270 = x0,y0,x1,y,max x2 x,max y2 y,c1:c
271 if height<=0 || y<=height || y1<=y0;
272 = vbreak f (x0,y0,x2,y0,x2,y2,c) item (f (x2,y0) item);
273
274 checkname name = "empty" if null name;
275 = name otherwise;
276
277 match_control path name pat
278 = fnmatch pat (join2 path name) 0 if index pat "/" >= 0;
279 = fnmatch pat name 0 otherwise;
280
281 let gmax = max;
282 add_widget path (x,y) item
283 = x,y,[]
284 if null (join2 path name) ||
285 any (match_control path name) exclude
286 when name = mangle $ control_label item end;
287 add_widget path (x,y) (button name)
288 = add_widget path (x,y) (checkbox name) if fake_buttons_flag;
289 add_widget path (x,y) (button name)
290 = x+button_x,y+button_y,
291 [obj x y bng 15 250 50 0 s s
292 name 0 (-6) 0 fn1 white black black]
293 when name = mangle name;
294 s = control_sym $ join2 path name;
295 name = checkname name;
296 end
297 if nvoices==0 ||
298 ~any ((==)name) ["freq","gain","gate"];
299 add_widget path (x,y) (checkbox name)
300 = x+button_x,y+button_y,
301 [obj x y tgl 15 0 s s
302 name 0 (-6) 0 fn1 white black black 0 1]
303 when name = mangle name;
304 s = control_sym $ join2 path name;
305 name = checkname name;
306 end
307 if nvoices==0 ||
308 ~any ((==)name) ["freq","gain","gate"];
309 add_widget path (x,y) (nentry (name,init,min,max,_))
310 = x+nentry_x,y+nentry_y,
311 [obj x y nbx 5 14 min max 0 0 s s
312 name 0 (-6) 0 fn2 white black black 256]
313 when name = mangle name;
314 s = control_sym $ join2 path name;
315 name = checkname name;
316 end
317 if nvoices==0 ||
318 ~any ((==)name) ["freq","gain","gate"];
319 add_widget path (x,y) (hslider (name,init,min,max,step))
320 = if radio_sliders>0 && min==0 &&
321 step==1 && max<radio_sliders then
322 x+gmax hslider_x (radio_sliders*15),y+hslider_y,
323 [obj x y hradio 15 1 0 (max+1) s s
324 name 0 (-6) 0 fn1 white black black 0]
325 else if slider_nums_flag then
326 x+hslider_x+nentry_x,y+hslider_y,
327 [obj x y hsl 128 15 min max 0 0 s s
328 name (-2) (-6) 0 fn1 white black black 0 1,
329 obj (x+hslider_x) y nbx 5 14 min max 0 0 s s
330 "empty" 0 (-6) 0 fn2 white black black 256]
331 else
332 x+hslider_x,y+hslider_y,
333 [obj x y hsl 128 15 min max 0 0 s s
334 name (-2) (-6) 0 fn1 white black black 0 1]
335 when name = mangle name;
336 s = control_sym $ join2 path name;
337 name = checkname name;
338 end
339 if nvoices==0 ||
340 ~any ((==)name) ["freq","gain","gate"];
341 add_widget path (x,y) (vslider (name,init,min,max,step))
342 = if radio_sliders>0 && min==0 &&
343 step==1 && max<radio_sliders then
344 x+vslider_x,y+gmax vslider_y (radio_sliders*15),
345 [obj x y vradio 15 1 0 (max+1) s s
346 name 0 (-6) 0 fn1 white black black 0]
347 else if slider_nums_flag then
348 x+nentry_x,y+vslider_y+nentry_y,
349 [obj x y vsl 15 128 min max 0 0 s s
350 name 0 (-8) 0 fn1 white black black 0 1,
351 obj x (y+vslider_y-10) nbx 5 14 min max 0 0 s s
352 "empty" 0 (-6) 0 fn2 white black black 256]
353 else
354 x+vslider_x,y+vslider_y,
355 [obj x y vsl 15 128 min max 0 0 s s
356 name 0 (-8) 0 fn1 white black black 0 1]
357 when name = mangle name;
358 s = control_sym $ join2 path name;
359 name = checkname name;
360 end
361 if nvoices==0 ||
362 ~any ((==)name) ["freq","gain","gate"];
363 add_widget path (x,y) (hbargraph (name,min,max))
364 = if slider_nums_flag then
365 x+hslider_x+nentry_x,y+hslider_y,
366 [obj x y hsl 128 15 min max 0 0 s s
367 name (-2) (-6) 0 fn1 gray black black 0 1,
368 obj (x+hslider_x) y nbx 5 14 min max 0 0 s s
369 "empty" 0 (-6) 0 fn2 gray black black 256]
370 else
371 x+hslider_x,y+hslider_y,
372 [obj x y hsl 128 15 min max 0 0 s s
373 name (-2) (-6) 0 fn1 gray black black 0 1]
374 when name = mangle name;
375 s = control_sym $ join2 path name;
376 name = checkname name;
377 end
378 if nvoices==0 ||
379 ~any ((==)name) ["freq","gain","gate"];
380 add_widget path (x,y) (vbargraph (name,min,max))
381 = if slider_nums_flag then
382 x+nentry_x,y+vslider_y+nentry_y,
383 [obj x y vsl 15 128 min max 0 0 s s
384 name 0 (-8) 0 fn1 gray black black 0 1,
385 obj x (y+vslider_y-10) nbx 5 14 min max 0 0 s s
386 "empty" 0 (-6) 0 fn2 gray black black 256]
387 else
388 x+vslider_x,y+vslider_y,
389 [obj x y vsl 15 128 min max 0 0 s s
390 name 0 (-8) 0 fn1 gray black black 0 1]
391 when name = mangle name;
392 s = control_sym $ join2 path name;
393 name = checkname name;
394 end
395 if nvoices==0 ||
396 ~any ((==)name) ["freq","gain","gate"];
397 add_widget _ (x,y) _
398 = x,y,[] otherwise;
399
400 /* Create the control objects and wiring. */
401
402 make_control_objs controls
403 = [obj 0 0 receive "$0-init",
404 obj dx 0 send (if nvoices>0 then "$0-all" else "$0-in"),
405 obj (dx+dx div 2) 0 send "$0-read",
406 obj (2*dx) 0 receive "$0-write"] + c
407 when controls = checkbox "active":controls;
408 dx = foldl max 0 $ map ((#).control_label) controls;
409 dx = (dx+7)*8;
410 _,c = foldl (control_objs dx) (0,[]) controls;
411 end;
412
413 control_objs dx (j,c) (button name)
414 = control_objs dx (j,c) (checkbox name) if fake_buttons_flag;
415 control_objs dx (j,c) (button name)
416 = (j+1,c+button_control_objs dx j name s 0)
417 when s = control_sym name end;
418 control_objs dx (j,c) (checkbox "active")
419 = (j+1,c+activate_control_objs dx j "active" s 1)
420 when s = control_sym "active" end;
421 control_objs dx (j,c) (checkbox name)
422 = (j+1,c+active_control_objs dx j name s 0)
423 when s = control_sym name end;
424 control_objs dx (j,c) (nentry (name,init,_))
425 = (j+1,c+active_control_objs dx j name s init)
426 when s = control_sym name end;
427 control_objs dx (j,c) (hslider (name,init,_))
428 = (j+1,c+active_control_objs dx j name s init)
429 when s = control_sym name end;
430 control_objs dx (j,c) (vslider (name,init,_))
431 = (j+1,c+active_control_objs dx j name s init)
432 when s = control_sym name end;
433 control_objs dx (j,c) (hbargraph (name,_))
434 = (j+1,c+passive_control_objs dx j name s 0)
435 when s = control_sym name end;
436 control_objs dx (j,c) (vbargraph (name,_))
437 = (j+1,c+passive_control_objs dx j name s 0)
438 when s = control_sym name end;
439 control_objs _ (j,c) _
440 = (j,c) otherwise;
441
442 control_sym name
443 = sprintf "$0-%s" $ substr name 1 (#name-1) if name!0=="/";
444 = sprintf "$0-%s" name otherwise;
445
446 activate_control_objs dx j name s init
447 = [msg 0 ((2*j+1)*20) init,
448 obj 0 ((2*j+2)*20) send s,
449 //connect 0 0 (6*j+4) 0,
450 connect (6*j+4) 0 (6*j+5) 0,
451 obj dx ((2*j+1)*20) receive s,
452 msg dx ((2*j+2)*20) name "$1",
453 connect (6*j+6) 0 (6*j+7) 0,
454 connect (6*j+7) 0 1 0,
455 obj (2*dx) ((2*j+1)*20) route name,
456 obj (2*dx) ((2*j+2)*20) send s,
457 connect (if j>0 then 6*j+2 else 3)
458 (if j>0 then 1 else 0) (6*j+8) 0,
459 connect (6*j+8) 0 (6*j+9) 0];
460
461 active_control_objs dx j name s init
462 = [msg 0 ((2*j+1)*20) init,
463 obj 0 ((2*j+2)*20) send s,
464 connect 0 0 (6*j+4) 0,
465 connect (6*j+4) 0 (6*j+5) 0,
466 obj dx ((2*j+1)*20) receive s,
467 msg dx ((2*j+2)*20) name "$1",
468 connect (6*j+6) 0 (6*j+7) 0,
469 connect (6*j+7) 0 1 0,
470 obj (2*dx) ((2*j+1)*20) route name,
471 obj (2*dx) ((2*j+2)*20) send s,
472 connect (if j>0 then 6*j+2 else 3)
473 (if j>0 then 1 else 0) (6*j+8) 0,
474 connect (6*j+8) 0 (6*j+9) 0];
475
476 button_control_objs dx j name s init
477 = [msg 0 ((2*j+1)*20) init,
478 obj 0 ((2*j+2)*20) "faust-s" s,
479 connect 0 0 (6*j+4) 0,
480 connect (6*j+4) 0 (6*j+5) 0,
481 obj dx ((2*j+1)*20) receive s,
482 obj dx ((2*j+2)*20) "faust-r" name,
483 connect (6*j+6) 0 (6*j+7) 0,
484 connect (6*j+7) 0 1 0,
485 obj (2*dx) ((2*j+1)*20) route name,
486 obj (2*dx) ((2*j+2)*20) "faust-s" s,
487 connect (if j>0 then 6*j+2 else 3)
488 (if j>0 then 1 else 0) (6*j+8) 0,
489 connect (6*j+8) 0 (6*j+9) 0];
490
491 passive_control_objs dx j name s init
492 = [msg 0 ((2*j+1)*20) init,
493 obj 0 ((2*j+2)*20) send s,
494 connect 0 0 (6*j+4) 0,
495 connect (6*j+4) 0 (6*j+5) 0,
496 obj dx ((2*j+1)*20) "faust-timer" "$0",
497 msg dx ((2*j+2)*20) name,
498 connect (6*j+6) 0 (6*j+7) 0,
499 connect (6*j+7) 0 2 0,
500 obj (2*dx) ((2*j+1)*20) route name,
501 obj (2*dx) ((2*j+2)*20) send s,
502 connect (if j>0 then 6*j+2 else 3)
503 (if j>0 then 1 else 0) (6*j+8) 0,
504 connect (6*j+8) 0 (6*j+9) 0];
505
506 /* Make control names as in faustxml.pure but with name mangling and "/" in
507 front. */
508
509 mangle s = join "-" $ filter (\x->~null x) $
510 regsplit "[^A-Za-z0-9]+" REG_EXTENDED s 0
511 when
512 s = strcat $ regsplit "[ \t]*\\[[^]]+\\][ \t]*" REG_EXTENDED s 0;
513 end;
514
515 pdcontrols x = filter (((~=)"/").control_label) $ controls "" x with
516 controls path x
517 = case x of
518 f@_ (lbl::string,ctrls@[]) |
519 f@_ (lbl::string,ctrls@(_:_))
520 = catmap (controls (join2 path lbl)) ctrls
521 when lbl = mangle lbl end;
522 f@_ (lbl::string,args)
523 = [f (join2 path lbl,args)]
524 when lbl = mangle lbl end;
525 f@_ lbl::string
526 = [f (join2 path lbl)]
527 when lbl = mangle lbl end;
528 end;
529 end if controlp x;
530
531 join2 "" s = "/"+s;
532 join2 s "" = s;
533 join2 s t = s+"/"+t otherwise;
534
535 /* main program */
536
537 error msg::string
538 = fprintf stderr "%s: %s\n" (prog,msg) $$ exit 1;
539 error x = fprintf stderr "%s: unknown error (%s)\n" (prog,str x) $$
540 exit 1;
541
542 invalid_option opt
543 = error $ sprintf "invalid option %s, try -h for help" opt;
544
545 invalid_src_option opt
546 = error $ sprintf "invalid option %s in source" opt;
547
548 get_set_opt opt = case myopts!![opt] of
549 [val::string] = split "," val;
550 _ = [] otherwise;
551 end;
552
553 get_int_opt opt = case myopts!![opt] of
554 [val::string] = check_int_opt opt val if ~null val;
555 _ = 0 otherwise;
556 end;
557
558 extern int atoi(char*);
559 check_int_opt opt val
560 = n if n>0 when n = atoi val end;
561 = error $ sprintf "invalid option value %s %s" (opt,val);
562
563 print_usage prog
564 = printf
565 "faust2pd version %s, Copyright (c) 2009 by Albert Graef\n\
566 Usage: %s [-hVbs] [-f size] [-o output-file] [-n #voices]\n\
567 [-r max] [-X patterns] [-x width] [-y height] input-file\n\
568 Options:\n\
569 -h, --help display this help message and exit\n\
570 -V, --version display the version number and exit\n\
571 -b, --fake-buttons replace buttons (bangs) with checkboxes (toggles)\n\
572 -f, --font-size font size for GUI elements (10 by default)\n\
573 -n, --nvoices create a synth patch with the given number of voices\n\
574 -o, --output-file output file name ('.pd' file)\n\
575 -r, --radio-sliders radio controls for sliders with values 0..max-1\n\
576 -s, --slider-nums sliders with additional number control\n\
577 -X, --exclude exclude controls matching the given glob patterns\n\
578 -x, --width maximum width of the GUI area\n\
579 -y, --height maximum height of the GUI area\n\
580 input-file input file name ('.dsp.xml' file)\n\
581 Default output-file is input-file with new extension '.pd'.\n"
582 (version,prog) $$ exit 0;
583
584 print_version = printf
585 "faust2pd version %s, Copyright (c) 2009 by Albert Graef\n" version $$
586 exit 0;
587
588 let opts = [("--help", "-h", NOARG),
589 ("--version", "-V", NOARG),
590 ("--fake-buttons", "-b", NOARG),
591 ("--slider-nums", "-s", NOARG),
592 ("--radio-sliders", "-r", REQARG),
593 ("--nvoices", "-n", REQARG),
594 ("--font-size", "-f", REQARG),
595 ("--width", "-x", REQARG),
596 ("--height", "-y", REQARG),
597 ("--exclude", "-X", REQARG),
598 ("--output-file", "-o", REQARG)];
599
600 //let compiling = 1;
601 //let argv = ["faust2pd","test/organ.dsp.xml"];
602 let prog,myargs = case argv of prog:args = prog,args; _ = "faust2pd",[] end;
603
604 //let prog = "faust2pd";
605
606 let myopts,myargs = catch invalid_option $ getopt opts myargs;
607 let myopts = dict myopts;
608 let help_flag = member myopts "--help";
609 let version_flag = member myopts "--version";
610
611 if compiling then
612 ()
613 else if version_flag then
614 print_version
615 else if help_flag then
616 print_usage prog
617 else if null myargs then
618 error "no source file specified, try -h for help"
619 else if #myargs>1 then
620 error "more than one source file specified, try -h for help"
621 else ();
622
623 let xmlname:_ = if compiling then [""] else myargs;
624
625 let outname = if member myopts "--output-file" then
626 myopts!"--output-file"
627 else ();
628
629 if outname===xmlname then
630 error "output would overwrite source file, aborting"
631 else ();
632
633 attrs s = regexg (\info->info!3) "\\[pd:([^]]+)\\]" REG_EXTENDED s 0;
634
635 let dsp_info => (src_opts,_) =
636 if compiling then () => ([],[])
637 else
638 (dsp_info => catch invalid_src_option (getopt opts src_opts) when
639 setlocale LC_ALL "C";
640 dsp_info = catch error (faustxml::info xmlname);
641 src_opts = case dsp_info!5 of
642 _ (label,_) = ["--"+opt | opt = attrs label];
643 _ = [];
644 end;
645 end);
646
647 /* Command line options always override what's in the source. */
648 let myopts = dict (src_opts+members myopts);
649
650 let fake_buttons_flag = member myopts "--fake-buttons";
651 let slider_nums_flag = member myopts "--slider-nums";
652 let [radio_sliders,nvoices,height,width,fnsize] = map get_int_opt
653 ["--radio-sliders","--nvoices","--height","--width","--font-size"];
654 let exclude = get_set_opt "--exclude";
655
656 let fn1,fn2 = if fnsize>0 then fnsize,fnsize else fn1,fn2;
657
658 main = catch error mainprog $$ exit 0;
659 mainprog = write_synth nvoices dsp_info outname if nvoices>0;
660 = write_dsp dsp_info outname otherwise;
661
662 if compiling then () else main;