X-Git-Url: https://scm.cri.ensmp.fr/git/Faustine.git/blobdiff_plain/1059e1cc0c2ecfa237406949aa26155b6a5b9154..66f23d4fabf89ad09adbd4dfc15ac6b5b2b7da83:/interpreter/preprocessor/faust-0.9.47mr3/tools/faust2pd/faustxml.pure

diff --git a/interpreter/preprocessor/faust-0.9.47mr3/tools/faust2pd/faustxml.pure b/interpreter/preprocessor/faust-0.9.47mr3/tools/faust2pd/faustxml.pure
new file mode 100644
index 0000000..c3b0e74
--- /dev/null
+++ b/interpreter/preprocessor/faust-0.9.47mr3/tools/faust2pd/faustxml.pure
@@ -0,0 +1,312 @@
+
+/* faustxml.pure: Parse a Faust XML file. */
+
+/* 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/>. */
+
+using dict, regex, system, xml;
+namespace faustxml;
+
+/* .. default-domain:: pure
+   .. module:: faustxml
+   .. namespace:: faustxml
+
+   Appendix: faustxml
+   ==================
+
+   The faustxml module is provided along with faust2pd to retrieve the
+   description of a Faust DSP from its XML file as a data structure which
+   is ready to be processed by Pure programs. It may also be useful in other
+   Pure applications which need to inspect description of Faust DSPs.
+
+   The main entry point is the :func:`info` function which takes the name of a
+   Faust-generated XML file as argument and returns a tuple ``(name, descr,
+   version, in, out, controls)`` with the name, description, version, number
+   of inputs and outputs and the toplevel group with the descriptions of the
+   controls of the dsp. A couple of other convenience functions are provided
+   to deal with the control descriptions.
+
+   Usage
+   -----
+
+   Use the following declaration to import this module in your programs::
+
+     using faustxml;
+
+   For convenience, you can also use the following to get access to the
+   module's namespace::
+
+     using namespace faustxml;
+
+   Data Structure
+   --------------
+
+   The following constructors are used to represent the UI controls of Faust
+   DSPs:
+
+   .. constructor:: button label
+      		    checkbox label
+
+      A button or checkbox with the given label.
+
+   .. constructor:: nentry (label,init,min,max,step)
+      		    vslider (label,init,min,max,step)
+		    hslider (label,init,min,max,step)
+
+      A numeric input control with the given label, initial value, range and
+      stepwidth.
+
+   .. constructor:: vbargraph (label,min,max)
+      		    hbargraph (label,min,max)
+
+      A numeric output control with the given label and range.
+
+   .. constructor:: vgroup (label,controls)
+      		    hgroup (label,controls)
+		    tgroup (label,controls)
+
+      A group with the given label and list of controls in the group. */
+
+nonfix button checkbox nentry vslider hslider vbargraph hbargraph
+  vgroup hgroup tgroup;
+
+public controlp;
+
+/* ..
+
+   Operations
+   ----------
+
+   .. function:: controlp x
+
+      Check for control description values. */
+
+controlp x
+= case x of
+    button _ | checkbox _ | nentry _ | vslider _ | hslider _ |
+    vbargraph _ | hbargraph _ | vgroup _ | hgroup _ | tgroup _ = true;
+    _ = false;
+  end;
+
+/* .. function:: control_type x
+      		 control_label x
+		 control_args x
+
+      Access functions for the various components of a control description. */
+
+public control_type control_label control_args;
+
+control_type x@(f@_ _) = f if controlp x;
+
+control_label x@(_ label::string) |
+control_label x@(_ (label,_)) = label if controlp x;
+
+control_args x@(_ _::string) = () if controlp x;
+control_args x@(_ (_,args)) = args if controlp x;
+
+/* .. function:: controls x
+ 
+      This function returns a flat representation of a control group ``x`` as
+      a list of basic control descriptions, which provides a quick way to
+      access all the control values of a Faust DSP. The grouping controls
+      themselves are omitted. You can pass the last component of the return
+      value of the :func:`info` function to this function. */
+
+public controls;
+
+controls x@(_ args)
+= case args of
+    _,ctrls = catmap controls ctrls if listp ctrls;
+    _ = [x] otherwise;
+  end if controlp x;
+
+/* .. function:: pcontrols x
+ 
+      Works like the :func:`controls` function above, but also replaces the label of
+      each basic control with a fully qualified path consisting of all control
+      labels leading up to the given control. Thus, e.g., the label of a
+      slider ``"gain"`` inside a group ``"voice#0"`` inside the main
+      ``"faust"`` group will be denoted by the label
+      ``"faust/voice#0/gain"``. */
+
+public pcontrols;
+
+pcontrols x = controls "" x with
+  controls path (f@_ (label::string,args))
+			= catmap (controls (join path label)) args
+			    if listp args;
+			= [f (join path label,args)];
+  controls path (f@_ label::string)
+			= [f (join path label)];
+  join "" s		|
+  join s ""		= s;
+  join s t		= s+"/"+t otherwise;
+end if controlp x;
+
+/* .. function:: info fname
+ 
+      Extract the description of a Faust DSP from its XML file. This is the
+      main entry point. Returns a tuple with the name, description and version
+      of the DSP, as well as the number of inputs and outputs and the toplevel
+      group with all the control descriptions. Raises an exception if the XML
+      file doesn't exist or contains invalid contents.
+
+   Example::
+
+     > using faustxml;
+     > let name,descr,version,in,out,group =
+     >   faustxml::info "examples/basic/freeverb.dsp.xml";
+     > name,descr,version,in,out;
+     "freeverb","freeverb -- a Schroeder reverb","1.0",2,2
+     > using system;
+     > do (puts.str) $ faustxml::pcontrols group;
+     faustxml::hslider ("freeverb/damp",0.5,0.0,1.0,0.025)
+     faustxml::hslider ("freeverb/roomsize",0.5,0.0,1.0,0.025)
+     faustxml::hslider ("freeverb/wet",0.3333,0.0,1.0,0.025)
+
+*/
+
+public info;
+
+private basename trim str_val tree node;
+private parse parse_doc parse_node parse_prop parse_type
+  parse_control make_control parse_group make_group;
+
+info fname::string
+= case xml::load_file fname 0 of
+    doc = name,descr,info when
+            name = basename fname; descr,info = parse doc;
+            descr = if null descr then name else descr;
+          end if xml::docp doc;
+    _ = throw "could not open XML file" otherwise;
+  end;
+
+/* Private operations. *******************************************************/
+
+/* Determine the basename of a file (strip off path and extension). */
+
+basename s::string
+= s when s::string = last $ split "/" s; s::string = head $ split "." s; end;
+
+/* Remove leading and trailing whitespace. */
+
+trim s::string = regex "^[ \t\n]*((.|\n)*[^ \t\n])[ \t\n]*$" REG_EXTENDED
+		 s 0!4;
+
+/* Parse a string value. */
+
+str_val s::string
+= case eval (sprintf "quote (%s)" s) of
+    s::string = s;
+    _ = s otherwise;
+  end;
+
+/* Generate a tree representation of an entire XML document, or the subtree of
+   an XML document rooted at a given node. */
+
+tree doc::pointer = tree (xml::root doc) if xml::docp doc;
+tree n::pointer = node (xml::node_info n) 
+		  [tree m | m = xml::children n; ~xml::is_blank_node m]
+		    if xml::nodep n;
+
+/* Helper functions to parse the contents of a Faust XML file. */
+
+parse doc
+= case map (map tree . xml::select doc)
+       ["/faust/name","/faust/version",
+	"/faust/inputs","/faust/outputs",
+	"/faust/ui/activewidgets/widget",
+	"/faust/ui/passivewidgets/widget",
+	"/faust/ui/layout/group"] of
+    [[name],[version],[in],[out],active,passive,layout] =
+      parse_doc (name,version,in,out,active+passive,layout);
+    _ = throw "invalid XML data" otherwise;
+  end;
+
+private extern int atoi(char*);
+private extern double atof(char*);
+
+parse_doc (node (xml::element "name" _ _) name,
+	   node (xml::element "version" _ _) version,
+	   node (xml::element "inputs" _ _) in,
+	   node (xml::element "outputs" _ _) out,
+	   controls,layout)
+= case map (parse_group (dict controls)) layout of
+    [controls] = (name,version,in,out,controls);
+    _ = throw "invalid XML data" otherwise;
+  end when
+    [name,version,in,out] = map parse_node [name,version,in,out];
+    [name,version] = map (parse_prop.trim) [name,version];
+    [in,out] = map atoi [in,out];
+    controls = map parse_control controls;
+  end;
+parse_doc _ = throw "invalid XML data" otherwise;
+
+parse_node [node (xml::text s::string) _] = s;
+parse_node [] = "";
+parse_node _ = throw "invalid XML data" otherwise;
+
+parse_prop s
+= case s of
+    "Unknow" = ""; // sic! (old Faust versions)
+    "Unknown" = "";
+    _::string = str_val s;
+    _ = "" otherwise;
+  end;
+
+parse_type s::string = eval $ "faustxml::"+s;
+
+parse_control (node (xml::element "widget" _ attrs) params)
+= case attrs!!["type","id"]+params!!["label"] of
+    [ty,id,label] =
+      make_control (atoi id) ty (str_val label) params;
+    _ = throw "invalid XML data" otherwise;
+  end when
+    attrs = dict attrs; params = dict $ map param params with
+      param (node (xml::element name::string _ _) val)
+      = name=>val if stringp val when val = parse_node val end;
+      param _ = throw "invalid XML data" otherwise;
+    end;
+  end;
+parse_control _ = throw "invalid XML data" otherwise;
+
+make_control id ty label params
+= id => parse_type ty label if any ((==)ty) ["button","checkbox"];
+= case params!!["init","min","max","step"] of
+    res@[init,min,max,step] =
+      id => parse_type ty (label,tuple (map atof res));
+    _ = throw "invalid XML data" otherwise;
+  end if any ((==)ty) ["vslider","hslider","nentry"];
+= case params!!["min","max"] of
+    res@[min,max] =
+      id => parse_type ty (label,tuple (map atof res));
+    _ = throw "invalid XML data" otherwise;
+  end if any ((==)ty) ["vbargraph","hbargraph"];
+make_control _ _ _ _ = throw "invalid XML data" otherwise;
+
+parse_group cdict (node (xml::element "group" _ attrs) params)
+= case attrs!!["type"] of
+    [ty] = make_group cdict ty params;
+    _ = throw "invalid XML data" otherwise;
+  end when attrs = dict attrs end;
+parse_group cdict (node (xml::element "widgetref" _ ["id"=>id::string]) [])
+= case cdict!![atoi id] of [c] = c; _ = throw "invalid XML data"; end;
+parse_group _ _ = throw "invalid XML data" otherwise;
+
+make_group cdict ty (node (xml::element "label" _ _) label:params)
+= case parse_type ty (str_val label,map (parse_group cdict) params) of
+    c = c if stringp label && controlp c;
+    _ = throw "invalid XML data" otherwise;
+  end when label = parse_node label end;
+make_group _ _ _ = throw "invalid XML data" otherwise;