interpretor/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;