#! /usr/local/bin/pure -x

/* Copyright (c) 2009 by Albert Graef.

   This is free software; you can redistribute it and/or modify it under the
   terms of the GNU General Public License as published by the Free Software
   Foundation; either version 3, or (at your option) any later version.

   This software is distributed in the hope that it will be useful, but
   WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
   or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
   more details.

   You should have received a copy of the GNU General Public License along
   with this program. If not, see <http://www.gnu.org/licenses/>. */

// This is set at build time.
let version = "@version@";

using dict, faustxml, getopt, regex, system;
using namespace faustxml;

/* Constructors to represent Pd messages and objects. */

public obj msg text connect coords send receive route
  bng tgl nbx hsl vsl hradio vradio;

send = s;
receive = r;

/* Merge subpatches. */

merge a b	= a+map (shift (nobjs a)) b with
  shift n (connect x i y j)
		= connect (x+n) i (y+n) j;
  shift _ x	= x otherwise;
  nobjs objs	= #filter isobj objs;
  isobj (f@_ x)	= isobj f;
  isobj x	= any ((===)x) [obj,msg,text] otherwise;
end;

/* Move subpatches on the canvas. */

move dx dy objs	= map (move dx dy) objs if listp objs;
move dx dy (obj x y)
		= obj (x+dx) (y+dy);
move dx dy (msg x y)
		= msg (x+dx) (y+dy);
move dx dy (f@_ x)
		= move dx dy f x;
move dx dy x	= x otherwise;

/* Write dsp and synth patches to a file. */

write_dsp info outname
		= fputs "#N canvas 0 0 450 300 10;\n" f $$
		  do (write_obj f) objs
		    when name,_ = info;
		      outname = if null outname then name+".pd" else outname;
		      f = fopen outname "w";
		      if pointerp f then ()
		      else throw $ outname+strerror errno;
		      objs = make_dsp info;
		    end;

write_synth n info outname
		= fputs "#N canvas 0 0 450 300 10;\n" f $$
		  do (write_obj f) objs
		    when name,_ = info;
		      outname = if null outname then name+".pd" else outname;
		      f = fopen outname "w";
		      if pointerp f then ()
		      else throw $ outname+strerror errno;
		      objs = make_synth n info;
		    end;

write_obj f x	= fprintf f "#X %s;\n" $ obj_str x;

obj_str (f@_ x::string)
		= obj_str f if null x;
		= obj_str f+" \\"+x if x!0 == "$";
		= obj_str f+" "+x otherwise;
obj_str (f@_ x::int)
		= obj_str f+sprintf " %d" x otherwise;
obj_str (f@_ x::double)
		= obj_str f+sprintf " %g" x otherwise;
obj_str (f@_ x)	= obj_str f+" "+str x;
obj_str f	= str f otherwise;

/* Construct dsp and synth patches. */

comment y	= [text 0 (y+10) $ sprintf "Generated %s by faust2pd v%s. \
See http://faust.grame.fr and http://pure-lang.googlecode.com."
		   (strftime "%c" (localtime time),version)];

make_dsp (name,descr,version,in,out,layout)
		= merge dsp controls +
		  (if null controls then []
		   else [coords 0 (-1) 1 1 x (y-10) 1 0 0]) +
		  comment y
		    when controls = filter is_dsp_control $
		      pdcontrols layout; k = #controls;
		      x,y,controls = make_controls layout controls;
		      dsp = move 10 (y+60) $
		      make_simple (name+"~") in out;
		    end;

make_synth n (name,descr,version,in,out,layout)
		= merge voices controls +
		  (if null controls then []
		   else [coords 0 (-1) 1 1 x (y-10) 1 0 0]) +
		  comment y
		    when controls = filter is_voice_control $
		      pdcontrols layout; k = #controls;
		      x,y,controls = make_controls layout controls;
		      voices = move 10 (y+60) $
		      make_voices (name+"~") out n;
		    end;

// check for the "active" control which is treated specially
is_dsp_control c
		= name~="active"
		    when name = last $ split "/" $ control_label c end;

// check for "active" and special voice controls (freq/gain/gate) which
// shouldn't be exposed in the GUI
is_voice_control c
		= ~any ((==)name) ["active","freq","gain","gate"]
		    when name = last $ split "/" $ control_label c end;

/* Create the dsp subpatch. */

make_simple dsp in out
=						// -- objects --

  [obj (i*60) 0 "inlet~" |			// 0..in-1	inlet~
   i = 1..in] +
  [obj 0 0 "inlet",				// in		inlet
   obj (max 2 (in+1)*60) 0 receive "$0-read",	// in+1		receive $0-read
   obj (max 2 (in+1)*60) 30 "faust-control" "$0",
						// in+2	      faust-control $0
   obj (max 2 (in+1)*60) 60 send "$0-write",	// in+3		s $0-write
   obj 0 60 receive "$0-in",			// in+4		receive $0-in
   obj 0 90 dsp,				// in+5		dsp
   obj 0 120 send "$0-out"] +			// in+6		s $0-out
  [obj (i*60) 150 "outlet~" |			// in+7..in+7+out-1
   i = 1..out] +				//		outlet~
  [obj 0 150 "outlet"] +			// in+7+out	outlet

						// -- connections --

  [connect in 0 (in+2) 0,			// inlet -> faust-control
   connect (in+1) 0 (in+2) 0,			// receive $0-read -> faust-control
   connect (in+2) 0 (in+3) 0,			// faust-control -> s $0-write
   connect (in+5) 0 (in+6) 0,			// dsp -> s $0-out
   connect in 0 (in+7+out) 0,			// inlet -> outlet
   connect (in+4) 0 (in+5) 0] +			// receive $0-in -> dsp
  [connect (i-1) 0 (in+5) i |			// inlet~ -> dsp
   i = 1..in] +
  [connect (in+5) i (in+7+i-1) 0 |		// dsp -> outlet~
   i = 1..out];

/* Create the synth subpatch. */

make_voices dsp out n
=						// -- objects --

  [obj 0 0 "inlet",				// 0		inlet #1
   obj 120 0 "inlet",				// 1		inlet #2
   obj 180 0 receive "$0-read",			// 2		r $0-read
   obj 120 30 receive "$0-all",			// 3		r $0-all
   obj 180 30 "faust-control" "$0",		// 4	      faust-control $0
   obj 180 60 send "$0-write",			// 5		s $0-write
   obj 120 60 receive "$0-in",			// 6		r $0-in
   obj 120 ((n+1)*30+60) send "$0-out"] +	// 7		s $0-out
  cat [[obj 0 (i*30+60) "faust-gate" i,		// 8,10..2*n+6	faust-gate 1..n
	obj 120 (i*30+60) dsp] |		// 9,11..2*n+7	dsp #1..n
       i = 1..n] +
  [obj (i*60+120) ((n+1)*30+90) "outlet~" |	// 2*n+8..2*n+8+out-1
   i = 0..out-1] +				//		outlet~ #1..n
  [obj 0 ((n+1)*30+90) "outlet"] +		// 2*n+8+out	outlet

						// -- connections --

  [connect 1 0 4 0,				// inlet #2 -> faust-control
   connect 2 0 4 0,				// r $0-read -> faust-control
   connect 4 0 5 0,				// faust-control -> s $0-write
   connect 1 0 (2*n+8+out) 0,			// inlet #2 -> outlet
   connect 6 0 9 0,				// r $0-in -> dsp #1
   connect 9 0 7 0] +				// dsp #1 -> s $0-out
  cat [[connect 0 0 (2*i+8) 0,			// inlet #1 -> faust-gate 1..n
	connect (2*i+8) 0 (2*i+9) 0,		// faust-gate 1..n -> dsp #1..n
	connect 3 0 (2*i+9) 0] |		// r $0-all -> dsp #1..n
       i = 0..n-1] +
  [connect (2*i+9) (j+1) (2*n+8+j) 0 |		// dsp #1..n -> outlet~ #1..n
   i = 0..n-1; j = 0..out-1];

/* Create the GUI+controls subpatch. */

const black = -1;
const white = -0x40000;
const gray  = -0x38e39;

/* FIXME: The following is mostly guesswork, so you might have to customize
   this. Maybe these values should be configurable from the command line, or a
   better layout algorithm should be designed which also takes into account
   the widget labels. */

const button_x,button_y = 50,30;
const nentry_x,nentry_y = 75,30;
const hslider_x,hslider_y = 150,30;
const vslider_x,vslider_y = 50,150;

make_controls layout controls
		= x,y,c
		    if ~null gui
		    when x,y,gui = make_gui layout;
		      c = move (max 450 (x+30)) 10 $
		      make_control_objs controls;
		      c = merge gui c;
		    end;
		= 0,0,[] otherwise;

/* Create the GUI subpatch. */

let fn1,fn2 = 10,10; // default GUI font sizes, adapt as needed

make_gui layout	= x,y,c+
		  [obj (x-38) 3 bng 15 250 50 1 "$0-init" "$0-ignore"
		   "empty" 0 (-6) 0 fn1 white black black,
		   obj (x-18) 3 tgl 15 1 "$0-active" "$0-active"
		   "empty" 0 (-6) 0 fn1 white black black 1 1]
		    if ~null c
		    when x,y,c = make_group "" (10,30) layout end;
		= 0,0,[] otherwise;

make_group path (x,y) (tgroup g)
		= make_group path (x,y) (hgroup g);
make_group path (x,y) (hgroup (name,items))
		= //printf "end %s\n" $ join2 path $ mangle name $$
		  x,y,cat (reverse c)
		    when _,_,_,_,x,y,c =
		      //printf "hgroup %s\n" $ join2 path $ mangle name $$
		      foldl (hstep (make_group (join2 path (mangle name))))
		      (x,y,x,y,x,y,[]) items;
		    end;
make_group path (x,y) (vgroup (name,items))
		= //printf "end %s\n" $ join2 path $ mangle name $$
		  x,y,cat (reverse c)
		    when _,_,_,_,x,y,c =
		      //printf "vgroup %s\n" $ join2 path $ mangle name $$
		      foldl (vstep (make_group (join2 path (mangle name))))
		      (x,y,x,y,x,y,[]) items;
		    end;
make_group path (x,y) item
		= //printf "%s [%s] item %s\n" (str (x,y),path,str item) $$
		  add_widget path (x,y) item;

hstep f (x0,y0,x1,y1,x2,y2,c) item
		= hbreak f (x0,y0,x1,y1,x2,y2,c) item (x,y,c1)
		    when x,y,c1 = f (x1,y1) item end;
hbreak f (x0,y0,x1,y1,x2,y2,c) item (x,y,c1)
		= x0,y0,x,y1,max x2 x,max y2 y,c1:c
		    if width<=0 || x<=width || x1<=x0;
		= hbreak f (x0,y0,x0,y2,x2,y2,c) item (f (x0,y2) item);
vstep f (x0,y0,x1,y1,x2,y2,c) item
		= vbreak f (x0,y0,x1,y1,x2,y2,c) item (x,y,c1)
		    when x,y,c1 = f (x1,y1) item end;
vbreak f (x0,y0,x1,y1,x2,y2,c) item (x,y,c1)
		= x0,y0,x1,y,max x2 x,max y2 y,c1:c
		    if height<=0 || y<=height || y1<=y0;
		= vbreak f (x0,y0,x2,y0,x2,y2,c) item (f (x2,y0) item);

checkname name	= "empty" if null name;
		= name otherwise;

match_control path name pat
		= fnmatch pat (join2 path name) 0 if index pat "/" >= 0;
		= fnmatch pat name 0 otherwise;

let gmax = max;
add_widget path (x,y) item
		= x,y,[]
		    if null (join2 path name) ||
		      any (match_control path name) exclude
		    when name = mangle $ control_label item end;
add_widget path (x,y) (button name)
		= add_widget path (x,y) (checkbox name) if fake_buttons_flag;
add_widget path (x,y) (button name)
		= x+button_x,y+button_y,
		  [obj x y bng 15 250 50 0 s s
		   name 0 (-6) 0 fn1 white black black]
		    when name = mangle name;
		      s = control_sym $ join2 path name;
		      name = checkname name;
		    end
		    if nvoices==0 ||
		      ~any ((==)name) ["freq","gain","gate"];
add_widget path (x,y) (checkbox name)
		= x+button_x,y+button_y,
		  [obj x y tgl 15 0 s s
		   name 0 (-6) 0 fn1 white black black 0 1]
		    when name = mangle name;
		      s = control_sym $ join2 path name;
		      name = checkname name;
		    end
		    if nvoices==0 ||
		      ~any ((==)name) ["freq","gain","gate"];
add_widget path (x,y) (nentry (name,init,min,max,_))
		= x+nentry_x,y+nentry_y,
		  [obj x y nbx 5 14 min max 0 0 s s
		   name 0 (-6) 0 fn2 white black black 256]
		    when name = mangle name;
		      s = control_sym $ join2 path name;
		      name = checkname name;
		    end
		    if nvoices==0 ||
		      ~any ((==)name) ["freq","gain","gate"];
add_widget path (x,y) (hslider (name,init,min,max,step))
		= if radio_sliders>0 && min==0 &&
		    step==1 && max<radio_sliders then
		    x+gmax hslider_x (radio_sliders*15),y+hslider_y,
		    [obj x y hradio 15 1 0 (max+1) s s
		     name 0 (-6) 0 fn1 white black black 0]
		  else if slider_nums_flag then
		    x+hslider_x+nentry_x,y+hslider_y,
		    [obj x y hsl 128 15 min max 0 0 s s
		     name (-2) (-6) 0 fn1 white black black 0 1,
		     obj (x+hslider_x) y nbx 5 14 min max 0 0 s s
		     "empty" 0 (-6) 0 fn2 white black black 256]
		  else
		    x+hslider_x,y+hslider_y,
		    [obj x y hsl 128 15 min max 0 0 s s
		     name (-2) (-6) 0 fn1 white black black 0 1]
		    when name = mangle name;
		      s = control_sym $ join2 path name;
		      name = checkname name;
		    end
		    if nvoices==0 ||
		      ~any ((==)name) ["freq","gain","gate"];
add_widget path (x,y) (vslider (name,init,min,max,step))
		= if radio_sliders>0 && min==0 &&
		    step==1 && max<radio_sliders then
		    x+vslider_x,y+gmax vslider_y (radio_sliders*15),
		    [obj x y vradio 15 1 0 (max+1) s s
		     name 0 (-6) 0 fn1 white black black 0]
		  else if slider_nums_flag then
		    x+nentry_x,y+vslider_y+nentry_y,
		    [obj x y vsl 15 128 min max 0 0 s s
		     name 0 (-8) 0 fn1 white black black 0 1,
		     obj x (y+vslider_y-10) nbx 5 14 min max 0 0 s s
		     "empty" 0 (-6) 0 fn2 white black black 256]
		  else
		    x+vslider_x,y+vslider_y,
		    [obj x y vsl 15 128 min max 0 0 s s
		     name 0 (-8) 0 fn1 white black black 0 1]
		    when name = mangle name;
		      s = control_sym $ join2 path name;
		      name = checkname name;
		    end
		    if nvoices==0 ||
		      ~any ((==)name) ["freq","gain","gate"];
add_widget path (x,y) (hbargraph (name,min,max))
		= if slider_nums_flag then
		    x+hslider_x+nentry_x,y+hslider_y,
		    [obj x y hsl 128 15 min max 0 0 s s
		     name (-2) (-6) 0 fn1 gray black black 0 1,
		     obj (x+hslider_x) y nbx 5 14 min max 0 0 s s
		     "empty" 0 (-6) 0 fn2 gray black black 256]
		  else
		    x+hslider_x,y+hslider_y,
		    [obj x y hsl 128 15 min max 0 0 s s
		     name (-2) (-6) 0 fn1 gray black black 0 1]
		    when name = mangle name;
		      s = control_sym $ join2 path name;
		      name = checkname name;
		    end
		    if nvoices==0 ||
		      ~any ((==)name) ["freq","gain","gate"];
add_widget path (x,y) (vbargraph (name,min,max))
		= if slider_nums_flag then
		    x+nentry_x,y+vslider_y+nentry_y,
		    [obj x y vsl 15 128 min max 0 0 s s
		     name 0 (-8) 0 fn1 gray black black 0 1,
		     obj x (y+vslider_y-10) nbx 5 14 min max 0 0 s s
		     "empty" 0 (-6) 0 fn2 gray black black 256]
		  else
		    x+vslider_x,y+vslider_y,
		    [obj x y vsl 15 128 min max 0 0 s s
		     name 0 (-8) 0 fn1 gray black black 0 1]
		    when name = mangle name;
		      s = control_sym $ join2 path name;
		      name = checkname name;
		    end
		    if nvoices==0 ||
		      ~any ((==)name) ["freq","gain","gate"];
add_widget _ (x,y) _
		= x,y,[] otherwise;

/* Create the control objects and wiring. */

make_control_objs controls
		= [obj 0 0 receive "$0-init",
		   obj dx 0 send (if nvoices>0 then "$0-all" else "$0-in"),
		   obj (dx+dx div 2) 0 send "$0-read",
		   obj (2*dx) 0 receive "$0-write"] + c
		    when controls = checkbox "active":controls;
		      dx = foldl max 0 $ map ((#).control_label) controls;
		      dx = (dx+7)*8;
		      _,c = foldl (control_objs dx) (0,[]) controls;
		    end;

control_objs dx (j,c) (button name)
		= control_objs dx (j,c) (checkbox name) if fake_buttons_flag;
control_objs dx (j,c) (button name)
		= (j+1,c+button_control_objs dx j name s 0)
		    when s = control_sym name end;
control_objs dx (j,c) (checkbox "active")
		= (j+1,c+activate_control_objs dx j "active" s 1)
		    when s = control_sym "active" end;
control_objs dx (j,c) (checkbox name)
		= (j+1,c+active_control_objs dx j name s 0)
		    when s = control_sym name end;
control_objs dx (j,c) (nentry (name,init,_))
		= (j+1,c+active_control_objs dx j name s init)
		    when s = control_sym name end;
control_objs dx (j,c) (hslider (name,init,_))
		= (j+1,c+active_control_objs dx j name s init)
		    when s = control_sym name end;
control_objs dx (j,c) (vslider (name,init,_))
		= (j+1,c+active_control_objs dx j name s init)
		    when s = control_sym name end;
control_objs dx (j,c) (hbargraph (name,_))
		= (j+1,c+passive_control_objs dx j name s 0)
		    when s = control_sym name end;
control_objs dx (j,c) (vbargraph (name,_))
		= (j+1,c+passive_control_objs dx j name s 0)
		    when s = control_sym name end;
control_objs _ (j,c) _
		= (j,c) otherwise;

control_sym name
		= sprintf "$0-%s" $ substr name 1 (#name-1) if name!0=="/";
		= sprintf "$0-%s" name otherwise;

activate_control_objs dx j name s init
		= [msg 0 ((2*j+1)*20) init,
		   obj 0 ((2*j+2)*20) send s,
		   //connect 0 0 (6*j+4) 0,
		   connect (6*j+4) 0 (6*j+5) 0,
		   obj dx ((2*j+1)*20) receive s,
		   msg dx ((2*j+2)*20) name "$1",
		   connect (6*j+6) 0 (6*j+7) 0,
		   connect (6*j+7) 0 1 0,
		   obj (2*dx) ((2*j+1)*20) route name,
		   obj (2*dx) ((2*j+2)*20) send s,
		   connect (if j>0 then 6*j+2 else 3)
		   (if j>0 then 1 else 0) (6*j+8) 0,
		   connect (6*j+8) 0 (6*j+9) 0];

active_control_objs dx j name s init
		= [msg 0 ((2*j+1)*20) init,
		   obj 0 ((2*j+2)*20) send s,
		   connect 0 0 (6*j+4) 0,
		   connect (6*j+4) 0 (6*j+5) 0,
		   obj dx ((2*j+1)*20) receive s,
		   msg dx ((2*j+2)*20) name "$1",
		   connect (6*j+6) 0 (6*j+7) 0,
		   connect (6*j+7) 0 1 0,
		   obj (2*dx) ((2*j+1)*20) route name,
		   obj (2*dx) ((2*j+2)*20) send s,
		   connect (if j>0 then 6*j+2 else 3)
		   (if j>0 then 1 else 0) (6*j+8) 0,
		   connect (6*j+8) 0 (6*j+9) 0];

button_control_objs dx j name s init
		= [msg 0 ((2*j+1)*20) init,
		   obj 0 ((2*j+2)*20) "faust-s" s,
		   connect 0 0 (6*j+4) 0,
		   connect (6*j+4) 0 (6*j+5) 0,
		   obj dx ((2*j+1)*20) receive s,
		   obj dx ((2*j+2)*20) "faust-r" name,
		   connect (6*j+6) 0 (6*j+7) 0,
		   connect (6*j+7) 0 1 0,
		   obj (2*dx) ((2*j+1)*20) route name,
		   obj (2*dx) ((2*j+2)*20) "faust-s" s,
		   connect (if j>0 then 6*j+2 else 3)
		   (if j>0 then 1 else 0) (6*j+8) 0,
		   connect (6*j+8) 0 (6*j+9) 0];

passive_control_objs dx j name s init
		= [msg 0 ((2*j+1)*20) init,
		   obj 0 ((2*j+2)*20) send s,
		   connect 0 0 (6*j+4) 0,
		   connect (6*j+4) 0 (6*j+5) 0,
		   obj dx ((2*j+1)*20) "faust-timer" "$0",
		   msg dx ((2*j+2)*20) name,
		   connect (6*j+6) 0 (6*j+7) 0,
		   connect (6*j+7) 0 2 0,
		   obj (2*dx) ((2*j+1)*20) route name,
		   obj (2*dx) ((2*j+2)*20) send s,
		   connect (if j>0 then 6*j+2 else 3)
		   (if j>0 then 1 else 0) (6*j+8) 0,
		   connect (6*j+8) 0 (6*j+9) 0];

/* Make control names as in faustxml.pure but with name mangling and "/" in
   front. */

mangle s	= join "-" $ filter (\x->~null x) $
		  regsplit "[^A-Za-z0-9]+" REG_EXTENDED s 0
when
  s = strcat $ regsplit "[ \t]*\\[[^]]+\\][ \t]*" REG_EXTENDED s 0;
end;

pdcontrols x	= filter (((~=)"/").control_label) $ controls "" x with
  controls path x
		= case x of
		    f@_ (lbl::string,ctrls@[]) |
		    f@_ (lbl::string,ctrls@(_:_))
		      = catmap (controls (join2 path lbl)) ctrls
		        when lbl = mangle lbl end;
		    f@_ (lbl::string,args)
		      = [f (join2 path lbl,args)]
		        when lbl = mangle lbl end;
		    f@_ lbl::string
		      = [f (join2 path lbl)]
		        when lbl = mangle lbl end;
		  end;
end if controlp x;

join2 "" s	= "/"+s;
join2 s ""	= s;
join2 s t	= s+"/"+t otherwise;

/* main program */

error msg::string
		= fprintf stderr "%s: %s\n" (prog,msg) $$ exit 1;
error x		= fprintf stderr "%s: unknown error (%s)\n" (prog,str x) $$
		  exit 1;

invalid_option opt
		= error $ sprintf "invalid option %s, try -h for help" opt;

invalid_src_option opt
		= error $ sprintf "invalid option %s in source" opt;

get_set_opt opt	= case myopts!![opt] of
		   [val::string] = split "," val;
		   _ = [] otherwise;
		  end;

get_int_opt opt	= case myopts!![opt] of
		   [val::string] = check_int_opt opt val if ~null val;
		   _ = 0 otherwise;
		  end;

extern int atoi(char*);
check_int_opt opt val
		= n if n>0 when n = atoi val end;
		= error $ sprintf "invalid option value %s %s" (opt,val);

print_usage prog
		= printf
"faust2pd version %s, Copyright (c) 2009 by Albert Graef\n\
Usage: %s [-hVbs] [-f size] [-o output-file] [-n #voices]\n\
  [-r max] [-X patterns] [-x width] [-y height] input-file\n\
Options:\n\
-h, --help          display this help message and exit\n\
-V, --version       display the version number and exit\n\
-b, --fake-buttons  replace buttons (bangs) with checkboxes (toggles)\n\
-f, --font-size     font size for GUI elements (10 by default)\n\
-n, --nvoices       create a synth patch with the given number of voices\n\
-o, --output-file   output file name ('.pd' file)\n\
-r, --radio-sliders radio controls for sliders with values 0..max-1\n\
-s, --slider-nums   sliders with additional number control\n\
-X, --exclude       exclude controls matching the given glob patterns\n\
-x, --width         maximum width of the GUI area\n\
-y, --height        maximum height of the GUI area\n\
input-file          input file name ('.dsp.xml' file)\n\
Default output-file is input-file with new extension '.pd'.\n"
		  (version,prog) $$ exit 0;

print_version	= printf
"faust2pd version %s, Copyright (c) 2009 by Albert Graef\n" version $$
		  exit 0;

let opts        = [("--help", "-h", NOARG),
		   ("--version", "-V", NOARG),
		   ("--fake-buttons", "-b", NOARG),
		   ("--slider-nums", "-s", NOARG),
		   ("--radio-sliders", "-r", REQARG),
		   ("--nvoices", "-n", REQARG),
		   ("--font-size", "-f", REQARG),
		   ("--width", "-x", REQARG),
		   ("--height", "-y", REQARG),
		   ("--exclude", "-X", REQARG),
		   ("--output-file", "-o", REQARG)];

//let compiling = 1;
//let argv = ["faust2pd","test/organ.dsp.xml"];
let prog,myargs = case argv of prog:args = prog,args; _ = "faust2pd",[] end;

//let prog = "faust2pd";

let myopts,myargs = catch invalid_option $ getopt opts myargs;
let myopts = dict myopts;
let help_flag = member myopts "--help";
let version_flag = member myopts "--version";

if compiling then
  ()
else if version_flag then
  print_version
else if help_flag then
  print_usage prog
else if null myargs then
  error "no source file specified, try -h for help"
else if #myargs>1 then
  error "more than one source file specified, try -h for help"
else ();

let xmlname:_ = if compiling then [""] else myargs;

let outname = if member myopts "--output-file" then
                myopts!"--output-file"
              else ();

if outname===xmlname then
  error "output would overwrite source file, aborting"
else ();

attrs s		= regexg (\info->info!3) "\\[pd:([^]]+)\\]" REG_EXTENDED s 0;

let dsp_info => (src_opts,_) =
  if compiling then () => ([],[])
  else
  (dsp_info => catch invalid_src_option (getopt opts src_opts) when
     setlocale LC_ALL "C";
     dsp_info = catch error (faustxml::info xmlname);
     src_opts = case dsp_info!5 of
                  _ (label,_) = ["--"+opt | opt = attrs label];
                  _ = [];
                end;
   end);

/* Command line options always override what's in the source. */
let myopts = dict (src_opts+members myopts);

let fake_buttons_flag = member myopts "--fake-buttons";
let slider_nums_flag = member myopts "--slider-nums";
let [radio_sliders,nvoices,height,width,fnsize] = map get_int_opt
  ["--radio-sliders","--nvoices","--height","--width","--font-size"];
let exclude = get_set_opt "--exclude";

let fn1,fn2 = if fnsize>0 then fnsize,fnsize else fn1,fn2;

main		= catch error mainprog $$ exit 0;
mainprog	= write_synth nvoices dsp_info outname if nvoices>0;
		= write_dsp dsp_info outname otherwise;

if compiling then () else main;