interpretor/preprocessor/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;