OOP initial commit with new traces.
[Faustine.git] / interpretor / faust-0.9.47mr3 / tools / faust2pd / faustxml.pure
1
2 /* faustxml.pure: Parse a Faust XML file. */
3
4 /* Copyright (c) 2009 by Albert Graef.
5
6 This is free software; you can redistribute it and/or modify it under the
7 terms of the GNU General Public License as published by the Free Software
8 Foundation; either version 3, or (at your option) any later version.
9
10 This software is distributed in the hope that it will be useful, but
11 WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
12 or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
13 more details.
14
15 You should have received a copy of the GNU General Public License along
16 with this program. If not, see <http://www.gnu.org/licenses/>. */
17
18 using dict, regex, system, xml;
19 namespace faustxml;
20
21 /* .. default-domain:: pure
22 .. module:: faustxml
23 .. namespace:: faustxml
24
25 Appendix: faustxml
26 ==================
27
28 The faustxml module is provided along with faust2pd to retrieve the
29 description of a Faust DSP from its XML file as a data structure which
30 is ready to be processed by Pure programs. It may also be useful in other
31 Pure applications which need to inspect description of Faust DSPs.
32
33 The main entry point is the :func:`info` function which takes the name of a
34 Faust-generated XML file as argument and returns a tuple ``(name, descr,
35 version, in, out, controls)`` with the name, description, version, number
36 of inputs and outputs and the toplevel group with the descriptions of the
37 controls of the dsp. A couple of other convenience functions are provided
38 to deal with the control descriptions.
39
40 Usage
41 -----
42
43 Use the following declaration to import this module in your programs::
44
45 using faustxml;
46
47 For convenience, you can also use the following to get access to the
48 module's namespace::
49
50 using namespace faustxml;
51
52 Data Structure
53 --------------
54
55 The following constructors are used to represent the UI controls of Faust
56 DSPs:
57
58 .. constructor:: button label
59 checkbox label
60
61 A button or checkbox with the given label.
62
63 .. constructor:: nentry (label,init,min,max,step)
64 vslider (label,init,min,max,step)
65 hslider (label,init,min,max,step)
66
67 A numeric input control with the given label, initial value, range and
68 stepwidth.
69
70 .. constructor:: vbargraph (label,min,max)
71 hbargraph (label,min,max)
72
73 A numeric output control with the given label and range.
74
75 .. constructor:: vgroup (label,controls)
76 hgroup (label,controls)
77 tgroup (label,controls)
78
79 A group with the given label and list of controls in the group. */
80
81 nonfix button checkbox nentry vslider hslider vbargraph hbargraph
82 vgroup hgroup tgroup;
83
84 public controlp;
85
86 /* ..
87
88 Operations
89 ----------
90
91 .. function:: controlp x
92
93 Check for control description values. */
94
95 controlp x
96 = case x of
97 button _ | checkbox _ | nentry _ | vslider _ | hslider _ |
98 vbargraph _ | hbargraph _ | vgroup _ | hgroup _ | tgroup _ = true;
99 _ = false;
100 end;
101
102 /* .. function:: control_type x
103 control_label x
104 control_args x
105
106 Access functions for the various components of a control description. */
107
108 public control_type control_label control_args;
109
110 control_type x@(f@_ _) = f if controlp x;
111
112 control_label x@(_ label::string) |
113 control_label x@(_ (label,_)) = label if controlp x;
114
115 control_args x@(_ _::string) = () if controlp x;
116 control_args x@(_ (_,args)) = args if controlp x;
117
118 /* .. function:: controls x
119
120 This function returns a flat representation of a control group ``x`` as
121 a list of basic control descriptions, which provides a quick way to
122 access all the control values of a Faust DSP. The grouping controls
123 themselves are omitted. You can pass the last component of the return
124 value of the :func:`info` function to this function. */
125
126 public controls;
127
128 controls x@(_ args)
129 = case args of
130 _,ctrls = catmap controls ctrls if listp ctrls;
131 _ = [x] otherwise;
132 end if controlp x;
133
134 /* .. function:: pcontrols x
135
136 Works like the :func:`controls` function above, but also replaces the label of
137 each basic control with a fully qualified path consisting of all control
138 labels leading up to the given control. Thus, e.g., the label of a
139 slider ``"gain"`` inside a group ``"voice#0"`` inside the main
140 ``"faust"`` group will be denoted by the label
141 ``"faust/voice#0/gain"``. */
142
143 public pcontrols;
144
145 pcontrols x = controls "" x with
146 controls path (f@_ (label::string,args))
147 = catmap (controls (join path label)) args
148 if listp args;
149 = [f (join path label,args)];
150 controls path (f@_ label::string)
151 = [f (join path label)];
152 join "" s |
153 join s "" = s;
154 join s t = s+"/"+t otherwise;
155 end if controlp x;
156
157 /* .. function:: info fname
158
159 Extract the description of a Faust DSP from its XML file. This is the
160 main entry point. Returns a tuple with the name, description and version
161 of the DSP, as well as the number of inputs and outputs and the toplevel
162 group with all the control descriptions. Raises an exception if the XML
163 file doesn't exist or contains invalid contents.
164
165 Example::
166
167 > using faustxml;
168 > let name,descr,version,in,out,group =
169 > faustxml::info "examples/basic/freeverb.dsp.xml";
170 > name,descr,version,in,out;
171 "freeverb","freeverb -- a Schroeder reverb","1.0",2,2
172 > using system;
173 > do (puts.str) $ faustxml::pcontrols group;
174 faustxml::hslider ("freeverb/damp",0.5,0.0,1.0,0.025)
175 faustxml::hslider ("freeverb/roomsize",0.5,0.0,1.0,0.025)
176 faustxml::hslider ("freeverb/wet",0.3333,0.0,1.0,0.025)
177
178 */
179
180 public info;
181
182 private basename trim str_val tree node;
183 private parse parse_doc parse_node parse_prop parse_type
184 parse_control make_control parse_group make_group;
185
186 info fname::string
187 = case xml::load_file fname 0 of
188 doc = name,descr,info when
189 name = basename fname; descr,info = parse doc;
190 descr = if null descr then name else descr;
191 end if xml::docp doc;
192 _ = throw "could not open XML file" otherwise;
193 end;
194
195 /* Private operations. *******************************************************/
196
197 /* Determine the basename of a file (strip off path and extension). */
198
199 basename s::string
200 = s when s::string = last $ split "/" s; s::string = head $ split "." s; end;
201
202 /* Remove leading and trailing whitespace. */
203
204 trim s::string = regex "^[ \t\n]*((.|\n)*[^ \t\n])[ \t\n]*$" REG_EXTENDED
205 s 0!4;
206
207 /* Parse a string value. */
208
209 str_val s::string
210 = case eval (sprintf "quote (%s)" s) of
211 s::string = s;
212 _ = s otherwise;
213 end;
214
215 /* Generate a tree representation of an entire XML document, or the subtree of
216 an XML document rooted at a given node. */
217
218 tree doc::pointer = tree (xml::root doc) if xml::docp doc;
219 tree n::pointer = node (xml::node_info n)
220 [tree m | m = xml::children n; ~xml::is_blank_node m]
221 if xml::nodep n;
222
223 /* Helper functions to parse the contents of a Faust XML file. */
224
225 parse doc
226 = case map (map tree . xml::select doc)
227 ["/faust/name","/faust/version",
228 "/faust/inputs","/faust/outputs",
229 "/faust/ui/activewidgets/widget",
230 "/faust/ui/passivewidgets/widget",
231 "/faust/ui/layout/group"] of
232 [[name],[version],[in],[out],active,passive,layout] =
233 parse_doc (name,version,in,out,active+passive,layout);
234 _ = throw "invalid XML data" otherwise;
235 end;
236
237 private extern int atoi(char*);
238 private extern double atof(char*);
239
240 parse_doc (node (xml::element "name" _ _) name,
241 node (xml::element "version" _ _) version,
242 node (xml::element "inputs" _ _) in,
243 node (xml::element "outputs" _ _) out,
244 controls,layout)
245 = case map (parse_group (dict controls)) layout of
246 [controls] = (name,version,in,out,controls);
247 _ = throw "invalid XML data" otherwise;
248 end when
249 [name,version,in,out] = map parse_node [name,version,in,out];
250 [name,version] = map (parse_prop.trim) [name,version];
251 [in,out] = map atoi [in,out];
252 controls = map parse_control controls;
253 end;
254 parse_doc _ = throw "invalid XML data" otherwise;
255
256 parse_node [node (xml::text s::string) _] = s;
257 parse_node [] = "";
258 parse_node _ = throw "invalid XML data" otherwise;
259
260 parse_prop s
261 = case s of
262 "Unknow" = ""; // sic! (old Faust versions)
263 "Unknown" = "";
264 _::string = str_val s;
265 _ = "" otherwise;
266 end;
267
268 parse_type s::string = eval $ "faustxml::"+s;
269
270 parse_control (node (xml::element "widget" _ attrs) params)
271 = case attrs!!["type","id"]+params!!["label"] of
272 [ty,id,label] =
273 make_control (atoi id) ty (str_val label) params;
274 _ = throw "invalid XML data" otherwise;
275 end when
276 attrs = dict attrs; params = dict $ map param params with
277 param (node (xml::element name::string _ _) val)
278 = name=>val if stringp val when val = parse_node val end;
279 param _ = throw "invalid XML data" otherwise;
280 end;
281 end;
282 parse_control _ = throw "invalid XML data" otherwise;
283
284 make_control id ty label params
285 = id => parse_type ty label if any ((==)ty) ["button","checkbox"];
286 = case params!!["init","min","max","step"] of
287 res@[init,min,max,step] =
288 id => parse_type ty (label,tuple (map atof res));
289 _ = throw "invalid XML data" otherwise;
290 end if any ((==)ty) ["vslider","hslider","nentry"];
291 = case params!!["min","max"] of
292 res@[min,max] =
293 id => parse_type ty (label,tuple (map atof res));
294 _ = throw "invalid XML data" otherwise;
295 end if any ((==)ty) ["vbargraph","hbargraph"];
296 make_control _ _ _ _ = throw "invalid XML data" otherwise;
297
298 parse_group cdict (node (xml::element "group" _ attrs) params)
299 = case attrs!!["type"] of
300 [ty] = make_group cdict ty params;
301 _ = throw "invalid XML data" otherwise;
302 end when attrs = dict attrs end;
303 parse_group cdict (node (xml::element "widgetref" _ ["id"=>id::string]) [])
304 = case cdict!![atoi id] of [c] = c; _ = throw "invalid XML data"; end;
305 parse_group _ _ = throw "invalid XML data" otherwise;
306
307 make_group cdict ty (node (xml::element "label" _ _) label:params)
308 = case parse_type ty (str_val label,map (parse_group cdict) params) of
309 c = c if stringp label && controlp c;
310 _ = throw "invalid XML data" otherwise;
311 end when label = parse_node label end;
312 make_group _ _ _ = throw "invalid XML data" otherwise;