--- /dev/null
+
+/* 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;
projects / Faustine.git / blobdiff