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