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