% metaobj.mp 0.93
% D. Roegel (roegel@loria.fr)
% January 15 - June 14, 2001
% November 13, 2001
% December 5, 2001
% December 23, 2002
% March 23, 2004
% April 9, 2004
% May 27, 2004
% June 1, 2004
% October 5, 2005
% October 23, 2005
% May 1st, 2006
% June 18, 2006
%
% MetaPost bug:
% ------------
%   With this file, I discovered a bug in the linux/web2c 7.3.1
%   implementation of metapost. There is a memory leak with
%   respect to strings. Apparently, if you increase |pool_size|
%   and recreate the |.mem|, you can avoid it, but I am not
%   sure the problem is really gone.
%   I mentionned this problem on the metafont mailing list on January 26, 2001.
%
% History:
%
%         January 15, 2001: start of the package
%         January     2001: development of most of
%                           the low-level object functions
%                           including cloning,
%                           as well as many classes of objects,
%                           including trees and the option mechanism
%         January 26, 2001: metapost bug discovered
%         February    2001: code improved
%         March-May   2001: paths and labels,
%                           addition of many of PSTricks' features
%         May 29,     2001: first private release (0.5)
%                           with a 120 pages documentation
%                           and 225 KB of core code.
%         May 31,     2001: new option pathfilled for paths
% 0.51  
%         June 5,     2001: coil and zigzag connections, option shortcuts
%                             (arm for armA and armB, etc.), arrows shortcuts
%                             (-, ->, etc.)
%         June 6,     2001: flip and treeflip options, linetension split
%                           into linetensionA and linetensionB
%         June 7,     2001: define_global_pair_option
%                           framestyle option
%                           ObjColor, ObjString, ObjBoolean and ObjTransform
%                           Second private release (0.51)
% 0.52    June  8,    2001: shadowcolor option
%         June 12,    2001: general shadows for all objects,
%                           and simplification of the shadow mechanism for Box
% 0.60    June 13,    2001: boxheight and boxdepth parameters for ncbox
%                            and ncarcbox; addUserPath,addStandardPath,ObjPath;
% 0.80    June 14,    2001: addition of |unfill| in objects
%         June 14,    2001: first released version on CTAN
% 0.81    Nov. 13,    2001: bug correction: contrary to what is written above,
%                           ObjColor, ObjString, ObjBoolean and ObjTransform
%                           were not correctly implemented. The field
%                           containing their list (for instance booleanlist_)
%                           was not declared. (Bug reported by
%                           Marc van Dongen, dongen@cs.ucc.ie,
%                           November 5, 2001.)
% 0.82    Dec.  5,    2001: for compatibility with ConTeXt, the |.exp|
%                           extensions were renamed into |.expl|
%                           (Bug reported by Eckhart Guthöhrlein,
%                            eckhart_guthoehrlein@public.uni-hamburg.de,
%                            July 3, 2001)
% 0.83    Dec. 23,    2002: in addPath, an incorrect use of infinity was
%                           replaced by length (infinity can't be used to
%                           get the end of a cyclic path, see metapost manual)
%                           (bug noticed by Jan Holfert (jan.holfert@gmx.net),
%                            comp.text.tex, 2002-05-13 15:00:07 PST,
%                            but never reported to me since);
%                           all other such misuses (in five other macros)
%                           have been corrected.
% 0.84    March 23,   2004: bug correction in newCircle (usually, only half
%                           of the cardinal points were correctly positionned)
%                           (bug noticed by Stephan Hennig,
%                            comp.text.tex, 2004-03-18 14:55:54 PST)
%                           The bug is also visible on page 43 of the manual,
%                           when the use of posA(n) is shown.
%                           It will be corrected in future versions of
%                           the manual.
% 0.85    April  9,   2004: arctime renamed into arctime_
%                           to avoid conflict with the cmarrows package
%                           (bug noticed by Stephan Hennig,
%                            comp.text.tex)
% 0.86    May   27,   2004: treemode made a global option of trees
%                           (bug noticed by Stephan Hennig)
%                           (Actually, a number of local options should be
%                            made global, and will probably be made so soon.)
% 0.87    June   1,   2004: - in drawTree, the root is unfilled only when
%                             there are fan children; before, it was always done
%                             (bug noticed by Stephan Hennig, May 29, 2004)
%                           - in all tc... macros, ntreepos was replaced
%                             by treeroot (bug noticed by Stephan Hennig, May 29, 2004)
%                           - labshift option now works when labels are attached
%                             to paths
% 0.88    October 5, 2005: - in newMatrix, the largest and tallest elements
%                            were not correctly computed when the options
%                            matrixnodehsize or matrixnodevsize were positive;
%                            surprisingly, these options had never been tested.
%                            (bug noticed by Stephan Hennig, September 2005)
% 0.89    October 23, 2005: - in newMatrix, the bounding box was not correctly
%                             computed when the options
%                             matrixnodehsize or matrixnodevsize were positive;
%                             (bug noticed by Stephan Hennig, October 2005)
%                           - also in newMatrix, the vertical distance between
%                             two rows was not correctly computed when the option
%                             matrixnodevsize was positive (the horizontal
%                             distance problem was corrected for version 0.88,
%                             but this one was forgotten)
%                             (bug noticed by Stephan Hennig, October 2005)
% 0.90    May 1st, 2006:    - in ObjLabel, user labels were only
%                             correctly positionned when the c point of the
%                             object was at the origin, because I had forgotten
%                             to translate the label. Incidentally, the bug
%                             occurred right next to the labshift bug corrected
%                             for version 0.87.
%                             (bug noticed by Stephan Hennig, May 2004,
%                              who reminded me on April 30, 2006)
% 0.91    June 18, 2006:    - connections such as ncdiag didn't use
%                             global defaults for angleA and angleB
%                             (bug noticed by Stephan Hennig, 18 June 2006)
%                             This was corrected in macro nc__.
% 0.92    Sep 27, 2006:     - define_local_picture_option added
%                               for labels on connections
%                              (this change, and those up to Oct. 5,
%                               were prompted by Steffen Reith
%                               Steffen Reith <streit@streit.cc>)
% 0.921   Oct  2, 2006:     - labpos, labpic, labdist, labangle
%                             and labdir can now be used with immediate
%                             connections
%         Oct  3, 2006:     - the objpathlabel_ macro had a bug related
%                             to the change of version 0.90, in that
%                             labels were not correctly positioned if
%                             the object was not centered at the origin;
%                             the problem had only partly been corrected
%                             in version 0.90;
%         Oct  5, 2006:     - finished the label code for connections
%                             added to objects (nc_core_)
%                           - the labdist option is now recognized also
%                             for ObjLabel
% 0.923   Nov 10, 2006:     - additional testing in nc__ for the case
%                             where the two object centers are the same;
%                           - new `curvemax' option for nccurve
%                             (prompted by Steffen Reith
%                               Steffen Reith <streit@streit.cc>)
%                           - `nccurve_' was extended to improve
%                             its behavior when the curve is looping
% 0.93    Dec 3,  2006:     - improvement of Container class
%                             to be mentioned in LGC2
%                             (this class was suggested by Michael Schwarz)
%
% The code has a lot of formatting for the mft program, but mft (even
% with Ulrick Vieth's changes) can't be used, because metaobj's code
% has too many idiosyncrasies. And besides, mft overflows anyway...

% Don't load this package twice:
if known metaobj_version: expandafter endinput; fi;

numeric metaobj_version;string metaobj_date;
metaobj_version=0.93;
metaobj_date="2006/12/03";
% The banner:
message "******* metaobj " & decimal (metaobj_version) &
        " (c) D. Roegel (" & metaobj_date & ") *******";message "";

tracingstats:=1;

% This helps simplifying the code.
def quote(expr s)=
  ditto & s & ditto
enddef;

% Compatibility with |boxes.mp|:
def boxit=newBox enddef;
def circleit=newEllipse enddef;

% Compatibility with |rboxes.mp| (which includes |boxes.mp|):
def rboxit=newRBox enddef;

% We also define |drawboxes|, |drawboxed|, |drawunboxed|, more or less
% similar to the ones in |boxes.mp|.
% The corresponding functions in |boxes.mp| also do |fixsize(t); fixpos(t);|

def drawboxed(text t) =         % Draw each box
  forsuffixes s=t:
    if unknown s.c: s.c=origin;fi;
    drawObj(s);
    draw BpathObj(s);
  endfor
enddef;

def drawunboxed(text t) =       % Draw contents of each box
  forsuffixes s=t:
    if unknown s.c: s.c=origin;fi;
    drawObj(s);
  endfor
enddef;

def drawboxes(text t) =         % Draw boundary path for each box
  forsuffixes s=t:
    if unknown s.c: s.c=origin;fi;    
    draw BpathObj(s);
  endfor
enddef;

%---------------------------------------------------------------------
% First, let's borrow two definitions from |boxes.mp|. We just give
% them different names to avoid conflicts.

% (from |str_prefix| in |boxes.mp|)
% Find the length of the prefix of string |s| for which |cond| is true for each
% character c of the prefix
vardef str_prefix_(expr s)(text cond) =
  save i_, c; string c;
  i_ = 0;
  forever:
    c := substring (i_,i_+1) of s;
    exitunless cond;
    exitif incr i_=length s;
  endfor
  i_
enddef;

% (from |generisize| in |boxes.mp|)
% Take a string returned by the |str| operator and return the same string
% with explicit numeric subscripts replaced by generic subscript symbols [].
vardef generisize_(expr ss) =
  save res, s, l; string res, s;
  res = "";             % result so far
  s = ss;               % left to process
  forever: exitif s="";
    l := str_prefix_(s, (c<>"[") and ((c<"0") or (c>"9")));
    res := res & substring (0,l) of s;
    s := substring (l,infinity) of s;
    if s<>"":
      res := res & "[]";
      l := if s>="[":  1 + str_prefix_(s, c<>"]")
           else:  str_prefix_(s, (c=".") or ("0"<=c) and (c<="9"))
           fi;
      s := substring(l,infinity) of s;
    fi
  endfor
  res
enddef;

% We also use |pathsel__| when constructing an ellipse.
% (from |pathsel_| in |boxes.mp|)
vardef pathsel__(expr a_,b_)(expr dhi)(expr circmargin)(text tt) =
  save f_, p_; path p_;
  p_ = origin..(a_,b_)+circmargin*unitvector(a_,b_);
  vardef f_(expr d_) =
    xpart((tt) intersectiontimes p_) >= 0
  enddef;
  solve f_(0,dhi+1.5circmargin)
enddef;

%---------------------------------------------------------------------

boolean show_object_names,show_corners,show_empty_boxes;
show_object_names=false;show_corners=false;
show_empty_boxes=false;

let obj=scantokens; % This is for clarity and should only be used
                    % when the argument of |scantokens| is a suffix
                    % representing an object. Otherwise, use |sc_|.
def Obj(expr n)=obj(iname_[n]) enddef;

% A few definitions to simplify the code
let sc_=scantokens;
% |currentObjname| is a string representing the current object
def sco_(expr s)=sc_(currentObjname&s) enddef;

def setcurrentobjname_(expr n)=
  save currentObjname;  
  string currentObjname;
  currentObjname=n;
enddef;

% An array of class names.
string Classes_[];
numeric nClasses_; % Number of different instanciated classes.
nClasses_=0;

numeric ClassName_[]; % The class name of an object.
                      % This is an index into the |Classes_| array.

% This array records the name of an object (not its class)
string iname_[];
% This function accesses the internal name.
def internalname_(expr n)=iname_[n] enddef;

def objClassName_(expr n)= Classes_[ClassName_[n]] enddef;

% Objects can have shortcut names; these are names defined
% by the user and which will lead to the object numbers.
% We use two arrays. The first has the shortcuts,
% the second has the object numbers.

string oname_[];
numeric ovalue_[];
numeric nshortcuts_;
nshortcuts_=0;

vardef addShortCut_(expr oname,ovalue)=
  save found;boolean found;found=false;
  for i:=1 upto nshortcuts_:
    if oname_[i]=oname:
      ovalue_[i]:=ovalue;
      found:=true;
    fi;
    exitif found;
  endfor;
  if not found:
    nshortcuts_:=nshortcuts_+1;
    oname_[nshortcuts_]=oname;
    ovalue_[nshortcuts_]:=ovalue;
  fi;
enddef;

% This function returns the number of an object, given its shortcut.
vardef objValue_(expr oname)=
  save val;numeric val;
  hide(
  for i:=1 upto nshortcuts_:
    if oname_[i]=oname:
      val:=ovalue_[i];
    fi;
    exitif known val;
  endfor;
  )
  val
enddef;

def nameToSuffixString_(expr s)=
  iname_[objValue_(s)]
enddef;

def nameToSuffix_(expr s)=
  obj(nameToSuffixString_(s))
enddef;

let O_=nameToSuffix_;

vardef addclass_(expr n,clname)=
  save i,j;
  if nClasses_>0:
    % first, see if |clname| is a known class name
    for i:=0 upto nClasses_-1:j:=i;
      exitif clname=Classes_[i];
    endfor;
    if clname=Classes_[j]:
      ClassName_[n]=j;
    else: % it is a new class name
      %createClassTest(clname); % we call it elsewhere
      ClassName_[n]=nClasses_;
      Classes_[nClasses_]=clname;
      nClasses_:=nClasses_+1;
    fi;
  else: % it is the first class name
    %createClassTest(clname); % we call it elsewhere
    ClassName_[n]=nClasses_;
    Classes_[nClasses_]=clname;
    nClasses_:=nClasses_+1;
  fi;
enddef;

def createClassTest(expr clname)=
  sc_ ("def is" & clname &
      "(suffix n)= (objClassName_(n)=" &
        ditto & clname & ditto & ") enddef;")
enddef;


% This is sometimes useful
vardef whateverstring = save ?; string ?; ? enddef;
def whateverpair = (whatever,whatever) enddef;


% We need an array to store option function names whose parameter
% is a string. For instance, when the option is "drawfunction(mydraw)",
% the string |"drawfunction"| is in the array and makes it possible
% to extract |"mydraw"| without calling the function |drawfunction|.
% This is not true of all option functions. Those having numeric
% parameters do not need a special treatment.

string opfunc_[];
numeric nopfunc_;nopfunc_=0;

% This function adds a string to the array.
% |addOptionFunction| should be called where the option functions
% are defined.
def addOptionFunction(expr s)=
  nopfunc_:=nopfunc_+1;
  opfunc_[nopfunc_]=s;
enddef;

% This function checks if a string is in the array:
vardef isOpFunc_(expr s)=
  save b;boolean b;
  hide(
    b=false;
    for i:=1 upto nopfunc_:
      if opfunc_[i]=s:b:=true;fi;
      exitif b;
    endfor;
    )
  b
enddef;

% This function takes a string such as |"drawfunction(mydraw)"|
% and replaces it with |"drawfunction("mydraw")"|
% if the function name (the first part, here |"drawfunction"|)
% is in the |opfunc_| array.
% The argument of the function can have parentheses, but they must
% be balanced. For instance, we can have |"color((0,1,1))"|.
% The argument can also contain spaces.

vardef correctOption_(expr s)=
  save a,b,c,l;string c;l=0; % parenthesis depth
  for i:=0 upto length(s)-1:
    c:=substring(i,i+1) of s;
    if (c="(") and (l=0): a:=i;
    elseif (c=")") and (l=1): b:=i;  
    fi;
    if c="(": l:=l+1;fi;
    if c=")": l:=l-1;fi;
  endfor;
  if isOpFunc_(substring(0,a) of s):
    (substring(0,a+1) of s &
     ditto & substring(a+1,b) of s & ditto
      & substring(b,infinity) of s)
  else: s
  fi
enddef;

% Apply a linear transformation to object |n|.
% The last parameter is of type |transform|.
% Fixed objects can be transformed, but they are untied.
vardef transformObj(suffix n)(expr $)=
  save p_,q_,i; pair p_[],q_[];
  memorizePoints_(n,$);
  % update the current transformation:
  n.ctransform_:=n.ctransform_ transformed $;
  % update the transformations for the non-standard labels
  % (such labels can be added to an object, even after several
  % transformations have been applied to it)
  if known n.ipic_.transf_.n_:
    for i:=1 upto n.ipic_.transf_.n_:
      n.ipic_.transf_[i]:=n.ipic_.transf_[i] transformed $;
    endfor;
  fi;
  % |message "transforming a box of type " & objClassName_(n);|
  begingroup
    save tie_function_; % used in the |subobjties_| strings
    for i:=1 upto n.nsubobjties_:
      % we define the function |tie_function_|:
      sc_ n.subobjties_[i];
      % and we call it:
      sc_ "tie_function_".n($);
    endfor;
  endgroup;
enddef;

% streamlined version: |n| is a number representing an object
vardef transform_Obj(expr n)(expr $)=
  hide(transformObj(obj(iname_[n]))($)) n
enddef;

% rotate object |n| by angle |$| around the origin
def rotateObj(suffix n)(expr $)=
  transformObj(n)(identity rotated $);
enddef;

% streamlined version: |n| is a number representing an object
vardef rotate_Obj(expr n)(expr $)=
  hide(rotateObj(obj(iname_[n]))($)) n
enddef;

% scale object |n| by |$|
def scaleObj(suffix n)(expr $)=
  transformObj(n)(identity scaled $);
enddef;

% streamlined version: |n| is a number representing an object
vardef scale_Obj(expr n)(expr $)=
  hide(scaleObj(obj(iname_[n]))($)) n
enddef;

% xscale object |n| by |$|
def xscaleObj(suffix n)(expr $)=
  transformObj(n)(identity xscaled $);
enddef;

% streamlined version: |n| is a number representing an object
vardef xscale_Obj(expr n)(expr $)=
  hide(xscaleObj(obj(iname_[n]))($)) n
enddef;

% yscale object |n| by |$|
def yscaleObj(suffix n)(expr $)=
  transformObj(n)(identity yscaled $);
enddef;

% streamlined version: |n| is a number representing an object
vardef yscale_Obj(expr n)(expr $)=
  hide(yscaleObj(obj(iname_[n]))($)) n
enddef;

% reflect object |n| around the line defined by the two points |$| and |$$|
def reflectObj(suffix n)(expr $,$$)=
  transformObj(n)(identity reflectedabout($,$$));
enddef;

% streamlined version: |n| is a number representing an object
vardef reflect_Obj(expr n)(expr $,$$)=
  hide(reflectObj(obj(iname_[n]))($,$$)) n
enddef;

% slant object |n| 
def slantObj(suffix n)(expr $)=
  transformObj(n)(identity slanted $);
enddef;

% streamlined version: |n| is a number representing an object
vardef slant_Obj(expr n)(expr $)=
  hide(slantObj(obj(iname_[n]))($)) n
enddef;

def declarestring_(expr s)(text l)=
  for $:=l:
    sc_("string " & s & "." & $);
  endfor;
enddef;

% |s| is an object; this function returns true if |s| has not been used
% as a prefix before.
def isNewPrefix(suffix s)=
  (not string s.pointlist_)
enddef;

% returns |true| if |v| is of type |t|, where both |t| and |v|
% are strings
def isOfType(expr t,v)=
  (sc_(t & " " & v))
enddef;

% returns a string representing the type of |v|
def TypeOf(expr v)=
  if numeric v:"numeric"
  elseif boolean v:"boolean"
  elseif pair v:"pair"
  elseif string v:"string"
  elseif color v:"color"
  elseif transform v:"transform"
  fi
enddef;

% |n| is the object and |s| its class
def assignObj(suffix n)(expr s)=
  n=incr(nObj_);   % new object number
  iname_[n]=str n; % the number and the associated string are recorded
                   % so that we can go from the number to the name
                   % (and hence to the object)
  addclass_(n,s);   % |n|'s class is memorized too
  % memorize a shortcut, if there is one:
  if known o_name_val:
    addShortCut_(o_name_val,n);
    o_name_val:=whateverstring;
  else:
    % we memorize the standard shortcut, which is |str n|, but only
    % if the object was given a name explicitely:
    if not streamlined_ and memorizeShortcuts:
      addShortCut_(str n,n);
    fi;
  fi;
  % reset |streamlined_|
  streamlined_:=false; 
  save gen_n_;string gen_n_;gen_n_=generisize_(str n);
  if not string n.pointlist_:
    declarestring_(gen_n_)(
              "pointlist_",      % list of points
              "pairlist_",       % list of pairs (non movable points)
              "pointarraylist_", % list of arrays
              "subarraylist_",   % list of arrays of subobjects
              "stringarraylist_",% list of arrays of strings
              "colorarraylist_", % list of arrays of colors 
              "picturearraylist_",% list of arrays of pictures
              "transformarraylist_",% list of arrays of transforms
              "booleanarraylist_",% list of arrays of booleans
              "numericarraylist_",   % list of arrays of numerics
              "pairarraylist_",  % list of arrays of pairs
              "points_in_arrayslist_", % list of all points of all arrays
              "picturelist_",    % list of pictures
              "numericlist_",    % list of numerics (useful for duplication)
	      "booleanlist_",    % list of booleans (ditto)
	      "colorlist_",      % list of colors (ditto)
	      "stringlist_",     % list of strings (ditto)
	      "transformlist_",  % list of transforms (ditto)
              "sublist_",        % list of subobjects
              "subobjties_[]",   % subobj tying equations (1 string/subobject)
              "code_",           % the code of an object
              "extra_code_");    % the extra code of an object
    expandafter numeric sc_(gen_n_).nsubobjties_;
               % number of subobjties
    expandafter transform sc_(gen_n_).ctransform_;
               % current transform of that object
  fi;
  % initialize the lists:
  forsuffixes $=pointlist_,pairlist_,pointarraylist_,subarraylist_,
    stringarraylist_,colorarraylist_,picturearraylist_,transformarraylist_,
    booleanarraylist_,numericarraylist_,pairarraylist_,points_in_arrayslist_,
    picturelist_,numericlist_,booleanlist_,colorlist_,stringlist_,
    transformlist_,sublist_,code_,extra_code_:
    n$:="";
  endfor;
  n.nsubobjties_=0;
  n.ctransform_:=identity;
  setcurrentobjname_(str n);
enddef;

numeric nObj_; % number of instanciated objects ($\geq$|nClasses_|)
               % and also last instanciated object
nObj_=0;

% There is no box with the number 0 and we reserve this number
% for the ``null box'' which is useful in certain places, such as matrices:
newinternal nb;
nb:=0;

% In order to refresh a |numeric| n: |n:=whatever;|
% (suggested by Bogus\l aw Jackowski on Jan 15, 2001 on the metafont list
%  in answer to a question I had asked)

def refresh_(text v)=
  if numeric v: v:=whatever;
  elseif pair v: v:=whateverpair;
    else: message "refresh_ is not defined for this type";
  fi;
enddef;

def refreshObjVars_(suffix n)(text v)=
  forsuffixes $=v:refresh_(n$);endfor;
enddef;

% This function makes it possible to declare pictures in an object.
% There can be several |ObjPicture| declarations in an object.
% (this is similar to |ObjPoint|)
vardef ObjPicture text l=
  forsuffixes $=l:
    if not isOfType("picture",currentObjname & "." & str $):
      sc_ ("picture " & generisize_(currentObjname) & "." & str $);
    fi;
  endfor;
  forsuffixes $=l:
    if sco_(".picturelist_")="":
      sco_(".picturelist_"):=str $;
    else:
      sco_(".picturelist_"):=sco_(".picturelist_") & "," & str $;
    fi;
  endfor;
enddef;

% Give a value to a picture variable and center the picture
% around the origin. All pictures will be centered around the origin
% and everytime we draw one (see |drawPicture|), we transform it.
% Pictures cannot be floating.
def setPicture(text v)(expr val)=
  sco_("." & str v)=val;
  sco_("." & str v):=
    sco_("." & str v) shifted -.5[urcorner(val),llcorner(val)];
enddef;

vardef drawPicture@#(suffix p) text options=
  draw @#p transformed @#ctransform_ shifted @#p.off options
           withcolor OptionValue.@#("picturecolor");
enddef;

% |ObjNumeric|, |ObjPair|, |ObjColor|, |ObjString| and |ObjTransform|
% are all created on the same model, using |defineObjType_|.

vardef defineObjType_(expr type,name)=
  sc_(
    "vardef Obj" & name & " text l=" &
      "forsuffixes $=l:" &
        "if not isOfType(" & quote(type) &
            ",currentObjname & " & quote(".") & "& str $):" &
          "sc_ (" & quote(type&" ") & " & generisize_(currentObjname) & " &
            quote(".") & " & str $);" &
        "fi;" &
      "endfor;" &
      "forsuffixes $=l:" &
        "if sco_(" & quote("." & type &"list_") & ")=" & quote("") & ":" &
          "sco_(" & quote("." & type &"list_") & "):=str $;" &
        "else:" &
          "sco_(" & quote("." & type &"list_") & "):=sco_(" &
            quote("." & type &"list_") & ") & " & quote(",") & " & str $;" &
        "fi;" &
      "endfor;" &
    "enddef;"
  );
  sc_(
    "def set" & name & "(text v)(expr val)=sco_(" &
        quote(".") & " & str v):=val;enddef;"
  );
enddef;

% |defineObjType_("numeric","Numeric");|

% This function makes it possible to declare numerical values
% as part of an object.
% There can be several |ObjNumeric| declarations in an object.
% (this is similar to |ObjPoint|)
% It defines both |ObjNumeric| and |setNumeric|.
defineObjType_("numeric","Numeric");

% This function makes it possible to declare pairs in an object.
% There can be several |ObjPair| declarations in an object
% Contrary to the points of |ObjPoint|, these are points
% that will not move with the object.
% They can be used for special purposes, for instance to store path data.
defineObjType_("pair","Pair");

defineObjType_("color","Color");
defineObjType_("boolean","Boolean");
defineObjType_("string","String");
defineObjType_("transform","Transform");

def BpathObj(suffix n)=
  sc_ ("Bpath" & objClassName_(n))(n)
enddef;

def StandardBpath(suffix n)= (n.inw--n.isw--n.ise--n.ine--cycle) enddef;

def BboxObj(suffix n)=(bbox(BpathObj(n))) enddef;

% Computes the real bounding box, without looking at the Bpath.
% The object must be attached.
% |bboxmargin| is used by |bbox|.
def rBboxObj(suffix n)=
  bbox(image(drawObj(n)))
enddef;

% This is like |decimal| but adds a "+" if the number is positive
def signeddecimal expr d=
  (if d>=0: "+" & decimal d else: decimal d fi)
enddef;

% min/max xpart/ypart of a list of points
def minmaxval(text f)(text xy)(expr pa,pb,pc,pd,pe,pf,pg,ph)=
  f(xy(pa),xy(pb),xy(pc),xy(pd),xy(pe),xy(pf),xy(pg),xy(ph))
enddef;

% Minimum xval of points |pa|, |pb|, ...
def xminval(expr pa,pb,pc,pd,pe,pf,pg,ph)=
  minmaxval(min)(xpart)(pa,pb,pc,pd,pe,pf,pg,ph) enddef;
% Maximum xval of points |pa|, |pb|, ...
def xmaxval(expr pa,pb,pc,pd,pe,pf,pg,ph)=
  minmaxval(max)(xpart)(pa,pb,pc,pd,pe,pf,pg,ph) enddef;
% Minimum yval of points |pa|, |pb|, ...
def yminval(expr pa,pb,pc,pd,pe,pf,pg,ph)=
  minmaxval(min)(ypart)(pa,pb,pc,pd,pe,pf,pg,ph) enddef;
% Maximum yval of points |pa|, |pb|, ...
def ymaxval(expr pa,pb,pc,pd,pe,pf,pg,ph)=
  minmaxval(max)(ypart)(pa,pb,pc,pd,pe,pf,pg,ph) enddef;

% Combines two real bounding boxes: both |bba| and |bbb|
% are paths. Only points 0 through 3 of each path are examined.
% This function is currently not used.
vardef combineTwoBBs(expr bba,bbb)=
  save xm,ym,xM,yM;
  hide(
    xm=xminval(point 0 of bba,point 1 of bba,point 2 of bba,point 3 of bba,
               point 0 of bbb,point 1 of bbb,point 2 of bbb,point 3 of bbb);
    ym=yminval(point 0 of bba,point 1 of bba,point 2 of bba,point 3 of bba,
               point 0 of bbb,point 1 of bbb,point 2 of bbb,point 3 of bbb);
    xM=xmaxval(point 0 of bba,point 1 of bba,point 2 of bba,point 3 of bba,
               point 0 of bbb,point 1 of bbb,point 2 of bbb,point 3 of bbb);
    yM=ymaxval(point 0 of bba,point 1 of bba,point 2 of bba,point 3 of bba,
               point 0 of bbb,point 1 of bbb,point 2 of bbb,point 3 of bbb);
  )
  ((xm,ym)--(xM,ym)--(xM,yM)--(xm,yM)--cycle)
enddef;

% |drawObj| takes a list of suffixes as parameters
def drawObj(text l)=
  forsuffixes $:=l:
    if show_object_names:
      % the name of the object is displayed at the upper right corner
      label(str $,$ne);
    fi;
    if show_corners:
      label("ne",$ne);label("se",$se);label("nw",$nw);label("sw",$sw);
    fi;
    % we must check if there is a specialized version of |drawObj|
    % for the current object, and call it if necessary.
    % We do it in such a way that it doesn't force a default
    % declaration on the object.
    if known sc_(str $).option_drawObj_:
      sc_ (OptionValue$("drawObj"))($);
    else:
      sc_ ("draw" & objClassName_($))($);
    fi;
    drawLabels$;
  endfor;
enddef;

% streamlined version: |n| is a number representing an object;
% contrary to other streamlined functions, this one does not return
% an object identification.
% |n| can also be a string shortcut for an object.
vardef draw_Obj(expr n)=
  if string n:
    drawObj(O_(n));
  else:
    drawObj(obj(iname_[n]));
  fi;
enddef;

% This function can only be used when the bounding path is continuous;
% if it is not the case, the |draw...| function for the object must be adapted.
def drawFramedOrFilledObject_(suffix n)=
  if OptionValue.n("framed"):
    % the shadow is the shadow of the frame, and we only show a shadow
    % if there is a frame
    if OptionValue.n("shadow"):
      fill (BpathObj(n) shifted (1mm,-1mm))
           withcolor OptionValue.n("shadowcolor");
    fi;
    % this removes most of the shadow 
    unfill BpathObj(n);
  fi;
  if OptionValue.n("filled"):
    fill BpathObj(n) withcolor OptionValue.n("fillcolor");
  fi;
  if OptionValue.n("framed"):
    pickup pencircle scaled OptionValue.n("framewidth");
    draw BpathObj(n) withcolor OptionValue.n("framecolor")
                     sc_(OptionValue.n("framestyle"));
    pickup defaultpen;
  fi;
enddef;

% This returns a picture corresponding to the drawing of object |n|
def pictureObj(suffix n)=
  image(drawObj(n))
enddef;

vardef memorizePoints_(suffix n)(expr $$)=
  save i,tmp,varlist_;string tmp,varlist_;
  % The array |p_[]| is not declared here, because it is also used elsewhere
  % (when the |.subobjties_| string is evaluated in |transformObj|)
  % We memorize all the points declared with |ObjPoint| and those
  % that are part of arrays. At this point, we have two strings and
  % we merely concatenate them:
  if n.pointlist_="":varlist_=n.points_in_arrayslist_;
  else:
    if n.points_in_arrayslist_<>"":
      varlist_=n.pointlist_ & "," & n.points_in_arrayslist_;
      else: varlist_=n.pointlist_;
    fi;
  fi;
  i=0;
  if varlist_<>"":
    forsuffixes $=sc_(varlist_):
      i:=i+1;p_[i]=n$;
    endfor;
  fi;
  refreshObjVars_(n)(sc_(varlist_));
  i:=0;
  if varlist_<>"":
    forsuffixes $=sc_(varlist_):i:=i+1;
      if i>1: % equation |$-tmp=(p_[i]-p_1) transformed $$|
        sc_ (str n & "." & str $ & "-" & tmp)=
             (p_[i]-p_1) transformed $$;
      else: tmp=str n & "." & str $;
      fi;  
    endfor;
  fi;
enddef;

% This function makes it possible to declare points in an object.
% There can be several |ObjPoint| declarations in an object
% These are points that will move with the object.
% Pairs that do not move can be declared with |ObjPair|.
vardef ObjPoint text l=
  forsuffixes $=l:
    if not isOfType("pair",currentObjname & "." & str $):
      sc_ ("pair " & generisize_(currentObjname) & "." & str $);
    fi;
  endfor;
  forsuffixes $=l:
    if sco_(".pointlist_")="":
      sco_(".pointlist_"):=str $;
    else:
      sco_(".pointlist_"):=sco_(".pointlist_") & "," & str $;
    fi;
  endfor;
enddef;

% We take as a convention that all objects have a minimal interface
% similar to the one given by |boxes.mp|. This does considerably
% facilitate reusability. In is not mandatory though.
% If you want the standard points, add |StandardPoints| as part of your object
% points (before the |ObjCode| section). You still have to use them in the
% equations, but it is also a good idea to include a few standard
% equations with |StandardEquations| (this is a string).
% Better though, is to write |StandardInterface| at the
% beginning of your object and use only inner points in the equations
% and drawing functions.
%
% The standard interface has the points ne,nw,se,sw,n,s,e,w,c;

def StandardPoints=
  ne,nw,sw,se,n,s,e,w,c
enddef;

% Drawings should not refer to the ``Standard Points,'' because it makes
% the drawings sensitive to bounding box changes.
% Instead, they should refer
% to their Inner variants, which are initially equal to them,
% as per the StandardInnerEquations
def StandardInnerPoints=
  ine,inw,isw,ise,in,is,ie,iw,ic
enddef;

vardef isStandardPoint@#=
  (
    (str @#="ne") or (str @#="nw") or (str @#="sw") or (str @#="se") or
    (str @#="n") or (str @#="s") or (str @#="e") or (str @#="w") or
    (str @#="c")
  )
enddef;

vardef StandardEquationsRaw@#=
  @#se-@#sw=@#ne-@#nw;  % parallelogram equation
  @#n=.5[@#ne,@#nw];    % North
  @#s=.5[@#se,@#sw];    % South
  @#e=.5[@#ne,@#se];    % East
  @#w=.5[@#nw,@#sw];    % West
  @#c=.5[@#n,@#s];      % Center
enddef;

% These are the equations connecting the outer bounding box
% (i.e. the interface) to the inner bounding box (the interface
% as seen from the inside)
def StandardInnerEquations=
  ("@#ine=@#ne;@#inw=@#nw;@#isw=@#sw;@#ise=@#se;@#in=@#n;@#is=@#s;" &
   "@#ie=@#e;@#iw=@#w;@#ic=@#c;")
enddef;


% It is important that this be a string, because there is a
% |sc_(PureStandardEquations)| somewhere.
def PureStandardEquations=
  ("@#se-@#sw=@#ne-@#nw;" & % parallelogram equation
   "xpart(@#se-@#ne)=0;" &
   "ypart(@#se-@#sw)=0;" &
   "@#n=.5[@#ne,@#nw];" &    % North
   "@#s=.5[@#se,@#sw];" &    % South
   "@#e=.5[@#ne,@#se];" &    % East
   "@#w=.5[@#nw,@#sw];" &    % West
   "@#c=.5[@#n,@#s];" )      % Center
enddef;

def StandardEquations=
  (PureStandardEquations & StandardInnerEquations)
enddef;

% This is the minimum set of equations for standard points,
% assuming only the middle relations. It is convenient if
% you want to control completely where the corners of the
% object are. This is for instance used in the |RandomBox| class.
def MinimumStandardEquations=
 ("@#n=.5[@#ne,@#nw];" &    % North
  "@#s=.5[@#se,@#sw];" &    % South
  "@#e=.5[@#ne,@#se];" &    % East
  "@#w=.5[@#nw,@#sw];" &    % West
  "@#c=.5[@#n,@#s];"        % Center
  & StandardInnerEquations)
enddef;

def StandardNumerics=
  dx,dy
enddef;

def StandardInterface=
  ObjPoint StandardPoints,StandardInnerPoints;
  ObjNumeric StandardNumerics;
enddef;

% Normally, the user can specify that a certain point in
% a certain subobject is tied (that is, is bound to it
% linearly, modulo the linear transformations) to
% a certain point in the main object.
% This is done with |tiePointToSubpoint(sw,sub,A)|
% for instance. If we assume that the first point of the
% main object (first in the point declarations)
% is always defined, and that this is the same for
% the subobjects, we can automatically tie all those
% pairs of points. The user will actually seldom
% need more. And what would that be anyway?
% If there are no subobjects, this function does nothing.
vardef StandardTies=
  save mainfirst,subfirst,co;
  string mainfirst,subfirst,co;
  co=currentObjname;
  mainfirst=firstPointOf_(co);
  % we loop over all subobjects
  % first, regular subobjects:
  if sc_(co).sublist_<>"":
    forsuffixes $:=sc_(sc_(co).sublist_):
      subfirst:=firstPointOf_(sc_(co)$);
      sc_("tiePointToSubpoint(" & mainfirst & "," &
          str $ & "," & subfirst & ")"); % ties |$subfirst| to |mainfirst|
    endfor;
  fi;
  % then arrays of subobjects:
  if sc_(co).subarraylist_<>"":
    forsuffixes $:=sc_(sc_(co).subarraylist_):
      for i:=1 upto sc_(co)$n_:
        % we check that the subobject is defined (in certain case,
        % such as matrices, there can be holes)
        if known sc_(co)$[i]:
          subfirst:=firstPointOf_(sc_(co)$[i]);
          sc_("tiePointToSubpoint(" & mainfirst & "," &
              str $ & decimal i & "," & subfirst & ")");
                % ties |$subfirst| to |mainfirst|
        fi;
      endfor;
    endfor;
  fi;
enddef;

% In order to extract the first point of an object,
% we go through its |pointlist_| string, and exit
% as soon as we have a suffix. In case this string is empty
% (that's very unlikely), we go through |points_in_arrayslist_|.
% If both are empty, there is no first point and we return an empty string.
% |n| is a suffix in string form.
vardef firstPointOf_(expr n)=
  save first_;string first_;
  hide(
  forsuffixes $:=sc_(sc_(n).pointlist_):
    first_:=str $;
    exitif first_<>"";
  endfor;
  if first_="":
    forsuffixes $:=sc_(sc_(n).points_in_arrayslist_):
      first_:=str $;
      exitif first_<>"";
    endfor;
  fi;)
  first_
enddef;

% This function finds the internal index of a point, where
% the |ObjPoint|s come first, then the points defined in an |ObjPointArray|.
% For instance, if |ObjPoint a,b,c| and |ObjPointArray(po)(7)|,
% the index of |a| is 1, the index of |b| is 2, the index of |c| is 3,
% the index of |po1| is 4, the index of |po2| is 5, etc.
% |n| is the object.
vardef indexOfPoint(suffix n)(text v)=
  save i_,j_,found_; % |v| can't be |i_| or |j_|
  hide(
  boolean found_;found_=false;
  j_:=0;
  if n.pointlist_<>"":
    forsuffixes i_:=sc_(n.pointlist_):
      j_:=j_+1;
      if str i_=str v:found_:=true;fi;
      exitif found_;
    endfor;
  fi;
  if not found_:
    if n.points_in_arrayslist_<>"":
      for i_:=sc_(n.points_in_arrayslist_):
        j_:=j_+1;
        if str i_=str v:found_:=true;fi;
        exitif found_;
      endfor;
    fi;
  fi;
  if not found_:j_:=0;fi;
  ) j_
enddef;

% This function needs to be called when points are added to an array
vardef addPointToPointArray@#(suffix a)=
  save co;string co;co=str @#;
  @#a.n_:=@#a.n_+1;
  if sco_(".points_in_arrayslist_")="":
    sco_(".points_in_arrayslist_"):=str a & decimal @#a.n_;
  else:
    sco_(".points_in_arrayslist_"):=
            sco_(".points_in_arrayslist_") & "," & str a & decimal @#a.n_;
  fi;  
enddef;

% These are points that will move with the object.
% Pairs that do not move can be declared with |ObjPairArray|.
vardef ObjPointArray(suffix a)(expr n)=
  save co;string co;co=currentObjname;
  if not isOfType("pair",co & "." & str a & "1"):
    sc_ ("pair " & generisize_(co) & "." & str a & "[]");
  fi;
  sco_("." & str a & ".n_"):=n;
  if sco_(".pointarraylist_")="":
    sco_(".pointarraylist_"):= str a;
  else:
    sco_(".pointarraylist_"):=sco_(".pointarraylist_") &","& str a;
  fi;
  for i:=1 upto n:
    if sco_(".points_in_arrayslist_")="":
      sco_(".points_in_arrayslist_"):=str a & decimal i;
    else:
      sco_(".points_in_arrayslist_"):=
            sco_(".points_in_arrayslist_") & "," & str a & decimal i;
    fi;
  endfor;
enddef;


% For pairs:
%   |name| can be |"Pair"|
%   |type|        |"pair"|
%   |var|         |"pairarraylist_"|
% This creates a function |ObjPairArray| storing the pairs
% in the |"pairarraylist_"| variable of the current object.
% The first parameter of |ObjPairArray| is the name of the array
% and the second parameter is its size. The function created memorizes
% the size of the array.
% The size can be modified afterwards, but only as many elements
% as were announced will be manipulated in automatic operations
% such as |duplicateObj|.
vardef defineArrayFunction(expr name)(expr type)(expr var)=
  save tmp;string tmp;
  tmp="vardef Obj" & name & "Array(suffix a)(expr n)=" &
        "save co;string co;co=currentObjname;" &
        "if not isOfType(" & quote(type) &",co & " & quote(".") &
            " & str a & " & quote("1") & "):" &
          "sc_ (" & quote(type & " ") & " & generisize_(co) & " &
            quote(".") & " & str a & " & quote("[]") & ");" &
        "fi;" &
        "sco_(" & quote(".") & " & str a & " &
            quote(".n_") & "):=n;" &
        "if sco_(" & quote("." & var) & ")=" & quote("") & ":" &
          "sco_(" & quote("." & var) & "):= str a;" &
        "else:" &
          "sco_(" & quote("." & var) & "):=" &
             "sco_(" & quote("." & var) & ") & " &
                  quote(",") & " & str a;" &
        "fi;" &
      "enddef;";
  sc_ tmp;
enddef;

defineArrayFunction("Numeric")("numeric")("numericarraylist_");
defineArrayFunction("String")("string")("stringarraylist_");
defineArrayFunction("Sub")("string")("subarraylist_");
defineArrayFunction("Pair")("pair")("pairarraylist_");
defineArrayFunction("Color")("color")("colorarraylist_");
defineArrayFunction("Picture")("picture")("picturearraylist_");
defineArrayFunction("Transform")("transform")("transformarraylist_");
defineArrayFunction("Boolean")("boolean")("booleanarraylist_");

% |t| is a list of strings, representing the object code,
% including equations (see examples)
vardef ObjCode text l=
  save s_,mac_,i_; % notice that we don't have to say that |s_| is a string!
  string mac_;mac_="";
  % The problem with object code and the equations it contains
  % is that they contain the name of the object,
  % but as given in the new... macro.
  % We only have the formal parameter name!
  % We must assume that it is `|@#|'. Maybe in the future, we will
  % guess it from the equations. Hope is not lost!
  % We now define locally (just in this |ObjCode| macro)
  % a macro having `|@#|' as a suffix parameter:
  % The macro looks like:
  %  |vardef code_function_@#= <the equations> enddef;|

  for s_:=l:mac_:=mac_&s_ & ";"; endfor;
  % we store the equations in the object; this is useful when an
  % object gets duplicated:
  sco_(".code_"):=mac_;
  begingroup; % we want the |vardef| macro only defined locally;
              % we don't need it later
    save code_function_;
    mac_:="vardef code_function_@#=" & mac_ & " enddef;";
    sc_ mac_; % this defines the macro
    % we call it with
    sc_ ("code_function_." & currentObjname);
  endgroup;
enddef;

% This function adds equations to an already existing object.
% These equations should only define new points, not alter
% previously defined points. 
vardef addObjCode@# text l=
  save mac;string mac;mac="";
  for s:=l:mac:=mac&s & ";"; endfor;
  @#code_:=@#code_ & mac;
enddef;

vardef addObjExtraCode@# text l=
  save mac;string mac;mac="";
  for s:=l:mac:=mac&s & ";"; endfor;
  @#extra_code_:=@#extra_code_ & mac;
enddef;

% |sub| is a field name and |t| is the subobject name
% we could even use the same name for boths
def SubObject(suffix sub)(suffix t)=
  if expandafter not expandafter string sco_("." & str sub):
    sc_ ("string " & generisize_(currentObjname) & "." & str sub);
  fi;
  sco_("." & str sub)=str t;
  if sco_(".sublist_")="":
    sco_(".sublist_"):=str sub;
  else:
    sco_(".sublist_"):=sco_(".sublist_") & "," & str sub;
  fi;
enddef;

def SubObjectOfArray(suffix sub)(suffix t)=
  sco_("." & str sub)=str t;
enddef;

% Point |b| of subobject |sub| (of the current object)
% is tied to point |a| of the current object.
% This means that we memorize an equation.
vardef tiePointToSubpoint(suffix a,sub,b)=
  save co,n,j;string co;co=currentObjname;
  obj(co).nsubobjties_:=obj(co).nsubobjties_+1;
  n=obj(co).nsubobjties_;
  % We must memorize the following code:
  %   |q_[n]=obj(co.sub).b;|
  %   |transformObj(obj(currentObjname.sub))($);|
  %   |co.a-obj(co.sub).b=(p_[j]-q_[n]) transformed $;|
  % (where |p_[j]| is the memorized value of the current objects' "a" point)
  % We have to find `|j|':
  j=indexOfPoint(obj(co))(a);
  % we store everything in a |vardef|, using |@#| instead of co
  % (this is necessary for matters of duplication)
  obj(co).subobjties_[n]:=
   "vardef tie_function_@#(expr $)=" &
     "q_" & decimal n & "=obj(@#" & str sub & ")." & str b &";" &
     "transformObj(obj(@#" & str sub & "))($);" &
     "@#" & str a & "-obj(@#" & str sub & ")." & str b &
     "=(p_" & decimal j & "-q_" & decimal n & ") transformed $;" &
    "enddef;";
enddef;

% Generation of new names (suffixes):
% All the names will start with |"_______"|.
% This initial string can be changed but it must end with |_|.
% The suffixes are generated in that order:
% |_______a|, |_______b|, |_______c|, ..., |_______z|,
% |_______aa|, |_______ab|, |_______ac|, ..., |_______az|,
% |_______ba|, ..., |_______bz|, |_______ca|, ...,
% |_______zz|, |_______aaa|, |_______aab|, etc.  
% All we need to is remember the last created suffix.
% We store it in a string:
string last_obj_;last_obj_="_______";

vardef newobjstring_=
  save l,prefix,lastchar,lastpos,lastposchar;
  hide(
    numeric lastpos;
    string prefix,lastchar,lastposchar;
    l=length(last_obj_);
    lastchar=substring (l-1,l) of last_obj_;
    if lastchar="_":
      last_obj_:=last_obj_ & "a";
    elseif lastchar="z":
      % in this case, we find the last character different from "z";
      % it is either a letter, or `|_|'
      lastpos=l;
      for i:=l-1 downto 1:
        lastpos:=i;
        lastposchar:=substring (i-1,i) of last_obj_;
        exitif (lastposchar<>"z");
      endfor;
      if lastposchar="_": % in this case, we have only z's
        last_obj_:=last_obj_ & "a";
      else:
        last_obj_:=(substring (0,lastpos-1) of last_obj_) &
           char(ASCII lastposchar +1)
           for i:=lastpos+1 upto l: & "a" endfor;
      fi;
    else:
      last_obj_:=
        (substring (0,l-1) of last_obj_) & char(ASCII lastchar +1);
    fi;
    )
  last_obj_
enddef;


% We can call this function for instance with
% |duplicateArray_(n,m)("ObjStringArray")(stringarraylist_)|
vardef duplicateArray_(suffix n,m)(expr f)(suffix var)=
  if m.var<>"":
    forsuffixes $:=sc_(m.var):
      sc_(f & "(" & str $ & ")(" & decimal m$n_ & ");");
      % we can do the previous |Obj...Array| because |assignObj|
      % defined the current object
      % we also fill the array:
      for i:=1 upto m$n_:
        n$[i]:=m$[i];
      endfor;
    endfor;
  fi;
enddef;

% This creates a copy of object |m| in object |n|
% If |n| contained something, it gets either overriden (if the fields
% were common with those of |m|, or meaningless (if the fields
% were not common with those of |m|)
% The various strings are copied, and the object code is executed
% (this recreates the equations, as when the object is created by
% a constructor). The difference with the constructor is that
% no parameter is given and that we make a deep copy.
% We also copy the subobjects.
% Problem: we need new names for the subobjects.
% We solve that problem by using the ``name generator'' |newobjstring_|
%
vardef duplicateObj(suffix n,m)=
  assignObj(n)(objClassName_(m)); % new number, but same type
  % |n.pointlist_:=m.pointlist_;| % (see below)
  % |n.pointarraylist_:=m.pointarraylist_;| % (see below)
  % |n.points_in_arrayslist_:=m.points_in_arrayslist_;| % (see below)
  n.code_:=m.code_;
  n.extra_code_:=m.extra_code_;
  % |n.picturelist_:=m.picturelist_;| % (see below)
  n.nsubobjties_:=m.nsubobjties_;
  for i:=1 upto n.nsubobjties_:
    n.subobjties_[i]:=m.subobjties_[i];
  endfor;

  n.sublist_:=m.sublist_; % list of subobjects (this doesn't change,
                          % but the values of the subobjects will be new)
  % create the types:
  if m.pointlist_<>"":
    % this also fills |n.pointlist_|
    sc_ ("ObjPoint " & m.pointlist_); 
  fi;
  if m.picturelist_<>"":
    % this also fills |n.picturelist_| and creates all appropriate variables
    sc_ ("ObjPicture " & m.picturelist_); 
  fi;

  % Duplication of numerical values:
  if m.numericlist_<>"":
    sc_ ("ObjNumeric " & m.numericlist_); % this also fills |n.numericlist_|
  fi;
  
  % Duplication of boolean values:
  if m.booleanlist_<>"":
    sc_ ("ObjBoolean " & m.booleanlist_); % this also fills |n.booleanlist_|
  fi;
  
  % Duplication of color values:
  if m.colorlist_<>"":
    sc_ ("ObjColor " & m.colorlist_); % this also fills |n.colorlist_|
  fi;
  
  % Duplication of string values:
  if m.stringlist_<>"":
    sc_ ("ObjString " & m.stringlist_); % this also fills |n.stringlist_|
  fi;
  
  % Duplication of transform values:
  if m.transformlist_<>"":
    sc_ ("ObjTransform " & m.transformlist_); % fills also |n.transformlist_|
  fi;
  
  % Duplication of pairs:
  if m.pairlist_<>"":
    sc_ ("ObjPair " & m.pairlist_); % this also fills |n.pairlist_|
  fi;
  
  % copy the current transformation of the object:
  n.ctransform_:=m.ctransform_;

  save gen_n_;string gen_n_;gen_n_=generisize_(str n);
  % we copy the options and their values:
  if known m.options_:
    %if (gen_n_=str n): % UNSURE IF THIS SHOULD ALWAYS BE COMMENTED (October 23, 2005)
      if unknown n.options_:
        expandafter string sc_(gen_n_).options_;
      fi;
    %fi
    n.options_=m.options_;
    forsuffixes $:=sc_(n.options_):
      % each |$| suffix starts with a |_|
      %if gen_n_=str n: % UNSURE IF THIS SHOULD ALWAYS BE COMMENTED (October 23, 2005)
        if expandafter unknown sc_(str n & ".option" & str $ & "_"):
          sc_(TypeOf(sc_(str m & ".option" & str $ & "_")) & " " &
            gen_n_ & ".option" & str $ & "_");
        fi;
      %fi;
      n.sc_("option" & str $ & "_")=m.sc_("option" & str $ & "_");
    endfor;
  fi;

  % we copy the numerical, pair and picture values if there are any
  forsuffixes $$=numericlist_,booleanlist_,colorlist_,stringlist_,
                 transformlist_,pairlist_,picturelist_:
    if n$$<>"":
      forsuffixes $:=sc_(n$$):n$:=m$;endfor;
    fi;
  endfor;

  % the following fills |n.pointarraylist_|
  % as well as |n.points_in_arrayslist_|
  if m.pointarraylist_<>"":
    forsuffixes $:=sc_(m.pointarraylist_):
      sc_("ObjPointArray(" & str $ & ")(" & decimal m$n_ & ");");
      % we can do the previous |ObjPointArray| because |assignObj|
      % defined the current object
    endfor;
  fi;
  
  % We duplicate the numeric arrays:
  duplicateArray_(n,m)("ObjNumericArray")(numericarraylist_);
  
  % We duplicate the pair arrays (non movable points);
  % this includes the structures memorizing paths:
  duplicateArray_(n,m)("ObjPairArray")(pairarraylist_);
  
  % We duplicate the string arrays:
  % it also fills |n.stringarraylist_|
  duplicateArray_(n,m)("ObjStringArray")(stringarraylist_);

  % We duplicate the color, picture, transform and boolean arrays:
  duplicateArray_(n,m)("ObjColorArray")(colorarraylist_);
  duplicateArray_(n,m)("ObjPictureArray")(picturearraylist_);
  duplicateArray_(n,m)("ObjTransformArray")(transformarraylist_);
  duplicateArray_(n,m)("ObjBooleanArray")(booleanarraylist_);
  
  % this is similar, but for Object arrays
  % it also fills |n.subarraylist_|
  if m.subarraylist_<>"":
    forsuffixes $:=sc_(m.subarraylist_):
      sc_("ObjSubArray(" & str $ & ")(" & decimal m$n_ & ");");
      % we can do the previous |ObjSubArray| because |assignObj|
      % defined the current object
      % Here, we do not copy the strings, because we are doing a deep copy
    endfor;
  fi;
  
  % Copy the information on subobjects (variables) and
  % call |duplicateObj| appropriately

  % First, the subobjects that are not part of arrays of subobjects:
  % we go through all suffixes corresponding to subobjects
  % of object |m|, and for each, we create a new name
  save newsub_;string newsub_;
  if n.sublist_<>"":
    forsuffixes $:=sc_(n.sublist_):
      newsub_:=newobjstring_;
      % first, create the type:
      if not string n$:
        sc_("string " & generisize_(str n & "." & str $));
      fi;
      n$:=newsub_;
      % we must now duplicate |obj(m$)| as |obj(n$)|; this will
      % also choose a value for |obj(m$)|
      duplicateObj(obj(n$),obj(m$));
    endfor;
  fi;
  % Second, the subobjects that are part of arrays of subobjects:
  % we go through all arrays of subobjects
  % of object |m|, and for each, we create a new name
  if n.subarraylist_<>"":
    forsuffixes $:=sc_(n.subarraylist_):
      % and now, we go through each element of the array:
      for i:=1 upto m$n_:
        % we only duplicate if there is something
        % (in matrices, for instance, certain objects can be null)
        if known m$[i]:
          newsub_:=newobjstring_;
          n$[i]:=newsub_;
          duplicateObj(obj(n$[i]),obj(m$[i]));
        fi;
      endfor;
    endfor;
  fi;

  % relink everything: we take the first point of this object,
  % and recreate all equations; we cannot take the code stored,
  % because it is the initial code, and the duplication of a
  % rotated object would then not be a rotated object
  % (except if we store all transformations, but this would
  % restrict us anyway to linear transformations)
  save mainfirst;string mainfirst;
  mainfirst=firstPointOf_(str n);
  
  % go through all points except the first, and relink
  forsuffixes $$=pointlist_,points_in_arrayslist_:
    if n$$<>"":
      forsuffixes $:=sc_(n$$):
        if str $<>mainfirst:
          n.sc_(mainfirst)-n$=m.sc_(mainfirst)-m$;
        fi;
      endfor;
    fi;
  endfor;

  % go to all regular subobjects, and relink

  if n.sublist_<>"":
    forsuffixes $:=sc_(n.sublist_):
      n.sc_(mainfirst)-obj(n$).obj(firstPointOf_(n$))=
        m.sc_(mainfirst)-obj(m$).obj(firstPointOf_(m$));
    endfor;
  fi;

  % go through all array subobjects, and relink;
  % we go through all arrays of subobjects
  % of object |m|, and for each, we create a new name
  if n.subarraylist_<>"":
    forsuffixes $:=sc_(n.subarraylist_):
      % and now, we go through each element of the array:
      for i:=1 upto n$n_:
        if known n$[i]:
          n.sc_(mainfirst)-obj(n$[i]).obj(firstPointOf_(n$[i]))=
            m.sc_(mainfirst)-obj(m$[i]).obj(firstPointOf_(m$[i]));
        fi;
      endfor;
    endfor;
  fi;
enddef;

% Streamlined version of |duplicateObj|: |n| is a number representing an object
% This function takes a number representing an object,
% duplicates it and returns a number representing its duplication.
vardef duplicate_Obj(expr n)=
  save newname_;string newname_;
  hide(
    % we do not set |streamlined_| to true, because it should be
    % used only before a constructor is called, which is not the case here.
    % first, choose a new name for the duplication:
    newname_:=newobjstring_;
    duplicateObj(obj(newname_),obj(iname_[n]));
  ) sc_(newname_)
enddef;

% This function merely unties all points of an object,
% but keeps the equations. Also, the subobjects remain attached
% to the main object. What it does is part of what
% |duplicateObj| does.
% |untieObj| is applied recursively.
%
% This function makes it possible to draw an object somewhere,
% to untie it and move it elsewhere, to draw it there, etc.
% We could achieve the same effect with duplication, but it would
% consume more memory.
vardef untieObj(suffix n)=
  save fp,p_,q_,i;
  string fp;pair p_[],q_[];
  % we first extract a point
  fp=firstPointOf_(str n);
  % we now go through all the points and store the differences
  % with the point |fp|
  i:=0;
  forsuffixes $$=pointlist_,points_in_arrayslist_:
    if n$$<>"":
      forsuffixes $:=sc_(n$$):i:=i+1;
        p_[i]=n$-n.sc_(fp);
      endfor;
    fi;
  endfor;

  % we also store the positions of the first points of all subobjects
  i:=0;
  
  if n.sublist_<>"":
    forsuffixes $:=sc_(n.sublist_):i:=i+1;
      q_[i]=obj(n$).obj(firstPointOf_(n$))-n.sc_(fp);
    endfor;
  fi;
  if n.subarraylist_<>"":
    forsuffixes $:=sc_(n.subarraylist_):
      for j:=1 upto n$n_:
        if known n$[j]:
          i:=i+1;
          q_[i]=obj(n$[j]).obj(firstPointOf_(n$[j]))-n.sc_(fp);
        fi;
      endfor;
    endfor;
  fi;
  
  % we refresh all points:

  save varlist_;string varlist_;
  if n.pointlist_="":varlist_=n.points_in_arrayslist_;
  else:
    if n.points_in_arrayslist_<>"":
      varlist_=n.pointlist_ & "," & n.points_in_arrayslist_;
      else: varlist_=n.pointlist_;
    fi;
  fi;
  refreshObjVars_(n)(sc_(varlist_));

  % we untie the subobjects

  if n.sublist_<>"":
    forsuffixes $:=sc_(n.sublist_):
      untieObj(obj(n$));
    endfor;
  fi;
  if n.subarraylist_<>"":
    forsuffixes $:=sc_(n.subarraylist_):
      for j:=1 upto n$n_:
        if known n$[j]:
          untieObj(obj(n$[j]));
        fi;
      endfor;
    endfor;
  fi;
  
  % and we recreate the differences from the ones stored:
  % (exactly the same code as above!)
  i:=0;
  forsuffixes $$=pointlist_,points_in_arrayslist_:
    if n$$<>"":
      forsuffixes $:=sc_(n$$):i:=i+1;
        p_[i]=n$-n.sc_(fp);
      endfor;
    fi;
  endfor;

  % we also attach again the subobjects
  % (also exactly the same code as above!)
  i:=0;
  if n.sublist_<>"":
    forsuffixes $:=sc_(n.sublist_):i:=i+1;
      q_[i]=obj(n$).obj(firstPointOf_(n$))-n.sc_(fp);
    endfor;
  fi;
  if n.subarraylist_<>"":
    forsuffixes $:=sc_(n.subarraylist_):
      for j:=1 upto n$n_:
        if known n$[j]:
          i:=i+1;
          q_[i]=obj(n$[j]).obj(firstPointOf_(n$[j]))-n.sc_(fp);
        fi;
      endfor;
    endfor;
  fi;  
enddef;

% Draw an array of objects. |n| is the object, |a| is the array,
% and the number of elements are assumed to be |a.n_|
% If you don't want to draw all the subobjects, make your own function.

def drawObjArray(suffix n)(suffix a)=
  for i:=1 upto n.a.n_:
    if known n.a[i]: % in certain cases (for instances matrices),
                     % we can have holes in the array
      drawObj(obj(n.a[i]));
    fi;
  endfor;
enddef;

% One idea for implementing |resetObj.expl| is to have the object
% constructor behave in a certain way when a flag is set. This way
% would be to refresh the variables, and to call again the equations.
% The problem with this approach is that subobjects have also to
% be reset, and this makes it necessary to give again the
% parameters of the constructor, since we don't save them,
% and since there is no constructor overloading in metapost.
% Hence, we decided to merely use the code in |ObjCode| sections.
% We first refresh the variables (only points), then call
% reset on the subobjects, then execute the memorized code.
% This constrains the user to put his code in |ObjCode|.
% (Otherwise, if |resetObj.expl| is never used, the code can just
% be given outside |ObjCode|, and not in strings.)

vardef resetObj.expl@#=
  save varlist_;string varlist_;
  % refresh the points (also those in arrays)
  if @#pointlist_="":varlist_=@#points_in_arrayslist_;
  else:
    if @#points_in_arrayslist_<>"":
      varlist_=@#pointlist_ & "," & @#points_in_arrayslist_;
      else: varlist_=@#pointlist_;
    fi;
  fi;
  refreshObjVars_(@#)(sc_(varlist_));
  
  % reset the current transformation:
  @#ctransform_:=identity;

  % reset the label transformations
  % (as can be observed, this does not place us back in the
  % initial state, if labels were only added after the application
  % of a transformation to an object)
  if known @#ipic_.n_:
    for i:=1 upto @#ipic_.n_:
      @#ipic_.transf_[i]:=identity;
    endfor;
  fi;
  
  % reset all subobjects

  if @#sublist_<>"":
    forsuffixes $:=sc_(@#sublist_):
      resetObj.expl.obj(@#.$);
    endfor;
  fi;
  if @#subarraylist_<>"":
    forsuffixes $:=sc_(@#subarraylist_):
      % and now, we go through each element of the array:
      for i:=1 upto @#.$n_:
        if known @#.$[i]:
          resetObj.expl.obj(@#.$[i]);
        fi;
      endfor;
    endfor;
  fi;

  % call the code
  begingroup; % we want the |vardef| macro only defined locally;
              % we don't need it later
    save code_function_;
    % define the function
    sc_("vardef code_function_@#=" & @#code_ & @#extra_code_ &
                   " enddef;");
    % call it
    code_function_@#;
  endgroup;
  
enddef;

% In order to find which point of an object is the most
% to the left, we search which of the four corners is such that
% all others are to its right. We return a string corresponding
% to the corner. |"sw"| for |sw|, etc.
% This function does not assume the corners to be determined,
% but it assumes that the vector between two points is known.
% |f| is |xpart| or |ypart|
% |g| is |<| or |>|
vardef findmost@#(text f)(text g)=
  save found_,i,corner;
  hide(
  string corner;boolean found_;found_=false;
  forsuffixes $:=nw,ne,sw,se:
    i:=0;
    forsuffixes $$:=nw,ne,sw,se:
      exitif f (@#.$$-@#.$) g 0;
      i:=i+1;
    endfor;
    if i=4:found_:=true;corner:=str $;fi;
    exitif found_;
  endfor;
  )
  corner
enddef;

% Recursive version of |findmost|. This function returns a numeric
% corresponding to the x or y part of a point.
% |f| is |xpart| or |ypart| and |g| is |<| or |>|
vardef findrecmost@#(text f)(text g)=
  save found_,i,corner,currentsub;
  hide(
    numeric corner,currentsub;boolean found_;found_=false;
    % first, we check the four corners of the object
    forsuffixes $:=nw,ne,sw,se:
      i:=0;
      forsuffixes $$:=nw,ne,sw,se:
        exitif f (@#.$$-@#.$) g 0;
        i:=i+1;
      endfor;
      if i=4:found_:=true;corner:=f(@#.$);fi;
      exitif found_;
    endfor;
    % then, we check each subobject recursively:
    % and first, the regular subobjects:
    if @#sublist_<>"":
      forsuffixes $:=sc_(@#sublist_):
        % check |obj(@#.$)|:
        currentsub:=findrecmost.obj(@#.$)(f)(g);
        if not (corner-currentsub g 0):
          corner:=currentsub;
        fi;
      endfor;
    fi;
    % and second, the subobjects that are part of arrays of subobjects:
    % we go through all arrays of subobjects  of object |@#|:
    if @#subarraylist_<>"":
      forsuffixes $:=sc_(@#subarraylist_):
        % and now, we go through each element of the array:
        for i:=1 upto @#.$n_:
          % check |obj(@#.$[i])|:
          if known @#.$[i]:
            currentsub:=findrecmost.obj(@#.$[i])(f)(g);
            if not (corner-currentsub g 0):
              corner:=currentsub;
            fi;
          fi;
        endfor;
      endfor;
    fi;
    )
  corner
enddef;

% These functions return a string corresponding to a suffix:
vardef find_lft_most@#= findmost@#(xpart)(<) enddef;
vardef find_rt_most@#=  findmost@#(xpart)(>) enddef;
vardef find_top_most@#= findmost@#(ypart)(>) enddef;
vardef find_bot_most@#= findmost@#(ypart)(<) enddef;

% The following are recursive versions of the previous functions.
% These functions return a numeric.
vardef findrec_lft_most@#= findrecmost@#(xpart)(<) enddef;
vardef findrec_rt_most@#=  findrecmost@#(xpart)(>) enddef;
vardef findrec_top_most@#= findrecmost@#(ypart)(>) enddef;
vardef findrec_bot_most@#= findrecmost@#(ypart)(<) enddef;

%========================================================================
% Streamlining

% We use a boolean to keep distinguish a streamlined function, from
% a non-streamlined one. This is needed to find out if a name has been
% given explicitely to an object.
boolean streamlined_;streamlined_=false;
% This boolean is set to true, which means that every time
% an object is defined with an explicit name, the string version
% of the name can be used as a shortcut. This is sometimes useful.
% Setting the boolean to false saves some space.
boolean memorizeShortcuts;memorizeShortcuts=true;

% Called with something like |streamline("BB")("(expr t)","suffixpar(t)");|
% where |t| represents the {\it number\/} of an object,
% the streamline function creates two variants of a constructor:
% 1) a first variant without options:
%|vardef new_BB(expr t)=|
%|  save newname_;string newname_;|
%|  hide(|
%|    streamlined_:=true;|
%|    newname_:=newobjstring_;|
%|    newBB.sc_(newname_) suffixpar(t);|
%|  )|
%|  sc_(newname_)|
%|enddef;|

% 2) a second variant with options:
%|vardef new_BB_(expr t)(text options)=|
%|  save newname_;string newname_;|
%|  hide(|
%|    streamlined_:=true;|
%|    newname_:=newobjstring_;|
%|    newBB.sc_(newname_) suffixpar(t) options;|
%|  )|
%|  sc_(newname_)|
%|enddef;|

% Called with something like
% |streamline("Tree")("(expr theroot)(text subtrees)",|
%                    |"suffixpar(theroot) suffixlist(subtrees)");|
% the streamline function creates the two variants:
%|vardef new_Tree(expr theroot)(text subtrees)=|
%|  save newname_;string newname_;|
%|  hide(|
%|    streamlined_:=true;|
%|    newname_:=newobjstring_;|
%|    newTree.sc_(newname_) suffixpar(theroot) suffixlist(subtrees);|
%|  )|
%|  sc_(newname_)|
%|enddef;|
%
% and
%
%|vardef new_Tree_(expr theroot)(text subtrees)(text options)=|
%|  save newname_;string newname_;|
%|  hide(|
%|    streamlined_:=true;|
%|    newname_:=newobjstring_;|
%|    newTree.sc_(newname_) suffixpar(theroot) suffixlist(subtrees)|
%|                                  options;|
%|  )|
%|  sc_(newname_)|
%|enddef;|
%

% In the above variants, |theroot| is not a suffix, but a string representing
% a suffix, as possibly returned by another |new_| call.
% Similarly, |subtree| is not a list of suffixes, but a list
% of strings representing suffixes. In one case, |suffixpar| must be specified
% in the parameters of |streamline|. In the other case, one has to write
% |suffixlist|.
% |suffixlist| transforms a list of strings into a list of suffixes.


% These ``streamlined'' variants do not take 
% an object name; instead, they provide one by themselves; then they
% call the regular constructor, and the name of the object
% is returned as a string
% The three parameters are strings.

vardef streamline(expr class,formalparameters,actualparameters)=
  save mac;string mac;
  mac="vardef new_" & class & formalparameters &
    "=save newname_;string newname_;" &
    "hide(streamlined_:=true;newname_:=newobjstring_;new" &
      class & ".sc_(newname_)" &
        actualparameters & ";)sc_(newname_) enddef;";
  sc_ mac;
  % variant with options:  
  mac:="vardef new_" & class & "_" & formalparameters &
    "(text options)=save newname_;string newname_;" &
    "hide(streamlined_:=true;newname_:=newobjstring_;new" &
      class & ".sc_(newname_)" &
        actualparameters & " options;)sc_(newname_) enddef;";
  sc_ mac;
  % we also create the "is" function:
  createClassTest(class);
enddef;

% A few definitions used above:

def suffixpar(expr s)=(obj(iname_[s])) enddef;

vardef concatsuffixlist_(text t)=
  save tmp;string tmp;
  hide(
    tmp="";
    for $:=t:
      if tmp<>"":
        tmp:=tmp & "," & iname_[$];
      else:
        tmp:=iname_[$];
      fi;
    endfor;
    )
  tmp
enddef;

% From a list of numbers, produces the concatenation of the
% associated suffixes, ready for a |text| parameter
def suffixlist(text t)=
  expandafter (sc_ concatsuffixlist_(t))
enddef;

% This function tries to find an inner point among the points of object |@#|
% It returns the point name as a string, and an empty string if there
% is no inner point.
vardef find_inner_point@#=
  save inn;string inn;
  hide(
    inn="";
    % we first loop over the |pointlist_| array:
    if @#pointlist_<>"":
      forsuffixes $:=sc_(@#pointlist_):
        if not isStandardPoint$:inn:=str $;fi;
        exitif inn<>"";
      endfor;
    fi;
    if inn="":
      % we then loop over all points of arrays,
      % that is, the |points_in_arrayslist_|:
      if @#points_in_arrayslist_<>"":
        forsuffixes $:=sc_(@#points_in_arrayslist_):
          if not isStandardPoint$:inn:=str $;fi;
          exitif inn<>"";
        endfor;
      fi;
    fi;
    )
  inn
enddef;

% |rebindrelativeObj|:
% This function is in a certain way similar to |newBB| in that
% it provides a regular bounding box to an object. That means that
% the four corners will be where they should be: |.nw| at the top left,
% |.sw| at the bottom left, etc. 
% The difference with |newBB| is that it does not create
% a new object, it only modifies the one given in parameter.
% No object layer is added.
% It should be emphasized however that there is no guarantee
% that the new bounds will contain the whole object, because
% neither the drawing instructions 
% nor the subobjects are taken into account. We do not take
% the subobjects into account, because if we did, it would make it
% difficult to cheat on the bounding box.
% The new bounding box is only guaranteed to be the tightest
% containing the former corners of the current object,
% plus the shifts given in parameters.
% This function is useful when you want to pretend that
% the bounding box is different from what it is, because
% the bounding box is used to decide how much space an object
% takes when used within another object.
% This function looks complex because it is! The object we want
% to recompute may be floating and we have to preserve that;
% we have to move some points in a floating object.
% The four additionnal parameters are four dimensions,
% representing changes in size in the four directions.
% The values can be positive or negative. Positive values
% move up or towards the right, and negative values move
% down or towards the left.
vardef rebindrelativeObj(suffix n)(expr dyn,dys,dxe,dxw)=
  save innerpoint,xleft,xright,ytop,ybot,i,nwi,swi,nei,sei,mac;
  string innerpoint,mac;
  % we define arrays of points, which will be useful below:
  save p_,q_,r_;pair p_[],q_[],r_[];
%  message "*** Rebinding with parameters " &
%    decimal(dyn) & "," & decimal(dys) & "," &
%    decimal(dxe) & "," & decimal(dxw);
  % first, we find the bounds (left, right, bottom, top) of object |n|:
  % we only look at the current object and not its subobjects
  % (if one wants the real bounding box, taking into account all
  % visible parts, use |rebindvisibleObj|)
  xleft= xpart(n.sc_(find_lft_most.n)); 
  xright=xpart(n.sc_(find_rt_most.n));
  ytop=  ypart(n.sc_(find_top_most.n));
  ybot=  ypart(n.sc_(find_bot_most.n));
  
  % We distinguish two cases: either there is an inner point
  % (i.e., different from the standard points of the bounding box + .c
  % which we also consider part of the bounding box),
  % or there is no such point.
  % The standard points are those we are going to change.
  innerpoint=find_inner_point.n;
  if innerpoint="": % easy (but rare) case
    % (It is not compulsorily an error if the object has no other points,
    % it could well be a filling or space object.)
    % IN THIS CASE, WE IGNORE POSSIBLE SUBOBJECTS, SINCE WE ASSUME
    % THAT THEY ARE TIED TO INNER POINTS.
    % Here, we have only to give new values to the standard points.
    % We first compute the value of the top left corner (|p_1|)
    % and the differences:
    p_1=(xleft,ytop)+(dxw,dyn);
    p_2=(xleft,ybot)+(dxw,dys)-p_1;
    p_3=(xright,ytop)+(dxe,dyn)-p_1;
    p_4=(xright,ybot)+(dxe,dys)-p_1;
    % Then, we refresh the original bounding box
    refreshObjVars_(n)(ne,nw,se,sw,n,s,e,w,c);
    % and we could recreate the three differences:
    % |n.sw-n.nw=p_2-p_1;n.ne-n.nw=p_3-p_1;n.se-n.nw=p_4-p_1;|
    % however, because of the StandardEquations, we can just define
    % two opposite corners:
    n.se-n.nw=p_4-p_1;
    % Now, either |p_1| is known, or it is not. If it is known,
    % we give its value to |n.nw|:
    if known p_1: n.nw:=p_1;fi;
  else: % common case, more work
    % first we memorize (computed (nw) - n.nw), (computed (sw) - n.sw), etc.,
    % that is, how much each corner is going to move to reach its
    % standard position:
    q_1=(xleft,ytop)-n.nw+(dxw,dyn);
    q_2=(xleft,ybot)-n.sw+(dxw,dys);
    q_3=(xright,ytop)-n.ne+(dxe,dyn);
    q_4=(xright,ybot)-n.se+(dxe,dys);
    % these four differences will be used later
             
    % We now memorize the differences between all points and the
    % inner point; only those differences which are fully known
    % will be considered (IS THIS TRUE?);
    % this will allow us to accept a few non
    % known (and non used) points
    % WE HAVE ASSUMED THAT THE INNERPOINT IS ATTACHED INSIDE THE OBJECT
    i:=0;
    % First, go through the regular points:
    if n.pointlist_<>"":
      forsuffixes $:=sc_(n.pointlist_):i:=i+1;
        p_[i]=n$-n.sc_(innerpoint);
        % memorize the indexes of the points |nw|,|sw|,|ne|,|se| when they pass
        if str $="nw":nwi=i;elseif str $="sw":swi=i;
        elseif str $="ne":nei=i;elseif str $="se":sei=i;fi;
      endfor;
    fi;
    % then through all other points:
    if n.points_in_arrayslist_<>"":
      forsuffixes $:=sc_(n.points_in_arrayslist_):i:=i+1;
        p_[i]=n$-n.sc_(innerpoint);
      endfor;
    fi;
    % we also save the value of the inner point,
    % in case it is well in place:
    if known n.sc_(innerpoint):p_0=n.sc_(innerpoint);fi;

    % we save the differences between the innerpoint and the first
    % points of the subobjects, if there are any:

    i:=0;
    if n.sublist_<>"":
      forsuffixes $:=sc_(n.sublist_):i:=i+1;
        r_[i]=n.sc_(innerpoint)-obj(n$).obj(firstPointOf_(n$));
      endfor;
    fi;
    if n.subarraylist_<>"":
      forsuffixes $:=sc_(n.subarraylist_):
        % and now, we go through each element of the array:
        for j:=1 upto n$n_:
          if known n$[j]:
            i:=i+1;
            r_[i]=n.sc_(innerpoint)-
                    obj(n$[j]).obj(firstPointOf_(n$[j]));
          fi;
        endfor;
      endfor;
    fi;

    % we refresh everything:
    forsuffixes $$=pointlist_,points_in_arrayslist_:
      if n$$<>"":
        forsuffixes $:=sc_(n$$):refreshObjVars_(n)($);endfor;
      fi;
    endfor;
    
    % we also untie the subobjects:

    i:=0;
    if n.sublist_<>"":
      forsuffixes $:=sc_(n.sublist_):i:=i+1;
        untieObj(obj(n$));
      endfor;
    fi;
    if n.subarraylist_<>"":
      forsuffixes $:=sc_(n.subarraylist_):
        % and now, we go through each element of the array:
        for j:=1 upto n$n_:
          if known n$[j]:
            i:=i+1;
            untieObj(obj(n$[j]));
          fi;
        endfor;
      endfor;
    fi;

    % and we redefine everything except the standard points:
    i:=0;
    forsuffixes $$=pointlist_,points_in_arrayslist_:
      if n$$<>"":
        forsuffixes $:=sc_(n$$):i:=i+1;
          if not isStandardPoint$:
            n$-n.sc_(innerpoint)=p_[i];
          fi;
        endfor;
      fi;
    endfor;
    
    % and finally, we attach the subobjects (same code as above):

    i:=0;
    if n.sublist_<>"":
      forsuffixes $:=sc_(n.sublist_):i:=i+1;
        r_[i]=n.sc_(innerpoint)-obj(n$).obj(firstPointOf_(n$));
      endfor;
    fi;
    if n.subarraylist_<>"":
      forsuffixes $:=sc_(n.subarraylist_):
        % and now, we go through each element of the array:
        for j:=1 upto n$n_:
          if known n$[j]:
            i:=i+1;
            r_[i]=n.sc_(innerpoint)-
                 obj(n$[j]).obj(firstPointOf_(n$[j]));
          fi;
        endfor;
      endfor;
    fi;

    % Now, all non standard points are bound to the inner point.
    % Finally, we attach the standard points properly;
    % we know where the new corners are located in the old system
    % points, for instance
    %  |(xpart(n.sc_(lftmost)),ypart(n.sc_(topmost)))|
    % corresponds to the new |n.nw|; however, if the object is floating,
    % we cannot write |n.nw=(xpart(n.sc_(lftmost)),...)|
    % because the latter refers to variables that do no longer exist.
    % What we can do is to say 
    %   |new(n.nw)-new(n.innerpoint)=(old(n.nw)-old(n.innerpoint))|
    %                    |+ (old(computed nw)-old(n.nw))|
    % The value of |(old(n.nw)-old(n.innerpoint))| is in the |p_| array
    % The value of |old(computed nw)-old(n.nw)| has been computed above,
    % before the variables were refreshed. We can just add them.
    %
    % Of the four following equations, we define only two,
    % corresponding to opposite corners. Otherwise, there are redundant
    % equations.
    n.nw-n.sc_(innerpoint)=p_[nwi]+q_1; 
    %|n.sw-n.sc_(innerpoint)=p_[swi]+q_2;|
    %|n.ne-n.sc_(innerpoint)=p_[nei]+q_3;|
    n.se-n.sc_(innerpoint)=p_[sei]+q_4;
    
    % And finally, we define the innerpoint |p_0| if necessary
    if known p_0:n.sc_(innerpoint)=p_0;fi;
  fi;

  mac:="vardef code_function_@#= " & PureStandardEquations & "enddef;";
  % we want the |vardef| macro only defined locally;we don't need it later
  begingroup; 
    save code_function_;
    sc_(mac);
    % determine |.n|, |.s|, etc.:
    sc_ ("code_function_." & str n); 
  endgroup;
enddef;

% streamlined version: |n| is a number representing an object
vardef rebindrelative_Obj(expr n)(expr dyn,dys,dxe,dxw)=
  hide(rebindrelativeObj(obj(iname_[n]))(dyn,dys,dxe,dxw)) n
enddef;

def rebindObj(suffix n)=
  rebindrelativeObj(n)(0,0,0,0);
enddef;

% streamlined version: |n| is a number representing an object
vardef rebind_Obj(expr n)=
  hide(rebindObj(obj(iname_[n]))) n
enddef;

% This function does an exact rebind, unlike the previous functions.
% It takes into account everything that is visible
vardef rebindVisibleObj(suffix n_)=
  save untied,p;boolean untied;path p;untied=true;
  if known n_.c:untied:=false;fi;
  if untied:n_.c=origin;fi;
  % first, we do a simple |rebindObj| to make sure
  % that the bounding box is parallel to the axes
  rebindObj(n_);
  save bboxmargin;
  bboxmargin:=0;
  p=rBboxObj(n_);
  rebindrelativeObj(n_)(
    ypart((point 2 of p)-n_.n),
    ypart((point 1 of p)-n_.s),
    xpart((point 1 of p)-n_.e),
    xpart((point 0 of p)-n_.w));
  if untied:untieObj(n_);fi;
enddef;

% It is often useful to set the size of an object, in order
% to get proper alignments. We provide several functions.
% These functions take a length and extend in one of the four
% directions until reaching this length. It is a straightforward
% application of |rebindrelativeObj|:

vardef extendObjRight@#(expr wd)=
  rebindrelativeObj(@#)(0,0,wd-xpart(@#e-@#w),0);
enddef;

vardef extendObjLeft@#(expr wd)=
  rebindrelativeObj(@#)(0,0,0,xpart(@#e-@#w)-wd);
enddef;

vardef extendObjUp@#(expr ht)=
  rebindrelativeObj(@#)(ht-ypart(@#n-@#s),0,0,0);
enddef;

vardef extendObjDown@#(expr ht)=
  rebindrelativeObj(@#)(0,ypart(@#n-@#s)-ht,0,0);
enddef;

% Handling of options in constructors:

% Options are added as optional text parameters at the end of constructors.
% The options are normally strings representing function calls
% with parameters. Several options can be separated by commas.
% Each object honors its own options.
% Non honored options produce errors.

% It is up to the object to decide if it takes options and if it
% handles them. Options are handled by a generic |ExecuteOptions| call.
% This function defines variables according to the options given.
% Later, these variables can be used to achieve various effects.

% The |ExecuteOptions| definition must not be a |vardef|
% because some of the options
% (for instance |o_treemode|) do |save|s and the scope of
% these |save|s must be the whole constructor.
% |$$| is the object; we need it in order to define |currentObjname|
% which is used by certain options. However, local options
% (the ones only used in the constructor) do not use the object name.
def ExecuteOptions(suffix $$)(text options)=
  % we don't need a |vardef| here,
  % because |ExecuteOptions| is called within a |vardef|
  setcurrentobjname_(str $$);
  for $:=options:
    % each option is a function call, so we just call it;
    % if the function called does not exist, it will of course
    % produce an error, but this error can clearly be diagnosed.
    % We call the function |correctOption_| in order to add
    % quotes in certain cases.
    sc_ (correctOption_("o_" & $));
  endfor;
enddef;

% Here are the functions that can be called; new functions can
% easily be added to handle more parameters.

def set_local_type(expr type,name,val)=
  sc_("save o_" & name & "_val;" &
             type & " o_" & name & "_val;o_" & name & "_val")=val;
enddef;

% For every option name |s|, this function defines a function |o_s|
% and calls |addOptionFunction| if the type is |"string"|.
% This call registers the option so that
% its arguments is protected.

vardef define_local_type_option(expr type,s)=
  save tmp;
  string tmp;
  tmp="def o_" & s & "(expr s)=";
  if s="arrows":
    tmp:=tmp & "set_local_type(" & quote(type) & "," & quote(s) &
               ",arrows_function_(s));enddef;";
  else:   
    tmp:=tmp &
      "set_local_type(" & quote(type) & "," & quote(s) & ",s);enddef;";
  fi;
  if type="string":
    tmp:=tmp & "addOptionFunction(" & quote("o_" & s) & ");";
  fi;
  sc_ tmp;
enddef;

def define_local_string_option(expr s)=
  define_local_type_option("string",s);
enddef;

def define_local_numeric_option(expr s)=
  define_local_type_option("numeric",s);
enddef;

def define_local_pair_option(expr s)=
  define_local_type_option("pair",s);
enddef;

def define_local_color_option(expr s)=
  define_local_type_option("color",s);
enddef;

def define_local_boolean_option(expr s)=
  define_local_type_option("boolean",s);
enddef;

def define_local_picture_option(expr s)=
  define_local_type_option("picture",s);
enddef;

def settodefaultifnotknown_(expr opname)(text type)(expr default)=
  if expandafter unknown sc_("o_" & opname & "_val"):
    expandafter save sc_("o_" & opname & "_val");
    expandafter type sc_("o_" & opname & "_val");
    sc_("o_" & opname & "_val")=default;
  fi;
enddef;
  
% Alignment option; the string version of the parameter is put
% into the current object |option_align_| field.
% This definition must not be a |vardef| because
% the scope of the |save| is the whole constructor.
define_local_string_option("align");

define_local_string_option("Dalign");
define_local_string_option("Ualign");
define_local_string_option("Lalign");
define_local_string_option("Ralign");

vardef define_global_type_option(expr type,opname)=
  save tmp;string tmp;
  tmp="def o_" & opname & "(expr s)=" &
          "global_" & type & "_option_(" & ditto & opname & ditto &
            ")(s);enddef;";
  if type="string":
    tmp:=tmp &
       "addOptionFunction(" & ditto & "o_" & opname & ditto & ");";
  fi;
  sc_(tmp);
enddef;

def define_global_string_option(expr opname)=
  define_global_type_option("string",opname);
enddef;

def define_global_boolean_option(expr opname)=
  define_global_type_option("boolean",opname);
enddef;

def define_global_color_option(expr opname)=
  define_global_type_option("color",opname);
enddef;

def define_global_numeric_option(expr opname)=
  define_global_type_option("numeric",opname);
enddef;

def define_global_pair_option(expr opname)=
  define_global_type_option("pair",opname);
enddef;

% The parameter of |halign| or |valign|
% is a list of alignment options, for instance |"clrccl"|
% It is used for matrix columns.

define_global_string_option("halign");
define_global_string_option("valign");

% Filling option; the parameter is put
% into the current object |option_filled_| field for later use.
define_global_boolean_option("filled");

% Color filling option
define_global_color_option("fillcolor");

% Framing options.
define_global_boolean_option("framed");
define_global_color_option("framecolor");
define_global_string_option("framestyle");

% Picture option
define_global_color_option("picturecolor");

% Shadow options
define_global_boolean_option("shadow");
define_global_color_option("shadowcolor");

% Fitting option. Usually, the default is for a frame to fit
% its contents. This options makes it possible to have regular frames
% around objects that have different widths and heights.
define_global_boolean_option("fit");

% Tree direction option.
% This definition must not be a |vardef| because
% the scope of the |save| is the whole constructor.
% The name |treemode| was chosen for compatibility with PSTricks.
define_global_string_option("treemode");

% PSTricks compatibility:
% This corresponds to PSTricks |treenodesize|;
% we took a different name, because we have two variants:
define_local_numeric_option("treenodehsize");
define_local_numeric_option("treenodevsize");

define_local_numeric_option("matrixnodehsize");
define_local_numeric_option("matrixnodevsize");

% |HBox| and |VBox| versions of the |"treenodehsize"|/|"treenodevsize"| option:
define_local_numeric_option("elementsize");

define_local_boolean_option("flip");
define_local_boolean_option("treeflip");

define_local_boolean_option("hideleaves");

% draw functions for connections
define_local_string_option("cdraw");

% label for connections
define_local_picture_option("labpic");
define_local_numeric_option("labdist");



% This is a list of all the stored options of a path.
% This list is defined so that it is easy to loop
% over all options.
def pathoptions_=
  _draw_,_connect_,posA,posB,armA,armB,offsetA,offsetB,
  name,linecolor,border,bordercolor,linestyle,doubleline,doublesep,
  arrows,angleA,angleB,arcangleA,arcangleB,curvemax,
  linewidth,nodesepA,nodesepB,
  loopsize,linearc,linetensionA,linetensionB,
  visible,boxsize,boxheight,boxdepth,pathfilled,pathfillcolor,
  coilarmA,coilarmB,coilheight,coilwidth,coilaspect,coilinc
enddef;
      
% default values for curves:
numeric curve_linewidth_default,
        curve_arcangleA_default,curve_arcangleB_default,
        curve_curvemax_default,
        curve_armA_default,curve_armB_default,curve_loopsize_default,
        curve_linetensionA_default,curve_linetensionB_default,
        curve_linearc_default,
        curve_border_default,curve_nodesepA_default,curve_nodesepB_default,
        curve_boxsize_default,curve_boxheight_default,curve_boxdepth_default,
        curve_doublesep_default,
        curve_coilarmA_default,curve_coilarmB_default,
        curve_coilheight_default,curve_coilwidth_default,
        curve_coilaspect_default,curve_coilinc_default;
% default values for curves (non stored options)
numeric curve_labpos_default,curve_labangle_default,curve_labdist_default;


curve_linewidth_default=.5bp;
curve_arcangleA_default=10;
curve_arcangleB_default=10;
curve_curvemax_default=1;
curve_armA_default=5mm;
curve_armB_default=5mm;
curve_loopsize_default=0.25cm;
curve_linearc_default=0cm;
curve_linetensionA_default=1;
curve_linetensionB_default=1;
curve_border_default=0pt;
curve_nodesepA_default=0pt;
curve_nodesepB_default=0pt;
curve_boxsize_default=5mm;
curve_boxheight_default=-1pt; % means that there is no default
curve_boxdepth_default=-1pt;  % means that there is no default
curve_doublesep_default=1pt;
curve_coilarmA_default=5mm;  % same as in PSTricks
curve_coilarmB_default=5mm;  % same as in PSTricks
curve_coilheight_default=1;  % same as in PSTricks
curve_coilwidth_default=1cm; % same as in PSTricks
curve_coilaspect_default=45; % same as in PSTricks
curve_coilinc_default=90; % 20 is better when |coilaspect|=0
 % (the PSTricks default is 10, but it seems unnecessary in most cases)

curve_labpos_default=0.5;
curve_labangle_default=0.0;
curve_labdist_default=1; % ratio

boolean curve_visible_default,curve_doubleline_default,
        curve_pathfilled_default;
curve_visible_default=true;
curve_doubleline_default=false;
curve_pathfilled_default=false;


color curve_linecolor_default,curve_bordercolor_default,
      curve_pathfillcolor_default;
curve_linecolor_default=black;
curve_bordercolor_default=white;
curve_pathfillcolor_default=black;

string curve_linestyle_default,curve_arrows_default,
       curve_posA_default,curve_posB_default;
pair curve_offsetA_default,curve_offsetB_default;       
curve_linestyle_default="";
curve_arrows_default="drawarrow";
curve_posA_default="ic";
curve_posB_default="ic";
curve_offsetA_default=(0,0);
curve_offsetB_default=(0,0);

% curve options shortcuts table
string curve_options_shortcuts_[];
numeric ncurve_options_shortcuts_;
ncurve_options_shortcuts_=0;

vardef isCurveOptionShortcut(expr opname)=
  save r;boolean r;r=false;
  hide(
    for i:=0 upto ncurve_options_shortcuts_-1:
      if curve_options_shortcuts_[i]=opname:r:=true;fi;
      exitif r;
    endfor;
    )
  r
enddef;

def setCurveDefaultOption(expr name,value)=
  if isCurveOptionShortcut(name):
    sc_("curve_" & name & "A_default"):=value;
    sc_("curve_" & name & "B_default"):=value;
  elseif name="arrows":
    sc_("curve_" & name & "_default"):=arrows_function_(value);
  else:
    sc_("curve_" & name & "_default"):=value;
  fi;
enddef;

% For all options for which there are two versions (A and B),
% we define special shortcuts, as does PSTricks.
% We also memorize the shortcuts, because they are needed in
% |setCurveDefaultOption|.

def define_path_option_shortcut(expr s)=
  scantokens("def o_" & s &
      "( expr l)=o_" & s & "A(l);o_" & s & "B(l);enddef;");
  curve_options_shortcuts_[ncurve_options_shortcuts_]=s;
  ncurve_options_shortcuts_:=ncurve_options_shortcuts_+1;
enddef;

define_path_option_shortcut("linetension");
define_path_option_shortcut("coilarm");
define_path_option_shortcut("pos");
define_path_option_shortcut("offset");
define_path_option_shortcut("arm");
define_path_option_shortcut("angle");
define_path_option_shortcut("arcangle");
define_path_option_shortcut("nodesep");

% Arrows functions: these functions should be similar to |draw|.
% They can be parameters to the |"arrows"| option.

def rdrawarrow = drawarrow reverse enddef;

% This is the default value for connections.
% |p| is a path to be drawn.
% |n| is a suffix for an array of stored parameters
% |i| is the index in this array
% If the suffix is empty, we use locally stored values.
vardef cdraw_default(suffix n)(expr i)(expr p)=
  save colorcmd,p_;string colorcmd;path p_;colorcmd="";
  p_=p;
  p_:=cutpathends_(p_,if known o_nodesepB_val: o_nodesepB_val
                      else: curve_nodesepB_default fi,
                      if known o_nodesepA_val: o_nodesepA_val
                      else: curve_nodesepA_default fi);
  if str n="":
    if CLOV_("border")>0:
      pickup pencircle scaled CLOV_("border");
      % we cut the ends of the path in order to avoid
      % the end nodes to be erased; the standard setting
      % should work in most cases, except when the path
      % reaches the node under a small angle; we should then
      % add options to define how much of the path we cut.
      draw cutpathends_(p,2*CLOV_("border"),2*CLOV_("border"))
              withcolor CLOV_("bordercolor");
    fi;
    pickup pencircle scaled CLOV_("linewidth");
    if CLOV_("linecolor")<>black:
      colorcmd:="withcolor " & colortostring(CLOV_("linecolor"));
    fi;
    if CLOV_("doubleline"):
      sc_(CLOV_("arrows") & "_double")
      (p_)(CLOV_("doublesep"))(CLOV_("linewidth"))
      sc_(CLOV_("linestyle"))
      sc_(colorcmd);
    else:
      sc_(CLOV_("arrows"))
      (p_)
      sc_(CLOV_("linestyle"))
      sc_(colorcmd);
    fi;
  else:
    if n.border[i]>0:
      pickup pencircle scaled n.border[i];
      % we cut the ends of the path in order to avoid
      % the end nodes to be erased; the standard setting
      % should work in most cases, except when the path
      % reaches the node under a small angle; we should then
      % add options to define how much of the path we cut.
      draw cutpathends_(p,2*n.border[i],2*n.border[i])
              withcolor n.bordercolor[i];
    fi;
    pickup pencircle scaled n.linewidth[i];
    if n.linecolor[i]<>black:
      colorcmd:="withcolor " & colortostring(n.linecolor[i]);
    fi;
    if n.doubleline[i]:
      sc_(n.arrows[i] & "_double")
      (p_)(n.doublesep[i])(n.linewidth[i])
      sc_(n.linestyle[i])
      sc_(colorcmd);
    else:
      sc_(n.arrows[i])
      (p_)
      sc_(n.linestyle[i])
      sc_(colorcmd);
    fi;
  fi;
  pickup pencircle scaled curve_linewidth_default;
enddef;

% color for connections
% We don't name it |color|, because at some point we would need
% to do a |sc_("color")| which would fail.
define_local_color_option("linecolor");

% border color (PSTricks compatibility)
define_local_color_option("bordercolor");

% size of border (PSTricks compatibility)
define_local_numeric_option("border");

% option for the path array |_path_|; this option makes
% it possible to use a different array with |nccurve| and similar
% functions.
define_local_string_option("patharray");

% connections within trees
define_global_string_option("edge");

% fan options:
define_global_string_option("fanlinestyle");

define_global_boolean_option("pointedfan");
define_global_numeric_option("fanlinearc");

% angles for connections (PSTricks compatibility)
define_local_numeric_option("angleA");
define_local_numeric_option("angleB");
define_local_numeric_option("arcangleA");
define_local_numeric_option("arcangleB");

% separations for connections (PSTricks compatibility)
define_local_numeric_option("nodesepA");
define_local_numeric_option("nodesepB");

% parameters for |ncbox| and |ncarcbox|: size of boxes (PSTricks compatibility)
define_local_numeric_option("boxsize");
define_local_numeric_option("boxheight");
define_local_numeric_option("boxdepth");

% parameter for |ncloop|
define_local_numeric_option("loopsize");

% smoothness of connections
define_local_numeric_option("linearc");

% coil/zigzag connections:
define_local_numeric_option("coilarmA");
define_local_numeric_option("coilarmB");
define_local_numeric_option("coilheight");
define_local_numeric_option("coilwidth");
define_local_numeric_option("coilaspect");
define_local_numeric_option("coilinc");

% visibility of connections
% (a connection can be invisible and be used for other purposes,
% such as label positionning or computation of intersections)
define_local_boolean_option("visible");

define_local_boolean_option("pathfilled");
define_local_color_option("pathfillcolor");

% tensions of connection (only |nccurve|)
define_local_numeric_option("linetensionA");
define_local_numeric_option("linetensionB");

% maximum distance for loops produced by nccurve
define_local_numeric_option("curvemax"); % added Nov 10, 2006

% thickness for connections
define_local_numeric_option("linewidth");

% style for connections 
define_local_string_option("linestyle");

% double lines:
define_local_boolean_option("doubleline");
define_local_numeric_option("doublesep");


% positions for connections
define_local_string_option("posA");
define_local_string_option("posB");

% offsets for connections
define_local_pair_option("offsetA");
define_local_pair_option("offsetB");

% arms for connections
define_local_numeric_option("armA");
define_local_numeric_option("armB");

% names for connections
define_local_string_option("name");

% Label options:
define_local_numeric_option("labrotate");
define_local_numeric_option("labangle");
define_local_numeric_option("labpos");
define_local_pair_option("labshift");
% this is like the labshift option, but will use the
% |laboff| definition used by |label|
define_local_string_option("labdir");
define_local_color_option("labcolor");
define_local_boolean_option("laberase");
define_local_string_option("labpoint");
define_local_string_option("labcard");
define_local_string_option("labpathname");
define_local_numeric_option("labpathid");


% Internal horizontal separation.
define_local_numeric_option("hsep");

% Internal vertical separation.
define_local_numeric_option("vsep");

define_local_numeric_option("hbsep");
define_local_numeric_option("vbsep");

% External horizontal separation
define_local_numeric_option("dx");

% External vertical separation
define_local_numeric_option("dy");

% Rotation angle
define_local_numeric_option("rotangle");

% How much the start of a line is shifted right
define_local_numeric_option("lstartdx");

% How much the end of a line is shifted right
define_local_numeric_option("lenddx");

define_global_numeric_option("rule");
define_local_numeric_option("lrsep");
define_local_numeric_option("rrsep");

% Line width for draws
define_global_numeric_option("framewidth");

% radius for corners of rounded corners
define_global_numeric_option("rbox_radius");

% Circle margin
define_local_numeric_option("circmargin");

% Polygon margin
define_local_numeric_option("polymargin");

define_local_numeric_option("angle");

% Draw arrow function option;
% the parameter is a string representing a draw function
% We first define a conversion function:

def arrows_function_(expr s)=
  if ((substring(0,1) of s >= "A") and (substring(0,1) of s <= "Z")) or
    ((substring(0,1) of s >= "a") and (substring(0,1) of s <= "z")):
    s
  elseif s="-": "draw"
  elseif s="->": "drawarrow"
  elseif s="<-": "rdrawarrow"
    % other cases can easily be added here
  else: "draw" % default
  fi
enddef;

define_local_string_option("arrows");

% This is an option to locally redefine the main drawing function
% of the object.
define_global_string_option("drawObj");

def global_option_(expr name)(expr s)=
  global_string_option_(name)(s);
enddef;

def global_boolean_option_(expr name)(expr s)=
  global_type_option_("boolean")(name)(s);
enddef;

def global_string_option_(expr name)(expr s)=
  global_type_option_("string")(name)(s);
enddef;

def global_numeric_option_(expr name)(expr s)=
  global_type_option_("numeric")(name)(s);
enddef;

def global_color_option_(expr name)(expr s)=
  global_type_option_("color")(name)(s);
enddef;

% This is for options that are attached to an object,
% and that are not local only to its constructor.
def global_type_option_(expr type)(expr name)(expr s)=
  if not isOfType(type,currentObjname & ".option_" & name & "_"):
    sc_(type)
       obj(generisize_(currentObjname)).sc_("option_" & name & "_");
  fi;
  if not string obj(currentObjname).options_:
    expandafter string obj(generisize_(currentObjname)).options_;
  fi;
  if unknown obj(currentObjname).options_:
    obj(currentObjname).options_="_" & name;
         % we added a |_| so that the tag becomes unknown
         % for we can then traverse the |options_| with a |forsuffixes|
         % in |duplicateObj|
         % (we should make this more robust)
  else:
    obj(currentObjname).options_:=obj(currentObjname).options_& ",_" & name;
  fi;
  obj(currentObjname).sc_("option_" & name & "_")=s;
enddef;

% This is a general function to test options:
% |@#| is the object name. |opname| is the option name
% and |opvalue| is the option value.

vardef Option@#(expr opname,opvalue)=
  (OptionValue@#(opname)=opvalue)
enddef;

% This function finds the value of a parameter for an object.
% An option is either stored in the object (when it is local, but meant
% to be used later, not in the constructor),
% or local in the object, but for an immediate use (i.e., it won't be
% available after the creation), or global to the class.
% In the first case, we check the variable
%   |@#sc_("option_" & opname & "_")|
%    (the type of the option is irrelevant here)
% In the second case, we check |sc_("o_" & opname & "_val")|
%    (the type of the option is irrelevant here)
% In the third case, we check the global value
%   |sc_(clname & "_" opname)|
%    (the type of the option is irrelevant here)
vardef OptionValue@#(expr opname)=
  (if known (@#sc_("option_" & opname & "_")):
      (@#sc_("option_" & opname & "_"))
   elseif known (sc_("o_" & opname & "_val")):
     (sc_("o_" & opname & "_val"))
   elseif known (sc_(objClassName_(@#) & "_" & opname)):
     (sc_(objClassName_(@#) & "_" & opname))
   else:
     whatever
   fi
  )
enddef;

% This function only looks at local options and does not
% take an object into account. It is suitable for the options
% of a draw command. Moreover, the last parameter is a default
% value.
vardef LocalOptionValue(expr opname,default)=
  (if known (sc_("o_" & opname & "_val")):
    (sc_("o_" & opname & "_val"))
   else:
     default
   fi
  )
enddef;

% Constructions such as |LocalOptionValue("posA",curve_posA_default)|
% are quite common. We therefore introduce a shortcut:
def CLOV_(expr opname)=
  sc_("LocalOptionValue(" &
       quote(opname) & ",curve_" & opname & "_default)")
enddef;

% This function defines default global values for classes.
% This works for numerical, string or color values.
% |setObjectDefaultOption("HBox")("hsep")(5mm)|
def setObjectDefaultOption(expr clname)(expr var)(expr val)=
  if numeric val:
    sc_(clname & "_" & var):=val;
  elseif string val:
    sc_("string " & clname & "_" & var & ";");
    sc_(clname & "_" & var):=val;
  elseif color val:
    sc_("color " & clname & "_" & var & ";");
    sc_(clname & "_" & var):=val;
  elseif boolean val:
    sc_("boolean " & clname & "_" & var & ";");
    sc_(clname & "_" & var):=val;
  fi;
enddef;

% |clearObj a,b| makes it possible to reuse the objects |a| and |b|
% If this function is called within |beginfig|/|endfig|, it only
% clears the object until the end of the environment.
let clearObj=save;

let showObj=showvariable;

% n is the number of an object
def show_Obj(expr n)=
  sc_("showObj " & iname_[n]);
enddef;


% Handling of paths in objects:

% This function adds a point to an object's point array.
% |p| is the point and |a| is the array of object |@#|.
% This function is used when a path is attached to an object.
vardef addPointToArray@#(expr p)(suffix a)=
  @#a.n_:=@#a.n_+1;
  @#a[@#a.n_]:=p;
  % The relative position of the point is memorized as an equation,
  % so that we can conveniently reset the object later, and not loose
  % the points.
  addObjExtraCode@# "@#" & str a & decimal(@#a.n_) & "-@#c=(" &
    decimal(xpart(p-@#c)) & "," & decimal(ypart(p-@#c)) & ");";
  if @#points_in_arrayslist_="":
    @#points_in_arrayslist_:=str a & decimal(@#a.n_);
  else:
    @#points_in_arrayslist_:=@#points_in_arrayslist_ & "," & str a & decimal(@#a.n_);
  fi;
enddef;

def cutpathends_(expr p,a,b)=
  if (a=0) and (b=0):p
  else:
    p cutafter (p intersectionpoint
                  (fullcircle scaled a shifted (point (length(p)) of p)))
      cutbefore (p intersectionpoint
        (fullcircle scaled b shifted (point 0 of p)))
  fi
enddef;


% This function adds a path to an object.
% The path is |p| and the object is |@#|.
% |n| is the name of the path within the object.
% It must have been defined with |addPathArray|.
vardef addPath@#(suffix n)(expr i)(text p)=
  save p_,untied;path p_;boolean untied;untied=true;
  % n is _spath_ or _upath_
  if known @#c:untied:=false;fi;
  % we temporarily tie the object if necessary
  if untied:@#c=origin;fi;
  % only then can we store the path:
  p_=p;
  % Now, we slightly modify the path in order to take the |nodesepA|
  % and |nodesepB| parameters into account:
  p_:=cutpathends_(p_,if known o_nodesepB_val: o_nodesepB_val
                      else: curve_nodesepB_default fi,
                      if known o_nodesepA_val: o_nodesepA_val
                      else: curve_nodesepA_default fi);
  setcurrentobjname_(str @#);
  % if the |ip_| array does not yet exist, create it:
  if not pair @#n.ip_1:       
    ObjPointArray(n.ip_)(0);
  else:
    % if it does already exist, we only initialize it once:
    if unknown @#n.ip_.n_:
      ObjPointArray(n.ip_)(0);
    fi;    
  fi;
  xpart(@#n[i])=@#n.ip_.n_+1; % path number
  % we add each point of the path |p_| to the |ip_| array:
  for j:=0 upto length p_-1:
    addPointToArray@#(point j of p_)(n.ip_);
    addPointToArray@#(postcontrol j of p_)(n.ip_);
    addPointToArray@#(precontrol (j+1) of p_)(n.ip_);
  endfor;
  addPointToArray@#(point (length(p_)) of p_)(n.ip_);
  ypart(@#n[i])=length p_;
  % if the object was initially untied, we untie it
  if untied:untieObj(@#);fi;
enddef;

% This function removes the paths from an array:
vardef deletePaths@#(suffix n)=
  @#extra_code_:="";
  for i:=1 upto @#n.ip_.n_:
    @#n[i]:=(whatever,whatever);
  endfor;
  % reset |ip_|
  @#n.ip_.n_:=0;
  % remove |ip_1|, ... from |points_in_arrayslist|:
  save newpoints_in_arrayslist_;
  string newpoints_in_arrayslist_;newpoints_in_arrayslist_:="";
  forsuffixes $:=sc_(@#points_in_arrayslist_):
    if (substring(0,length(str n & ".ip_")) of (str$))<>(str n & ".ip_"):
      if newpoints_in_arrayslist_="":
        newpoints_in_arrayslist_:=str$;
      else:
        newpoints_in_arrayslist_:=newpoints_in_arrayslist_ & "," & str$;
      fi;
    fi;
  endfor;
  @#points_in_arrayslist_:=newpoints_in_arrayslist_;
  message "@#points_in_arrayslist_=" & @#points_in_arrayslist_;
enddef;

% This function defines an array of paths within an object.
% |p| is the array name, |n| the size of the array
% and |@#| is the object.
vardef addPathArray@#(suffix p)(expr n)=
  setcurrentobjname_(str @#);
  ObjPairArray(p)(n);
enddef;

vardef addPathVariables@#(suffix p)=
  setcurrentobjname_(str @#);
  addPathArray@#(p)(0); % this is a standard array for paths added to
                        % an object
  forsuffixes $=_draw_,_connect_,posA,posB,name,linestyle,arrows:
    ObjStringArray(p$)(0);
  endfor;
  forsuffixes $=angleA,angleB,arcangleA,arcangleB,nodesepA,nodesepB,
    loopsize,linearc,linetensionA,linetensionB,linewidth,
    armA,armB,border,boxsize,boxheight,boxdepth,
    doublesep,coilarmA,coilarmB,coilheight,coilwidth,coilaspect,coilinc:
    ObjNumericArray(p$)(0);
  endfor;
  ObjBooleanArray(p.visible)(0);
  ObjBooleanArray(p.pathfilled)(0);
  ObjColorArray(p.pathfillcolor)(0);
  ObjBooleanArray(p.doubleline)(0);
  ObjPairArray(p.offsetA)(0);
  ObjPairArray(p.offsetB)(0);
  ObjColorArray(p.linecolor)(0);
  ObjColorArray(p.bordercolor)(0);
enddef;

def increment_pathparameters_(suffix p)(suffix $)=
  $p.n_:=$p.n_+1;
  $p._draw_[$p.n_]:=LocalOptionValue("cdraw","cdraw_default");
  $p.visible[$p.n_]:=CLOV_("visible");
  $p.pathfilled[$p.n_]:=CLOV_("pathfilled");
  $p.pathfillcolor[$p.n_]:=CLOV_("pathfillcolor");
  $p.border[$p.n_]:=CLOV_("border");
  $p.bordercolor[$p.n_]:=CLOV_("bordercolor");
  $p.linewidth[$p.n_]:=CLOV_("linewidth");
  $p.linecolor[$p.n_]:=CLOV_("linecolor");
  $p.nodesepA[$p.n_]:=CLOV_("nodesepA");
  $p.nodesepB[$p.n_]:=CLOV_("nodesepA");
  $p.arrows[$p.n_]:=CLOV_("arrows");
  $p.linestyle[$p.n_]:=CLOV_("linestyle");
  $p.doubleline[$p.n_]:=CLOV_("doubleline");
  forsuffixes $$=_draw_,visible,border,bordercolor,linewidth,linecolor,
    arrows,linestyle,nodesepA,nodesepB,doubleline,pathfilled,pathfillcolor:
    $p$$n_:=$p.n_;
  endfor;
enddef;
  
% This is a function simplifying the use of |addPath|
vardef addUserPath@#(text p) text options=
  ExecuteOptions()(options);
  if unknown @#_upath_.n_:
    addPathVariables@#(_upath_);
  fi;
  increment_pathparameters_(_upath_)(@#);
  addPath@#(_upath_,@#_upath_.n_,p);
enddef;

vardef addStandardPath@#(text p) text options=
  ExecuteOptions()(options);
  if unknown @#_spath_.n_:
    addPathVariables@#(_spath_);
  fi;
  increment_pathparameters_(_spath_)(@#);
  addPath@#(_spath_,@#_spath_.n_,p);
enddef;

def ObjPath(text p) text options=
  addStandardPath.sc_(currentObjname)(p) options;
enddef;
  
% The |Path| function reconstructs a path from a path |p[j]|
% and an object reference |@#|.
vardef Path@#(suffix p)(expr j)=
  (
    for i:=0 upto ypart(@#p[j])-1:
      @#p.ip_[xpart(@#p[j])+i*3]..
          controls @#p.ip_[xpart(@#p[j])+i*3+1] and
                   @#p.ip_[xpart(@#p[j])+i*3+2]..
      endfor
      @#p.ip_[xpart(@#p[j])+ypart(@#p[j])*3]
  )
enddef;

% The |drawMemorizedPaths_| function draws paths that have been memorized.
% It must be called explicitely in the draw function of an object.
% It uses the value of the |cdraw| option to draw the memorized path.
% This makes it possible to change the color, the style, etc.
% There are two kinds of paths attached to an object: the standard ones,
% in the |_spath_| array, and the user ones in the |_upath_| array.
% For instance, the standard paths of a tree are the connections between
% the root and the subtrees.
def drawMemorizedPaths_(suffix n)=
  forsuffixes $=_spath_,_upath_:
    if known n$n_:
      for i:=1 upto n$n_:
        % fans are not drawn here
        if n$arrows[i]<>"fandraw":
          if n$visible[i]:
            if n$pathfilled[i]:
              fill Path.n($,i)--cycle withcolor n$pathfillcolor[i];
            fi;
            sc_(n$_draw_[i])(n$)(i)(Path.n($,i));
          fi;
        fi;
      endfor;
    fi;
  endfor;
enddef;

% The following function is useful for classes which contain
% an object or a picture:
def StandardObjectOrPictureContainerSetup(expr v)=
  if (picture v) or (string v):
    ObjPoint p.off;
    ObjPicture p;
    if picture v:
      setPicture(p)(v);  % initialize the picture
    elseif string v:
      if v="":
        setPicture(p)(nullpicture);
      else:
        % borrowed from |boxes.mp|
        setPicture(p)(v infont defaultfont scaled defaultscale);
      fi;
    fi;
  elseif numeric v:
    SubObject(sub,Obj(v));
  else:
    errmessage "Parameter of StandardObjectOrPictureContainerSetup should be picture, a string or an object.";
  fi;
  ObjNumeric a,b;
  (obj(currentObjname)a,obj(currentObjname)b) =
    if numeric v: % object
        .5*(obj(obj(currentObjname)sub)ne-obj(obj(currentObjname)sub)sw)
    elseif (picture v) or (string v): 
       .5*(urcorner obj(currentObjname)p - llcorner obj(currentObjname)p)
    fi;
enddef;

def drawPictureOrObject(suffix n)=
  if known n.p:
    if urcorner(n.p)-llcorner(n.p)<>(0,0):
      drawPicture.n(p);
    fi;
  else:
    drawObj(obj(n.sub));
  fi;
enddef;

% Node connections:

def patharray_suffix_=
  sc_(LocalOptionValue("patharray","_upath_"))
enddef;

def sign_(expr n)=
  if n>=0:1 else:-1 fi
enddef;

% This function is used when certain paths have to be smoothed
% |p| is the path and |r| is the radius used where a sharp edge
% is rounded.
vardef smoothen(expr p,r)=
  save q,qq,anglechange;path q;pair qq[];
  hide(
    if r>0:
      q=point 0 of p;
      for i:=1 upto length(p)-1:
        qq0:=(whatever,whatever);qq1:=(whatever,whatever);
        qq2:=(whatever,whatever);qq3:=(whatever,whatever);
        if (point (i+1) of p=point i of p) or
           (point (i-1) of p=point i of p):
          anglechange:=0;
        else:
          anglechange:=angle(point (i+1) of p-point i of p)
                      -angle(point i of p-point (i-1) of p);
        fi;
        if anglechange>180: anglechange:=anglechange-360;fi;
        if anglechange<-180: anglechange:=anglechange+360;fi;
        if abs(anglechange)>1:
          % first, we compute the center of the arc
          qq0=whatever[point (i-1) of p,point i of p]
              +r*dir(angle(point i of p-point (i-1) of p)
                     +sign_(anglechange)*90)
             =whatever[point i of p,point (i+1) of p]
              +r*dir(angle(point (i+1) of p-point i of p)
                +sign_(anglechange)*90);
          % |qq1| and |qq2| are the points where the arc touches
          % the original curve
          qq1=whatever[point (i-1) of p,point i of p]
             =whatever[qq0,qq0+(point i of p-point (i-1) of p) rotated 90];
          qq2=whatever[point i of p,point (i+1) of p]
             =whatever[qq0,qq0+(point (i+1) of p-point i of p) rotated 90];
          qq3=qq0+r*unitvector(qq1+qq2-2qq0);
          q:=q & ((point (length(q)) of q)--qq1..
                   qq3..{point (i+1) of p-point i of p}qq2);
        else:
          q:=q & (point (length(q)) of q--point i of p);
        fi;
      endfor;
      q:=q & (point (length(q)) of q--point (length(p)) of p);
    else:
      q:=p;
    fi;
  )
  q
enddef;

% Generic part in the handling of node connections.
% |vardef| can't be used
% The object is |$| (if there is no object, |$| is empty)
% |n| and |m| are either objects (if they are numerics) or points
% (if they are pairs)
def nc_(suffix $)(suffix n,m)(expr f) text options =
  % this next line is actually only relevant when |$| is non-empty;
  % but if it is empty, the line is harmless.
  o_patharray("_upath_");
  % The first parameter is not used, because we have only local options
  % (non-local options have only a meaning for object constructors)
  ExecuteOptions()(options);
  nc__($)(n,m)(f)(patharray_suffix_);
enddef;

% The object is |$|
% |n| and |m| are either objects (if they are numerics) or points
% (if they are pairs)
def nc__(suffix $)(suffix n,m)(expr f)(suffix p)=
  if str $ <> "":
    if unknown $p.n_:
      addPathVariables$(p);
    fi;
    $p.n_:=$p.n_+1;
    % the next four lines must occur before the variables get a value,
    % because we want to memorize the initial state
    $p.angleA[$p.n_]:=o_angleA_val;
    $p.angleB[$p.n_]:=o_angleB_val;
    $p.nodesepA[$p.n_]:=o_nodesepA_val;
    $p.nodesepB[$p.n_]:=o_nodesepB_val;
  fi;
  if unknown o_angleA_val:
    save o_angleA_val;numeric o_angleA_val;
    if known curve_angleA_default: % added 18 June 2006
      o_angleA_val=curve_angleA_default;
    else:     
      if numeric n:
	if m.sc_(CLOV_("posB"))-n.sc_(CLOV_("posA"))<>(0,0):
          o_angleA_val=
	    angle(m.sc_(CLOV_("posB"))-n.sc_(CLOV_("posA")));
	else:
	  o_angleA_val=0;
	fi;	
      else:
	if m-n<>(0,0):
          o_angleA_val=angle(m-n);
	else:
	  o_angleA_val=0;
	fi;	
      fi;
    fi;
  fi;
  if unknown o_angleB_val:
    save o_angleB_val;numeric o_angleB_val;
    if known curve_angleB_default: % added 18 June 2006
      o_angleB_val=curve_angleB_default;
    else:     
      if numeric n:
	if m.sc_(CLOV_("posB"))-n.sc_(CLOV_("posA"))<>(0,0):
          o_angleB_val=
	    angle(m.sc_(CLOV_("posB"))-n.sc_(CLOV_("posA")));
	else:
          o_angleB_val=0;
	fi;    
      else:
	if m-n<>(0,0):
          o_angleB_val=angle(m-n);
	else:
	  o_angleB_val=0;
	fi;	
      fi;
    fi;
  fi;

  settodefaultifnotknown_("nodesepA")(numeric)(curve_nodesepA_default);
  settodefaultifnotknown_("nodesepB")(numeric)(curve_nodesepB_default);
  if str $ <> "":
    $p._draw_[$p.n_]:=LocalOptionValue("cdraw","cdraw_default");
    $p._connect_[$p.n_]:=f;
    forsuffixes $$=posA,posB,armA,armB,loopsize,visible,
      linetensionA,linetensionB,
      arcangleA,arcangleB,offsetA,offsetB,linewidth,linecolor,border,
      bordercolor,linestyle,arrows,boxsize,boxheight,boxdepth,
      doubleline,doublesep,pathfilled,pathfillcolor:
      $p$$[$p.n_]:=CLOV_(str $$);
    endfor;
    $p.name[$p.n_]:=LocalOptionValue("name","");
    nc_inc_$(p);
  fi;
enddef;


% Increment the size of the option arrays
vardef nc_inc_@#(suffix p)=
  forsuffixes $:=pathoptions_:
    @#p$n_:=@#p$n_+1;
  endfor;
enddef;

% This macro draws a label on an immediate curve % ZZZZZZZZ
% (created Sep. 28, 2006)
vardef nc_label_(expr p)=
  if known o_labpic_val:
    if known o_labangle_val:
      o_labangle_val:=o_labangle_val
	+angle(direction (o_labpos_val*length(p)) of p);
      o_labpic_val:=o_labpic_val rotated o_labangle_val;
    fi;
    save shift_;pair shift_;
    shift_:=(0,0); % default
    if known o_labdir_val:
      shift_:=clabshift_*CLOV_("labdist");
    fi;
    label(o_labpic_val,
        (point (CLOV_("labpos")*length(p)) of p) shifted shift_);
  fi;	  
enddef;

% This is the main function that distinguishes if a curve is in
% or out of an object (that is, if it will follow the object or not),
% and if it links two objects or two points.
% (That makes four different combinations.)
% |pa| is the path connecting two objects
% |pb| is the path connecting two points
% |n| can be either an object (numeric) or a point (pair).
vardef nc_core_@#(suffix n)(suffix p)(text pa)(text pb)=

  if str @# <> "":
    % we are in an object (deferred curve)
    if numeric n:
      % @#p.n_ = path number
      addPath@#(p,@#p.n_,pa);
      if known o_labpic_val:
        ObjLabel@#(o_labpic_val) "labpathid(" & decimal(-@#p.n_) & ")"; %AAAAAA
	% in the above, labpos is already taken into account if set
      fi;
      
    else:
      addPath@#(p,@#p.n_,pb);
      if known o_labpic_val:
        ObjLabel@#(o_labpic_val) "labpathid(" & decimal(-@#p.n_) & ")"; %AAAAAA
	% in the above, labpos is already taken into account if set
      fi;      
    fi;
  else:
    % we are not in an object (immediate curve)
    % we draw the curve only if it is visible:
    if CLOV_("visible"):
      if numeric n:
        sc_(LocalOptionValue("cdraw","cdraw_default"))
          ()(0) % value irrelevant, but first parameter empty
          (pa);
	% if necessary, a label is drawn
	nc_label_(pa); % added Sep. 28, 2006
      else:
        sc_(LocalOptionValue("cdraw","cdraw_default"))
          ()(0) % value irrelevant, but first parameter empty
          (pb);
        % if necessary, a label is drawn 
	nc_label_(pb); % added Sep. 28, 2006
      fi;
    fi;
  fi;
enddef;

% This is like |nc_core_|, but the last two parameters of
% |nc_core_| are identical.
vardef nc_core_double_@#(suffix n)(suffix p)(text pa)=
  nc_core_@#(n)(p)(pa)(pa);
enddef;

vardef ncshort_@#(expr a,b)(text n)(text m)(text options)=
  if string n:
    save tmp;string tmp;
    tmp="(" & str @# & ")(" & nameToSuffixString_(n) & "," &
                              nameToSuffixString_(m) & ")";
    sc_(a & "_" & tmp)(b) options;
    sc_(b & "_" & tmp)(patharray_suffix_);
  else:
    sc_(a & "_")(@#)(n,m)(b) options;
    sc_(b & "_")(@#)(n,m)(patharray_suffix_);
  fi;
enddef;

def object_(suffix n)(expr s)=
  (n.sc_(CLOV_("pos" &s))+CLOV_("offset" & s))
enddef;

def objectpoint_(suffix n)(expr s)=
  (n+CLOV_("offset" & s))
enddef;

% This function is useful for matrices. It returns the object at
% a given coordinate pair in a matrix. It is used by functions such
% as |mcline|.
def matpos(suffix $)(expr p)=
  obj($sb[(xpart(p)-1)*$ny+ypart(p)])
enddef;

let mpos=matpos;

% This function is useful for trees. It returns the object at
% a given rank in a tree.
def treepos(suffix $)(expr n)=
  obj(obj($subt).sb[n])
enddef;

let tpos=treepos;

% |ntreepos| is a shorthand for embedded |treepos| calls
vardef ntreepos_(suffix O)(text l)=
  save list,first,result;string list,result;
  hide(
  first=0;list="";
  forsuffixes $=l:
    if first=0: first:=$;
    else:
      if list="":list:=str $;
      else:
        list:=list & "," & str $;
      fi;
    fi;    
  endfor;
  if list="":
    result="treepos(" & str O & ")(" & decimal(first) & ")";
  else:
    result="ntreepos(treepos(" & str O & ")(" & decimal(first) &
        "))(" & list & ")";
  fi;
  )
  result
enddef;

% we can't use a |vardef| where a suffix appears, so we split
% the |ntreepos| function in two parts.
def ntreepos(suffix O)(text l)=
  scantokens(ntreepos_(O)(l))
enddef;

def treeroot(suffix $)(text l)=
  if isTree(ntreepos($)(l)):
    obj(ntreepos($)(l)root)
  else:
    ntreepos($)(l)
  fi
enddef;

def setupobjectfunction(suffix n)=
  save f;
  if numeric n:
    let f=object_;
  else:
    let f=objectpoint_;
  fi;
enddef;

% |@#| is the object to which a line is added
% |n| is the source subobject, |m| is the target.
% We also distinguish the case when |n| and |m| are objects
% and when they are points (numerics vs pairs)
vardef nccurve@#(text n)(text m) text options =
  ncshort_@#("nc","nccurve")(n)(m)(options);
enddef;

% ``reverse'' |nccurve|
vardef rnccurve@#(text n)(text m) text options =
  ncshort_@#("nc","nccurve")(m)(n)(options);
enddef;

vardef nccurve_(suffix $)(suffix n,m)(suffix p)=
  if n=m: % case added Nov. 10, 2006
    nc_core_$(n)(p)
      (object_(n)("A"){dir(o_angleA_val)}
	..{dir(180+o_angleB_val)-dir(o_angleA_val)}
	   (object_(n)("A")+CLOV_("curvemax")*1cm
	      *dir(.5[o_angleA_val,180+o_angleB_val]))
        ..{dir(o_angleB_val)}object_(m)("B")
	cutbefore BpathObj(n) cutafter BpathObj(m))
      (objectpoint_(n)("A"){dir(o_angleA_val)}
        ..{dir(180+o_angleB_val)-dir(o_angleA_val)}
	   (object_(n)("A")+CLOV_("curvemax")*1cm
	      *dir(.5[o_angleA_val,180+o_angleB_val]))
        ..{dir(o_angleB_val)}objectpoint_(m)("B"));
  else:    
    nc_core_$(n)(p)
      (object_(n)("A"){dir(o_angleA_val)}
        ..tension CLOV_("linetensionA") and CLOV_("linetensionB")
        ..{dir(o_angleB_val)}object_(m)("B")
         cutbefore BpathObj(n) cutafter BpathObj(m))
      (objectpoint_(n)("A"){dir(o_angleA_val)}
        ..tension CLOV_("linetensionA") and CLOV_("linetensionB")
        ..{dir(o_angleB_val)}objectpoint_(m)("B"));
  fi;  
enddef;

% variant for matrices:
% We connect two nodes of the matrix |@#|.
% This cannot be used to connect nodes that are not in the same
% matrix. It is simpler to name the nodes in order to achieve
% trans-connections.
vardef mccurve@#(expr ai,aj,bi,bj) text options=
  nccurve@#(matpos(@#)((ai,aj)))(matpos(@#)((bi,bj))) options;
enddef;

% variant for trees:
% We connect two nodes of the tree |@#|.
% This cannot be used to connect nodes that are not in the same tree.
% It is simpler to name the nodes in order to achieve trans-connections.
vardef tccurve@#(text ai)(text bi) text options=
  nccurve@#(treeroot(@#)(ai))(treeroot(@#)(bi)) options;
enddef;

% |@#| is the object to which a line is added
% |n| is the source subobject, |m| is the target.
% We also distinguish the case when |n| and |m| are objects
% and when they are points (numerics vs pairs)
vardef ncline@#(text n)(text m) text options =
  ncshort_@#("nc","ncline")(n)(m)(options);
enddef;

% ``reverse'' |ncline|
vardef rncline@#(text n)(text m) text options =
  ncshort_@#("nc","ncline")(m)(n)(options);
enddef;

vardef ncline_(suffix $)(suffix n,m)(suffix p)=
  nc_core_$(n)(p)
    (object_(n)("A")..object_(m)("B")
        cutbefore BpathObj(n) cutafter BpathObj(m))
    (objectpoint_(n)("A")..objectpoint_(m)("B"));
enddef;

% variant for matrices:
% We connect two nodes of the matrix |@#|.
% This cannot be used to connect nodes that are not in the same
% matrix. It is simpler to name the nodes in order to achieve
% trans-connections.
vardef mcline@#(expr ai,aj,bi,bj) text options=
  ncline@#(matpos(@#)((ai,aj)))(matpos(@#)((bi,bj))) options;
enddef;

% variant for trees:
% We connect two nodes of the tree |@#|.
% This cannot be used to connect nodes that are not in the same tree.
% It is simpler to name the nodes in order to achieve trans-connections.
vardef tcline@#(text ai)(text bi) text options=
  ncline@#(treeroot(@#)(ai))(treeroot(@#)(bi)) options;
enddef;

% |@#| is the object to which a line is added
% |n| is the source subobject, |m| is the target.
% We also distinguish the case when |n| and |m| are objects
% and when they are points (numerics vs pairs)
vardef ncarc@#(text n)(text m) text options =
  ncshort_@#("nc","ncarc")(n)(m)(options);
enddef;

% ``reverse'' |ncarc|
vardef rncarc@#(text n)(text m) text options =
  ncshort_@#("nc","ncarc")(m)(n)(options);
enddef;

vardef ncarc_(suffix $)(suffix n,m)(suffix p)=
  nc_core_$(n)(p)
    (object_(n)("A"){dir(o_angleA_val+CLOV_("arcangleA"))}
      ..{dir(o_angleB_val-CLOV_("arcangleB"))}object_(m)("B")
       cutbefore BpathObj(n) cutafter BpathObj(m))
    (objectpoint_(n)("A"){dir(o_angleA_val+CLOV_("arcangleA"))}
        ..{dir(o_angleB_val-CLOV_("arcangleB"))}objectpoint_(m)("B"));
enddef;

% variant for matrices:
% We connect two nodes of the matrix |@#|.
% This cannot be used to connect nodes that are not in the same
% matrix. It is simpler to name the nodes in order to achieve
% trans-connections.
vardef mcarc@#(expr ai,aj,bi,bj) text options=
  ncarc@#(matpos(@#)((ai,aj)))(matpos(@#)((bi,bj))) options;
enddef;

% variant for trees:
% We connect two nodes of the tree |@#|.
% This cannot be used to connect nodes that are not in the same tree.
% It is simpler to name the nodes in order to achieve trans-connections.
vardef tcarc@#(text ai)(text bi) text options=
  ncarc@#(treeroot(@#)(ai))(treeroot(@#)(bi)) options;
enddef;

% |@#| is the object to which a line is added
% |n| is the source subobject, |m| is the target.
% We also distinguish the case when |n| and |m| are objects
% and when they are points (numerics vs pairs).
vardef ncangle@#(text n)(text m) text options =
  ncshort_@#("nc","ncangle")(n)(m)(options);
enddef;

% ``reverse'' |ncangle|
vardef rncangle@#(text n)(text m) text options =
  ncshort_@#("nc","ncangle")(m)(n)(options);
enddef;

vardef ncangle_(suffix $)(suffix n,m)(suffix p)=
  % we have to find two additional points; we must be careful
  % not to use assignments, because |n.c| and |m.c|
  % may be floating:
  save ap;pair ap[];
  setupobjectfunction(n);
  f(m)("B")-ap1=CLOV_("armB")*dir(CLOV_("angleB"));
  ap2=f(n)("A")+whatever*dir(CLOV_("angleA"));
  ap1=ap2+whatever*dir(CLOV_("angleA")+90);    
  nc_core_$(n)(p)
    (smoothen(object_(n)("A")--ap2--ap1--object_(m)("B")
           cutbefore BpathObj(n) cutafter BpathObj(m))(CLOV_("linearc")))
    (smoothen(objectpoint_(n)("A")--ap2--ap1--objectpoint_(m)("B"))
         (CLOV_("linearc")));
enddef;

% variant for matrices:
% We connect two nodes of the matrix |@#|.
% This cannot be used to connect nodes that are not in the same
% matrix. It is simpler to name the nodes in order to achieve
% trans-connections.
vardef mcangle@#(expr ai,aj,bi,bj) text options=
  ncangle@#(matpos(@#)((ai,aj)))(matpos(@#)((bi,bj))) options;
enddef;

% variant for trees:
% We connect two nodes of the tree |@#|.
% This cannot be used to connect nodes that are not in the same tree.
% It is simpler to name the nodes in order to achieve trans-connections.
vardef tcangle@#(text ai)(text bi) text options=
  ncangle@#(treeroot(@#)(ai))(treeroot(@#)(bi)) options;
enddef;

% |@#| is the object to which a line is added
% |n| is the source subobject, |m| is the target.
% We also distinguish the case when |n| and |m| are objects
% and when they are points (numerics vs pairs).
vardef ncangles@#(text n)(text m) text options =
  ncshort_@#("nc","ncangles")(n)(m)(options);
enddef;

% ``reverse'' |ncangles|
vardef rncangles@#(text n)(text m) text options =
  ncshort_@#("nc","ncangles")(m)(n)(options);
enddef;

vardef ncangles_(suffix $)(suffix n,m)(suffix p)=
  % we have to find additional points; we must be careful
  % not to use assignments, because |n.c| and |m.c|
  % may be floating:
  save ap;pair ap[];
  setupobjectfunction(n);
  ap1-f(n)("A")=CLOV_("armA")*dir(CLOV_("angleA"));
  f(m)("B")-ap2=CLOV_("armB")*dir(CLOV_("angleB"));
  ap3=ap1+whatever*dir(CLOV_("angleA")+90);
  ap2=ap3+whatever*dir(CLOV_("angleA"));    
  nc_core_$(n)(p)
    (smoothen(object_(n)("A")--ap1--ap3--ap2--object_(m)("B")
           cutbefore BpathObj(n) cutafter BpathObj(m))(CLOV_("linearc")))
    (smoothen(objectpoint_(n)("A")--ap1--ap3--ap2--objectpoint_(m)("B"))
         (CLOV_("linearc")));
enddef;

% variant for matrices:
% We connect two nodes of the matrix |@#|.
% This cannot be used to connect nodes that are not in the same
% matrix. It is simpler to name the nodes in order to achieve
% trans-connections.
vardef mcangles@#(expr ai,aj,bi,bj) text options=
  ncangles@#(matpos(@#)((ai,aj)))(matpos(@#)((bi,bj))) options;
enddef;

% variant for trees:
% We connect two nodes of the tree |@#|.
% This cannot be used to connect nodes that are not in the same tree.
% It is simpler to name the nodes in order to achieve trans-connections.
vardef tcangles@#(text ai)(text bi) text options=
  ncangles@#(treeroot(@#)(ai))(treeroot(@#)(bi)) options;
enddef;

% |@#| is the object to which a line is added
% |n| is the source subobject, |m| is the target.
% We also distinguish the case when |n| and |m| are objects
% and when they are points (numerics vs pairs).
vardef ncdiag@#(text n)(text m) text options =
  ncshort_@#("nc","ncdiag")(n)(m)(options);
enddef;

% ``reverse'' |ncdiag|
vardef rncdiag@#(text n)(text m) text options =
  ncshort_@#("nc","ncdiag")(m)(n)(options);
enddef;

vardef ncdiag_(suffix $)(suffix n,m)(suffix p)=
  % we have to find two additional points; we must be careful
  % not to use assignments, because |n.c| and |m.c|
  % may be floating:
  save ap;pair ap[];
  setupobjectfunction(n);
  ap1-f(n)("A")=CLOV_("armA")*dir(CLOV_("angleA"));
  f(m)("B")-ap2=CLOV_("armB")*dir(CLOV_("angleB"));
  nc_core_$(n)(p)
    (smoothen(object_(n)("A")--ap1--ap2--object_(m)("B")
       cutbefore BpathObj(n) cutafter BpathObj(m))(CLOV_("linearc")))
    (smoothen(objectpoint_(n)("A")--ap1--ap2--objectpoint_(m)("B"))
       (CLOV_("linearc")));
enddef;

% variant for matrices:
% We connect two nodes of the matrix |@#|.
% This cannot be used to connect nodes that are not in the same
% matrix. It is simpler to name the nodes in order to achieve
% trans-connections.
vardef mcdiag@#(expr ai,aj,bi,bj) text options=
  ncdiag@#(matpos(@#)((ai,aj)))(matpos(@#)((bi,bj))) options;
enddef;

% variant for trees:
% We connect two nodes of the tree |@#|.
% This cannot be used to connect nodes that are not in the same tree.
% It is simpler to name the nodes in order to achieve trans-connections.
vardef tcdiag@#(text ai)(text bi) text options=
  ncdiag@#(treeroot(@#)(ai))(treeroot(@#)(bi)) options;
enddef;

% |@#| is the object to which a line is added
% |n| is the source subobject, |m| is the target.
% We also distinguish the case when |n| and |m| are objects
% and when they are points (numerics vs pairs).
vardef ncdiagg@#(text n)(text m) text options =
  ncshort_@#("nc","ncdiagg")(n)(m)(options);
enddef;

% ``reverse'' |ncdiagg|
vardef rncdiagg@#(text n)(text m) text options =
  ncshort_@#("nc","ncdiagg")(m)(n)(options);
enddef;

vardef ncdiagg_(suffix $)(suffix n,m)(suffix p)=
  % we have to find an additional point; we must be careful
  % not to use assignments, because |n.c| and |m.c|
  % may be floating:
  save ap;pair ap;
  setupobjectfunction(n);
  ap-f(n)("A")=CLOV_("armA")*dir(CLOV_("angleA"));
  nc_core_$(n)(p)
    (smoothen(object_(n)("A")--ap--object_(m)("B")
       cutbefore BpathObj(n) cutafter BpathObj(m))(CLOV_("linearc")))
    (smoothen(objectpoint_(n)("A")--ap--objectpoint_(m)("B"))
       (CLOV_("linearc")));
enddef;

% variant for matrices:
% We connect two nodes of the matrix |@#|.
% This cannot be used to connect nodes that are not in the same
% matrix. It is simpler to name the nodes in order to achieve
% trans-connections.
vardef mcdiagg@#(expr ai,aj,bi,bj) text options=
  ncdiagg@#(matpos(@#)((ai,aj)))(matpos(@#)((bi,bj))) options;
enddef;

% variant for trees:
% We connect two nodes of the tree |@#|.
% This cannot be used to connect nodes that are not in the same tree.
% It is simpler to name the nodes in order to achieve trans-connections.
vardef tcdiagg@#(text ai)(text bi) text options=
  ncdiagg@#(treeroot(@#)(ai))(treeroot(@#)(bi)) options;
enddef;

% |@#| is the object to which a line is added
% |n| is the source subobject, |m| is the target.
% We also distinguish the case when |n| and |m| are objects
% and when they are points (numerics vs pairs).
vardef ncbar@#(text n)(text m) text options =
  ncshort_@#("nc","ncbar")(n)(m)(options);
enddef;

% ``reverse'' |ncbar|
vardef rncbar@#(text n)(text m) text options =
  ncshort_@#("nc","ncbar")(m)(n)(options);
enddef;

vardef ncbar_(suffix $)(suffix n,m)(suffix p)=
  % we have to find additional points; we must be careful
  % not to use assignments, because |n.c| and |m.c|
  % may be floating:
  save ap,posap;pair ap[];numeric posap;
  setupobjectfunction(n);
  % we use different arms, but the same angles (see PSTricks documentation):
  ap1-f(n)("A")=CLOV_("armA")*dir(CLOV_("angleA"));
  ap2-f(m)("B")=CLOV_("armB")*dir(CLOV_("angleA")); 
  ap3=posap[f(n)("A"),ap1]=whatever[ap2,ap2+(ap2-f(m)("B")) rotated 90];
  ap4=whatever[f(m)("B"),ap2]=whatever[ap1,ap1+(ap1-f(n)("A")) rotated 90];
  if posap<1:
    ap5=ap1;ap6=ap4;
  else:
    ap5=ap3;ap6=ap2;
  fi;  
  nc_core_$(n)(p)
    (smoothen(object_(n)("A")--ap5--ap6--object_(m)("B")
       cutbefore BpathObj(n) cutafter BpathObj(m))(CLOV_("linearc")))
    (smoothen(objectpoint_(n)("A")--ap5--ap6--objectpoint_(m)("B"))
       (CLOV_("linearc")));
enddef;

% variant for matrices:
% We connect two nodes of the matrix |@#|.
% This cannot be used to connect nodes that are not in the same
% matrix. It is simpler to name the nodes in order to achieve
% trans-connections.
vardef mcbar@#(expr ai,aj,bi,bj) text options=
  ncbar@#(matpos(@#)((ai,aj)))(matpos(@#)((bi,bj))) options;
enddef;

% variant for trees:
% We connect two nodes of the tree |@#|.
% This cannot be used to connect nodes that are not in the same tree.
% It is simpler to name the nodes in order to achieve trans-connections.
vardef tcbar@#(text ai)(text bi) text options=
  ncbar@#(treeroot(@#)(ai))(treeroot(@#)(bi)) options;
enddef;

% |@#| is the object to which a line is added
% |n| is the source subobject, |m| is the target.
% We also distinguish the case when |n| and |m| are objects
% and when they are points (numerics vs pairs).
vardef ncloop@#(text n)(text m) text options =
  ncshort_@#("nc","ncloop")(n)(m)(options);
enddef;

% ``reverse'' |ncloop|
vardef rncloop@#(text n)(text m) text options =
  ncshort_@#("nc","ncloop")(m)(n)(options);
enddef;

vardef ncloop_(suffix $)(suffix n,m)(suffix p)=
  % we have to find additionnal points; we must be careful
  % not to use assignments, because |n.c| and |m.c|
  % may be floating:
  save ap,posap;pair ap[];numeric posap;
  setupobjectfunction(n);
  ap1-f(n)("A")=CLOV_("armA")*dir(CLOV_("angleA"));
  f(m)("B")-ap2=CLOV_("armB")*dir(CLOV_("angleB")); 
  ap3-ap1=CLOV_("loopsize")*unitvector((ap1-f(n)("A")) rotated 90);
  ap4=whatever[ap3,ap3+(ap2-f(m)("B"))]
     =whatever[ap2,ap2+(ap2-f(m)("B")) rotated 90];
  nc_core_$(n)(p)
    (smoothen(object_(n)("A")--ap1--ap3--ap4--ap2--object_(m)("B")
       cutbefore BpathObj(n) cutafter BpathObj(m))(CLOV_("linearc")))
    (smoothen(objectpoint_(n)("A")--ap1--ap3--ap4--ap2--objectpoint_(m)("B"))
       (CLOV_("linearc")));
enddef;

% variant for matrices:
% We connect two nodes of the matrix |@#|.
% This cannot be used to connect nodes that are not in the same
% matrix. It is simpler to name the nodes in order to achieve
% trans-connections.
vardef mcloop@#(expr ai,aj,bi,bj) text options=
  ncloop@#(matpos(@#)((ai,aj)))(matpos(@#)((bi,bj))) options;
enddef;

% variant for trees:
% We connect two nodes of the tree |@#|.
% This cannot be used to connect nodes that are not in the same tree.
% It is simpler to name the nodes in order to achieve trans-connections.
vardef tcloop@#(text ai)(text bi) text options=
  ncloop@#(treeroot(@#)(ai))(treeroot(@#)(bi)) options;
enddef;

% |firstpart| returns the time elapsed between the beginning of |p|
% and the point where the distance to the origin (on |p|) is |d|

def firstpart_(expr d,p)=
  arctime_(d/arclength(p),p)
enddef;

% Cut a path |p| in pieces of approximate arclength |d|
% (this is actually a macro I wrote in April 1995)
vardef divide_equally_(expr p,d)=
  save a,q,v;
  numeric a;
  path q,v;
  hide(
    v=p;
    q=point 0 of v;
    forever:
      a:=firstpart_(d,v);
      q:=q{direction 0 of v}..{direction a of v}(point a of v);
      exitif abs(a-length(v))<.1mm;
      v:=subpath(a,length(v)) of v;
    endfor;
  )
  q
enddef;

vardef zigzagit__(expr p)=
  save n,q,r,zz;path q,r;pair zz[];
  hide(
    n=floor(arclength(p)/(CLOV_("coilwidth")*CLOV_("coilheight"))+0.5);
    % we now divide |p| in |n| pieces  
    q=divide_equally_(p,arclength(p)/n);
    % here, we must now introduce additional points
    for i:=0 upto length(q)-1:
      zz[i*3]=point i of q;
      zz[i*3+1]=.25[point i of q,point (i+1) of q]
        +CLOV_("coilwidth")/2
         *(unitvector((point (i+1) of q)-(point i of q)) rotated 90);
      zz[i*3+2]=.75[point i of q,point (i+1) of q]
        +CLOV_("coilwidth")/2
         *(unitvector(point (i+1) of q-point i of q) rotated -90);
    endfor;
    zz[length(q)*3]=point (length(q)) of q;
    % when joining the points, we must take care not to introduce
    % additional angles, in case |p| was not a straight line
    r=zz[0]--zz[1] for i:=1 upto length(q)-1: -- zz[3*i-1]--zz[3*i+1] endfor
      --zz[3*(length(q)-1)+2]--zz[3*length(q)];
    )
  r
enddef;

% coil function
def coilf_(expr q,i)=
  (
  if i>0:
    (arcpoint (i/n,q)
      +((.5CLOV_("coilwidth")
            *(sind(frac(i)*360),
              2*newcoilheight*i
              +cosd(frac(i)*360)*sind(CLOV_("coilaspect"))))
        -(0,.5CLOV_("coilwidth")*sind(CLOV_("coilaspect"))+(i/n)*arclength(q)))
        rotated (angle(arcdirection (i/n,q))-90)
        )
  else:
      (arcpoint (0,q)
      +((.5CLOV_("coilwidth")
            *(0,sind(CLOV_("coilaspect"))))
        -(0,.5CLOV_("coilwidth")*sind(CLOV_("coilaspect"))))
        rotated (angle(arcdirection (0,q))-90)
        )  
  fi
  )
enddef;

vardef coilit__(expr p)=
  save n,q,newcoilheight;path q;
  hide(
    n=round(arclength(p)/(CLOV_("coilheight")*CLOV_("coilwidth")));
    % we slightly change the coilheight so that the coil
    % turns an integer number of times
    if n>0:
      newcoilheight=arclength(p)/n/CLOV_("coilwidth");
    fi;
    q=coilf_(p,0)
    for i:=1 upto n*(360/CLOV_("coilinc")):
      ..coilf_(p,i*(CLOV_("coilinc")/360))
    endfor;
  )
  q
enddef;

% This function takes two paths where the last point
% of the first path is the first point of the second path;
% it creates a path looking like |p--q|, but where the
% common point is not duplicated.
def combinepaths_(expr p,q)=
  ((subpath(0,length(p)-1) of p)..
    controls (postcontrol (length(p)-1) of p) and
    (precontrol length(p) of p) ..q)
enddef;

vardef zigcoil_(expr type,p)=
  save na,nb;
  hide(
    % first, we cut two ends at lengths |coilarmA| and |coilarmB|
    na=firstpart_(CLOV_("coilarmA"),p);
    nb=firstpart_(CLOV_("coilarmB"),reverse p);
  )
  % we merge three paths, but we take care that no double points are added;
  % the double points would make it difficult to smooth the curve afterwards
  combinepaths_(
    combinepaths_(subpath (0,na) of p,
                  scantokens(type)(subpath (na,length(p)-nb) of p)),
                  subpath (length(p)-nb,length(p)) of p)
enddef;

vardef zigzagit(expr p)=
  zigcoil_("zigzagit__",p)
enddef;

vardef coilit(expr p)=
  zigcoil_("coilit__",p)
enddef;

def frac(expr i)=
  (i-floor(i))
enddef;

% function giving the time with respect to arclength:
% arctime_ 0 of p=beginning
% arctime_ 1 of p=end
% 
vardef arctime_(expr i,p)=
  save t;
  hide(
    if i=0: t=0;
    elseif i=1: t=length(p);
    else:
      save d,min,max;
      d=i*arclength(p);
      min=0;max=length(p);
      forever:
        t:=(min+max)/2;
        if arclength(subpath(0,t) of p)<d:
          min:=t;
        else:
          max:=t;
        fi;
        exitif arclength(subpath(min,max) of p)<.1mm;
      endfor;
    fi;
    )
  t
enddef;

def arcpoint(expr i,p)=
  (point arctime_(i,p) of p)
enddef;

def arcdirection(expr i,p)=
  (direction arctime_(i,p) of p)
enddef;


% |@#| is the object to which a line is added
% |n| is the source subobject, |m| is the target.
% We also distinguish the case when |n| and |m| are objects
% and when they are points (numerics vs pairs).
vardef nccoil@#(text n)(text m) text options =
  ncshort_@#("nc","nccoil")(n)(m)(options);
enddef;

% ``reverse'' |nccoil|
vardef rnccoil@#(text n)(text m) text options =
  ncshort_@#("nc","nccoil")(m)(n)(options);
enddef;

vardef nccoil_(suffix $)(suffix n,m)(suffix p)=
  setupobjectfunction(n);
  nc_core_$(n)(p)
    (coilit(object_(n)("A"){dir(o_angleA_val)}
      ..tension CLOV_("linetensionA") and CLOV_("linetensionB")
      ..{dir(o_angleB_val)}object_(m)("B")
       cutbefore BpathObj(n) cutafter BpathObj(m)))
    (coilit(objectpoint_(n)("A"){dir(o_angleA_val)}
      ..tension CLOV_("linetensionA") and CLOV_("linetensionB")
      ..{dir(o_angleB_val)}objectpoint_(m)("B")));
enddef;

% variant for matrices:
% We connect two nodes of the matrix |@#|.
% This cannot be used to connect nodes that are not in the same
% matrix. It is simpler to name the nodes in order to achieve
% trans-connections.
vardef mccoil@#(expr ai,aj,bi,bj) text options=
  nccoil@#(matpos(@#)((ai,aj)))(matpos(@#)((bi,bj))) options;
enddef;

% variant for trees:
% We connect two nodes of the tree |@#|.
% This cannot be used to connect nodes that are not in the same tree.
% It is simpler to name the nodes in order to achieve trans-connections.
vardef tccoil@#(text ai)(text bi) text options=
  nccoil@#(treeroot(@#)(ai))(treeroot(@#)(bi)) options;
enddef;


% |@#| is the object to which a line is added
% |n| is the source subobject, |m| is the target.
% We also distinguish the case when |n| and |m| are objects
% and when they are points (numerics vs pairs).
vardef nczigzag@#(text n)(text m) text options =
  ncshort_@#("nc","nczigzag")(n)(m)(options);
enddef;

% ``reverse'' |nczigzag|
vardef rnczigzag@#(text n)(text m) text options =
  ncshort_@#("nc","nczigzag")(m)(n)(options);
enddef;

vardef nczigzag_(suffix $)(suffix n,m)(suffix p)=
  setupobjectfunction(n);
  nc_core_$(n)(p)
    (smoothen(zigzagit(object_(n)("A"){dir(o_angleA_val)}
      ..tension CLOV_("linetensionA") and CLOV_("linetensionB")
      ..{dir(o_angleB_val)}object_(m)("B")
       cutbefore BpathObj(n) cutafter BpathObj(m)))(CLOV_("linearc")))
    (smoothen(zigzagit(objectpoint_(n)("A"){dir(o_angleA_val)}
      ..tension CLOV_("linetensionA") and CLOV_("linetensionB")
      ..{dir(o_angleB_val)}objectpoint_(m)("B")))(CLOV_("linearc")));
enddef;

% variant for matrices:
% We connect two nodes of the matrix |@#|.
% This cannot be used to connect nodes that are not in the same
% matrix. It is simpler to name the nodes in order to achieve
% trans-connections.
vardef mczigzag@#(expr ai,aj,bi,bj) text options=
  nczigzag@#(matpos(@#)((ai,aj)))(matpos(@#)((bi,bj))) options;
enddef;

% variant for trees:
% We connect two nodes of the tree |@#|.
% This cannot be used to connect nodes that are not in the same tree.
% It is simpler to name the nodes in order to achieve trans-connections.
vardef tczigzag@#(text ai)(text bi) text options=
  nczigzag@#(treeroot(@#)(ai))(treeroot(@#)(bi)) options;
enddef;


% |@#| is the object to which a line is added
% |n| is the source subobject, |m| is the target.
% We also distinguish the case when |n| and |m| are objects
% and when they are points (numerics vs pairs).
vardef ncbox@#(text n)(text m) text options =
  ncshort_@#("nc","ncbox")(n)(m)("arrows(draw)",options);
enddef;

% ``reverse'' |ncbox|
vardef rncbox@#(text n)(text m) text options =
  ncshort_@#("nc","ncbox")(m)(n)("arrows(draw)",options);
enddef;

% Compute the |boxheight| parameter
def compute_boxh(expr boxs,boxh,boxd)=
  if boxh>=0: boxh
  elseif boxd>=0: (2*boxs-boxd) % boxsize is half the width,
                                % according to PSTricks' documentation
  else: boxs
  fi  
enddef;

% Compute the |boxdepth| parameter
def compute_boxd(expr boxs,boxh,boxd)=
  if boxd>=0: boxd
  elseif boxh>=0: (2*boxs-boxh) % boxsize is half the width,
                                % according to PSTricks' documentation
  else: boxs
  fi  
enddef;

vardef ncbox_(suffix $)(suffix n,m)(suffix p)=
  % we have to find additional points; we must be careful
  % not to use assignments, because |n.c| and |m.c|
  % may be floating:
  save ap,boxh,boxd;pair ap[];
  setupobjectfunction(n);
  boxh=compute_boxh(CLOV_("boxsize"),CLOV_("boxheight"),CLOV_("boxdepth"));
  boxd=compute_boxd(CLOV_("boxsize"),CLOV_("boxheight"),CLOV_("boxdepth"));
  f(n)("A")-ap1=CLOV_("nodesepA")*unitvector(f(m)("B")-f(n)("A"));
  ap5-ap1=boxh*unitvector(dir(90+angle(f(m)("B")-f(n)("A"))));
  ap1-ap2=boxd*unitvector(dir(90+angle(f(m)("B")-f(n)("A"))));
  ap4-ap3=ap5-ap2;
  ap4-ap5=(CLOV_("nodesepA")
    +CLOV_("nodesepB")
    +arclength(f(n)("A")--f(m)("B")))*unitvector(f(m)("B")-f(n)("A"));
  % we set nodesepA and nodesepB to 0 because they are used with another
  % meaning in |addPath| (I am just following what PSTricks does.)
  o_nodesepA_val:=0;
  o_nodesepB_val:=0;
  nc_core_double_$(n)(p)
    (smoothen(ap1--ap2--ap3--ap4--ap5--ap1)(CLOV_("linearc")));
enddef;

% variant for matrices:
% We connect two nodes of the matrix |@#|.
% This cannot be used to connect nodes that are not in the same
% matrix. It is simpler to name the nodes in order to achieve
% trans-connections.
vardef mcbox@#(expr ai,aj,bi,bj) text options=
  ncbox@#(matpos(@#)((ai,aj)))(matpos(@#)((bi,bj))) options;
enddef;

% variant for trees:
% We connect two nodes of the tree |@#|.
% This cannot be used to connect nodes that are not in the same tree.
% It is simpler to name the nodes in order to achieve trans-connections.
vardef tcbox@#(text ai)(text bi) text options=
  ncbox@#(treeroot(@#)(ai))(treeroot(@#)(bi)) options;
enddef;

% |@#| is the object to which a line is added
% |n| is the source subobject, |m| is the target.
% We also distinguish the case when |n| and |m| are objects
% and when they are points (numerics vs pairs).
vardef ncarcbox@#(text n)(text m) text options =
  ncshort_@#("nc","ncarcbox")(n)(m)("arrows(draw)",options);
enddef;

% ``reverse'' |ncarcbox|
vardef rncarcbox@#(text n)(text m) text options =
  ncshort_@#("nc","ncarcbox")(m)(n)("arrows(draw)",options);
enddef;

vardef ncarcbox_(suffix $)(suffix n,m)(suffix p)=
  % we have to find additional points; we must be careful
  % not to use assignments, because |n.c| and |m.c|
  % may be floating:
  save ap,boxh,boxd;pair ap[];
  setupobjectfunction(n);
  boxh=compute_boxh(CLOV_("boxsize"),CLOV_("boxheight"),CLOV_("boxdepth"));
  boxd=compute_boxd(CLOV_("boxsize"),CLOV_("boxheight"),CLOV_("boxdepth"));
  ap20=unitvector(dir(90+angle(f(m)("B")-f(n)("A"))+CLOV_("arcangleA")));
  ap21=-ap24=ap20 rotated -90;
  ap22=-ap25=ap21 rotated (-2*CLOV_("arcangleA"));
  ap23=ap20 rotated (-2*CLOV_("arcangleA"));
  ap1-f(n)("A")=boxh*ap20;
  f(n)("A")-ap2=boxd*ap20;
  ap5-f(m)("B")=boxh*ap23;
  f(m)("B")-ap4=boxd*ap23;
  ap1-ap11=ap2-ap12=ap21*CLOV_("nodesepA");
  ap15-ap5=ap14-ap4=ap22*CLOV_("nodesepB");
  if CLOV_("arcangleA")=0:
    % normally, one would use |ncbox| instead of |ncarcbox| in this case,
    % but we make sure it works anyway
    ap6=.5[ap1,ap5];
    ap3=.5[ap2,ap4];
  else:
    if abs(CLOV_("arcangleA"))=90:
      ap0=.5[ap1,ap5];
    else:
      ap0=whatever[ap1,ap2]=whatever[ap5,ap4];
    fi;
    ap6-ap0=(ap1-ap0) rotated (.5*(angle(ap5-ap0)-angle(ap1-ap0)));
    ap3-ap0=(ap2-ap0) rotated (.5*(angle(ap5-ap0)-angle(ap1-ap0)));
  fi;
  % we set nodesepA and nodesepB to 0 because they are used with another
  % meaning in |addPath| (I am just following what PSTricks does.)
  o_nodesepA_val:=0;
  o_nodesepB_val:=0;
  nc_core_double_$(n)(p)
    (ap11{ap21}..ap1{ap21}..ap6..{ap22}ap5..ap15{ap22}..{ap25}ap14..
     {ap25}ap4..ap3..{ap24}ap2{ap24}..{ap24}ap12..{ap21}ap11);
enddef;

% variant for matrices:
% We connect two nodes of the matrix |@#|.
% This cannot be used to connect nodes that are not in the same
% matrix. It is simpler to name the nodes in order to achieve
% trans-connections.
vardef mcarcbox@#(expr ai,aj,bi,bj) text options=
  ncarcbox@#(matpos(@#)((ai,aj)))(matpos(@#)((bi,bj))) options;
enddef;

% variant for trees:
% We connect two nodes of the tree |@#|.
% This cannot be used to connect nodes that are not in the same tree.
% It is simpler to name the nodes in order to achieve trans-connections.
vardef tcarcbox@#(text ai)(text bi) text options=
  ncarcbox@#(treeroot(@#)(ai))(treeroot(@#)(bi)) options;
enddef;

% |@#| is the object to which a line is added
% |n| is the source and target subobject
% we could also distinguish the case when |n| is an object
% and when it is a point (numerics vs pairs)
vardef nccircle@#(text n) text options =
  o_patharray("_upath_");
  % The first parameter is not relevant since we have only local options
  ExecuteOptions()(options);
  if string n:
    save tmp;string tmp;
    tmp="(" & str @# & ")(" & nameToSuffixString_(n) & ")";
    sc_("nccircle_" & tmp)(patharray_suffix_);
  else:
    nccircle_(@#)(n)(patharray_suffix_);
  fi;
enddef;

% |n| is either an object (if numeric) or a point (if it is a pair)
vardef nccircle_(suffix $)(suffix n)(suffix p)=
  if str $<>"":
    if unknown $p.n_:
      addPathVariables$(p); 
    fi;
  fi;
  settodefaultifnotknown_("angleA")(numeric)(0);
  settodefaultifnotknown_("linewidth")(numeric)(curve_linewidth_default);
  settodefaultifnotknown_("nodesepA")(numeric)(0);
  settodefaultifnotknown_("nodesepB")(numeric)(0);
  if str $ <>"":
    $p.n_:=$p.n_+1;
    $p._draw_[$p.n_]:=LocalOptionValue("cdraw","cdraw_default");
    $p.name[$p.n_]:=LocalOptionValue("name","");
    $p._connect_[$p.n_]:="nccircle";
    $p.arrows[$p.n_]:=CLOV_("arrows");
    $p.visible[$p.n_]:=CLOV_("visible");
    $p.pathfilled[$p.n_]:=false;
    $p.pathfillcolor[$p.n_]:=black;
    $p.angleA[$p.n_]:=o_angleA_val;
    $p.angleB[$p.n_]:=o_angleB_val;
    $p.linewidth[$p.n_]:=o_linewidth_val;
    $p.nodesepA[$p.n_]:=o_nodesepA_val;
    $p.nodesepB[$p.n_]:=o_nodesepB_val;
    nc_inc_$(p);
  fi;
  
  % we have to find one additional point; we must be careful
  % not to use assignments, because |n.c| may be floating:
  save ap;pair ap;
  if numeric n:
    ap=n.c+2cm*dir(90+o_angleA_val); % 2cm should be a parameter
  else:
    ap=n+2cm*dir(90+o_angleA_val);   % 2cm should be a parameter
  fi;
  nc_core_$(n)(p)
    (n.c{dir(o_angleA_val)}..ap..n.c
      cutbefore BpathObj(n) cutafter BpathObj(n))
    (n{dir(o_angleA_val)}..ap..n);
enddef;

% variant for matrices:
vardef mccircle@#(expr ai,aj) text options=
  nccircle@#(matpos(@#)((ai,aj))) options;
enddef;

%====================================================================
% Labels

% Labels are pictures. We use an internal array |ipic_| in order
% to store the labels that are not the standard labels (such
% as the contents of a circle, etc.)

% This should be common to all labels
def objlabel_(suffix $)(expr p) text options =
  ExecuteOptions($)(options);
  if unknown $ipic_1:
    ObjPictureArray(ipic_)(0);
    ObjPointArray(ipic_.off_)(0);
    ObjTransformArray(ipic_.transf_)(0);
    ObjColorArray(ipic_.col_)(0);
    ObjBooleanArray(ipic_.erase_)(0);
  fi;
  $ipic_.n_:=$ipic_.n_+1;
  % we give default values to the options, in case they don't have any
  settodefaultifnotknown_("labrotate")(numeric)(0);
  settodefaultifnotknown_("labpos")(numeric)(0.5);
  settodefaultifnotknown_("labcolor")(color)(black);
  settodefaultifnotknown_("labpoint")(string)("ic");
  settodefaultifnotknown_("laberase")(boolean)(false);
  % picture:
  $ipic_[$ipic_.n_]=p;
  $ipic_[$ipic_.n_]:=$ipic_[$ipic_.n_]
    shifted -.5[urcorner(p),llcorner(p)] rotated o_labrotate_val;
  % transformation
  $ipic_.transf_.n_:=$ipic_.transf_.n_+1;
  $ipic_.transf_[$ipic_.transf_.n_]=identity;
  % we also store the color:
  $ipic_.col_.n_:=$ipic_.col_.n_+1;
  $ipic_.col_[$ipic_.col_.n_]=o_labcolor_val;
  $ipic_.erase_.n_:=$ipic_.erase_.n_+1;
  $ipic_.erase_[$ipic_.erase_.n_]=o_laberase_val;
enddef;

% This is used in |ObjLabel|
% the shift uses values defined in |plain.mp|
%  (labeloffset, laboff, etc.); see the code for |thelabel|.
def labshift_(suffix $)=
  (2 % 2 instead of 1 in the original code
    *labeloffset*laboff.sc_(o_labdir_val)
   -
   (labxf.sc_(o_labdir_val)*(lrcorner $ipic_[$ipic_.off_.n_])
      + labyf.sc_(o_labdir_val)*(ulcorner $ipic_[$ipic_.off_.n_])
      + (1-labxf.sc_(o_labdir_val)-labyf.sc_(o_labdir_val))
         *(llcorner $ipic_[$ipic_.off_.n_])
        )
  )
enddef;

% variant for curve labels:
def clabshift_=
  (2 % 2 instead of 1 in the original code
    *labeloffset*laboff.sc_(o_labdir_val)
   -
   (labxf.sc_(o_labdir_val)*(lrcorner o_labpic_val)
      + labyf.sc_(o_labdir_val)*(ulcorner o_labpic_val)
      + (1-labxf.sc_(o_labdir_val)-labyf.sc_(o_labdir_val))
         *(llcorner o_labpic_val)
        )
  )
enddef;

% not used
def opposite_(expr c)=
  if c="n": "s"
  elseif c="s": "n"
  elseif c="e": "w"
  elseif c="w": "e"
  elseif c="ne": "sw"
  elseif c="nw": "se"
  elseif c="sw": "ne"
  else: "nw"
  fi
enddef;

%
def cardtodir_(expr c)=
  if     c="n":  "top"
  elseif c="s":  "bot"
  elseif c="e":  "rt"
  elseif c="w":  "lft"
  elseif c="ne": "urt"
  elseif c="nw": "ulft"
  elseif c="sw": "llft"
  else:          "lrt"
  fi
enddef;

% This adds the picture |p| on point |a| of object |@#|.
% Two options are recognized: |labshift| and |labrotate|.
vardef ObjLabel@#(expr p) text options =
  objlabel_(@#)(p) options;
  % offset:
  addPointToPointArray@#(ipic_.off_);
  save tmpoff;pair tmpoff;
  if unknown o_labpathname_val and unknown o_labpathid_val:
    if unknown o_labcard_val:
      settodefaultifnotknown_("labshift")(pair)((0,0));
      tmpoff=@#sc_(o_labpoint_val)+o_labshift_val;
    else:
      % The |labcard| option is handled like the |labdir| option,
      % but from the |labcard| point of the object. For instance,
      % |labcard(s)| will be handled like a |labdir(bot)| on point |s|
      % of the object. We use |cardtodir_| to transform a cardinal point
      % into a direction.
      settodefaultifnotknown_("labdir")(string)(cardtodir_(o_labcard_val));
      tmpoff=@#sc_(o_labcard_val);
    fi;
  else:
    settodefaultifnotknown_("labshift")(pair)((0,0)); % added June 1, 2004
    tmpoff=objpathlabel_(@#)+@#c+o_labshift_val; % o_labshift_val added June 1, 2004
                                                 % and @#c on May 1, 2006
    if known o_labangle_val:
      @#ipic_[@#ipic_.n_]:=@#ipic_[@#ipic_.n_] rotated o_labangle_val;
    fi;
  fi;
  if known o_labdir_val:
    @#ipic_.off_[@#ipic_.off_.n_]=tmpoff+labshift_(@#)*CLOV_("labdist");
  else:
    @#ipic_.off_[@#ipic_.off_.n_]=tmpoff;
  fi;
enddef;

% This function places a label at a place
% that is the value of the expression |t|.
vardef ObjComputedLabel@#(expr p)(text t) text options =
  objlabel_(@#)(p) options;
  % offset:
  addPointToPointArray@#(ipic_.off_);
  @#ipic_.off_[@#ipic_.off_.n_]=t;
enddef;

% |pathid| is a path index in the standard or user path arrays.
% We distinguish the two cases with the sign of |pathid|.
% The |labpos| option will be the parameter of the path.
vardef objpathlabel_(suffix $)=
  save pathn,tmpoff;numeric pathn;pair tmpoff;
  hide(
  if known o_labpathid_val: pathn=o_labpathid_val;
  else:
    % we search in the path arrays for a path of that name;
    % this will give us its index:
    forsuffixes $$=_upath_,_spath_:
      if known $.$$n_:
        for i:=1 upto $.$$n_:
          if $.$$name[i]=o_labpathname_val:
            if str $$="_upath_":
              pathn=-i;
            else:
              pathn=i;
            fi;
          fi;
          exitif $.$$name[i]=o_labpathname_val;
        endfor;
      fi;
    endfor;
  fi;  
  save untied;boolean untied;untied=true;
  if known $c:untied:=false;
    save obj_pos;pair obj_pos;
    obj_pos=$c;
    untieObj($);
  fi;
  % we temporarily retie the object to the origin if necessary
  % (before Oct. 3, 2006, this was only done when the object
  %  was not tied, but it produced wrong results when
  %  the center of the object was not the origin)
  $c=origin;
  if pathn>0:
    tmpoff=point (o_labpos_val*length(Path$(_spath_,pathn)))
                 of Path$(_spath_,pathn);
    if known o_labangle_val: 
      o_labangle_val:=o_labangle_val
          +angle(direction (o_labpos_val*length(Path$(_spath_,pathn)))
                           of Path$(_spath_,pathn));
    fi;      
  else:
    tmpoff=point (o_labpos_val*length(Path$(_upath_,-pathn)))
                 of Path$(_upath_,-pathn);
    if known o_labangle_val: 
      o_labangle_val:=o_labangle_val
          +angle(direction (o_labpos_val*length(Path$(_upath_,-pathn)))
                           of Path$(_upath_,-pathn));
    fi;     
  fi;
  % if the object was initially untied, we untie it
  if untied:untieObj($);
  else: % retie it correctly:
    untieObj($);
    $c=obj_pos;
  fi;
  ) tmpoff
enddef;

% Draw the non-standard labels of object |@#|:
vardef drawLabels@#=
  if known @#ipic_.n_:
    for i:=1 upto @#ipic_.n_:
      if @#ipic_.erase_[i]:
        unfill bbox(@#ipic_[i] transformed @#ipic_.transf_[i]
                               shifted @#ipic_.off_[i]);
      fi;      
      draw @#ipic_[i] transformed @#ipic_.transf_[i] shifted @#ipic_.off_[i]
           withcolor @#ipic_.col_[i];
    endfor;
  fi;
enddef;

%====================================================================
% Line styles

% This is adapted from the definition of |double| in |feynmp.mp|:
def draw_double(expr p)(expr sep)(expr lwidth) text s =
  save oldpen;
  pen oldpen;
  oldpen := currentpen;
  pickup pencircle scaled (2lwidth+sep);
  % we use |cutdraw|, otherwise the ends are closed because
  % |undraw| will only remove some inner part
  cutdraw(p) s;
  pickup pencircle scaled sep;
  undraw p;
  pickup oldpen;
enddef;

def drawarrow_double(expr p)(expr sep)(expr lwidth) text s =
  save oldpen;
  pen oldpen;
  oldpen := currentpen;
  pickup pencircle scaled (2lwidth+sep); 
  drawarrow(p) s;
  pickup pencircle scaled sep;
  undraw p;
  pickup oldpen;
enddef;

def rdrawarrow_double(expr p)(expr sep)(expr lwidth) text s =
  drawarrow_double(reverse p)(sep)(lwidth) s;
enddef;

%====================================================================
% Trees

% A tree can be thought of as a root and a (possibly empty) list of subtrees.
% One could think of creating an object for the root and putting
% subobjects for all subtrees. However, doing so is not a good thing,
% because one has at the same place the shape of the root and
% the links to subtrees. So, if one wants to change the shape of
% the root (and possibly other nodes), one has either
%  - to make a copy of the function defining the object
%      and to change the shape (points, equations, paths), or
%  - to make a copy of another function defining the desired shape
%      and add what is relevant to subtrees
% But, there is a better way: one can define a generic ``tree node''
% object, having not only the usual subtrees as its subobjects,
% but also the root. Then, changing the shape of the root becomes
% independent of the rest of tree (assuming the interface conventions
% are respected, of course). The tree node object can even be
% parameterized more, for instance by a function deciding the layout
% of the subtrees (packed or not, considering only the bounding box,
% or looking inside, etc.)

% Tree: Generic Trees
% |@#| is a name for an object (must be a suffix)
% |@#| will be the number of the object, but will also be used
% as a prefix for other variables.
vardef newTree@#(suffix theroot)(text subtrees) text options=
  ExecuteOptions(@#)(options);
  assignObj(@#,"Tree");
  StandardInterface;
  save n,eq;numeric n;string eq;
  n=0;
  forsuffixes $:=subtrees:n:=n+1;endfor;
  ObjNumeric nst;
  setNumeric(nst)(n);
  % The |_spath_| variables are for connections
  % between the root and the subtrees
  addPathVariables@#(_spath_);
  SubObject(subt,obj(newobjstring_));
  if Option@#("treemode","L"):
    % We put the subtrees in an |VBox| object
    % and we use this non-documented construction to pass an option,
    % because we can't pass the option the usual way, at least not simply:
    begingroup;
      o_flip(OptionValue@#("treeflip"));
      o_align(OptionValue@#("Lalign"));
      o_vbsep(OptionValue@#("vbsep"));
      o_elementsize(OptionValue@#("treenodevsize"));
      newVBox.obj(@#subt)(subtrees);
    endgroup;
  elseif Option@#("treemode","R"):
    % We put the subtrees in an |VBox| object:
    begingroup; 
      o_flip(OptionValue@#("treeflip"));
      o_align(OptionValue@#("Ralign"));
      o_vbsep(OptionValue@#("vbsep"));
      o_elementsize(OptionValue@#("treenodevsize"));
      newVBox.obj(@#subt)(subtrees);
    endgroup;
  elseif Option@#("treemode","U"):
    % We put the subtrees in an |HBox| object:
    begingroup; 
      o_flip(OptionValue@#("treeflip"));
      o_align(OptionValue@#("Ualign"));
      o_hbsep(OptionValue@#("hbsep"));
      o_elementsize(OptionValue@#("treenodehsize"));
      newHBox.obj(@#subt)(subtrees);
    endgroup;
  else: % default case
    % We put the subtrees in an |HBox| object:
    begingroup; 
      o_flip(OptionValue@#("treeflip"));
      o_align(OptionValue@#("Dalign"));
      o_hbsep(OptionValue@#("hbsep"));
      o_elementsize(OptionValue@#("treenodehsize"));
      newHBox.obj(@#subt)(subtrees);
    endgroup;
  fi;

  % The root is also a subobject:
  SubObject(root,theroot);
  % we now build the equations:
  % CURRENTLY, WE ASSUME THAT THE SUBTREES ARE LARGER THAN THE ROOT,
  % BUT IT SHOULD BE MADE MORE GENERAL
  %  (right now, nothing here depends on the width of the root)
  %  (the tree can still be built, but it can happen that the root
  %   protrudes)
  % 1 horizontal equation: the root is in the middle of the tree
  % |xpart(root.c)=xpart(subt.c)|
  % 2 horizontal equation: horizontal space at the edges
  % |xpart(subt.w-@#w)=xpart(@#e-subt.e)=0mm;|
  % 3 vertical equation: vertical distance between root and subtrees
  % |ypart(root.s-subt.n)=1cm;|
  % 4 vertical equation: vertical space at the top
  % |ypart(@#n-root.n)=0mm;|
  % 5 vertical equation: vertical space at the bottom
  % |ypart(subt.s-@#s)=0mm;|
  if Option@#("treemode","L") or Option@#("treemode","R"):
    % 1: |ypart(root.c)=ypart(subt.c)|
    eq:="ypart(obj(@#root).c)=ypart(obj(@#subt).c);";
    % 2: |ypart(subt.s-@#s)=ypart(@#n-subt.n)=5mm;|
    eq:=eq & "ypart(obj(@#subt).s-@#s)=ypart(@#n-obj(@#subt).n)=" &
                               decimal (OptionValue@#("dy")) & ";";
    if Option@#("treemode","L"):
      % 3: |xpart(root.w-subt.e)=1cm;|
      if OptionValue@#("treenodehsize")>0:
        eq:=eq & "xpart(obj(@#root).e-obj(@#subt).e)=" &
          decimal
            (OptionValue@#("hsep")+OptionValue@#("treenodehsize")) & ";";
      else:
        eq:=eq & "xpart(obj(@#root).w-obj(@#subt).e)=" &
             decimal (OptionValue@#("hsep")) & ";";
      fi;
      % 4: |xpart(@#e-root.e)=0mm;|
      eq:=eq & "xpart(@#e-obj(@#root).e)=" &
                               decimal (OptionValue@#("dx")) & ";"; 
      % 5: |xpart(subt.w-@#w)=0mm;|
      eq:=eq & "xpart(obj(@#subt).w-@#w)=" &
                               decimal (OptionValue@#("dx")) & ";";
    else: % R
      % 3: |xpart(subt.w-root.e)=1cm;|
      if OptionValue@#("treenodehsize")>0:
        eq:=eq & "xpart(obj(@#subt).w-obj(@#root).w)=" &
          decimal
            (OptionValue@#("hsep")+OptionValue@#("treenodehsize")) & ";";
      else:
        eq:=eq & "xpart(obj(@#subt).w-obj(@#root).e)=" &
             decimal (OptionValue@#("hsep")) & ";";
      fi;
      % 4: |xpart(root.w-@#w)=0mm;|
      eq:=eq & "xpart(obj(@#root).w-@#w)=" &
                               decimal (OptionValue@#("dx")) & ";"; 
      % 5: |xpart(@#e-subt.e)=0mm;|
      eq:=eq & "xpart(@#e-obj(@#subt).e)=" &
                               decimal (OptionValue@#("dx")) & ";"; 
    fi;
  else: % includes default case
    % 1: |xpart(root.c)=xpart(subt.c)|
    eq:="xpart(obj(@#root).c)=xpart(obj(@#subt).c);";
    % 2: |xpart(subt.w-@#w)=xpart(@#e-subt.e)=5mm;|
    eq:=eq & "xpart(obj(@#subt).w-@#w)=xpart(@#e-obj(@#subt).e)=" &
                               decimal (OptionValue@#("dx")) & ";";
    if Option@#("treemode","U"):
      % 3: |ypart(subt.s-root.n)=1cm;|
      if OptionValue@#("treenodevsize")>0:
        eq:=eq & "ypart(obj(@#subt).s-obj(@#root).s)=" &
          decimal
            (OptionValue@#("vsep")+OptionValue@#("treenodevsize")) & ";";
      else:
        eq:=eq & "ypart(obj(@#subt).s-obj(@#root).n)=" &
                  decimal (OptionValue@#("vsep")) & ";";
      fi;
      % 4: |ypart(root.s-@#s)=0mm;|
      eq:=eq & "ypart(obj(@#root).s-@#s)=" &
                               decimal (OptionValue@#("dy")) & ";"; 
      % 5: |ypart(@#n-subt.n)=0mm;|
      eq:=eq & "ypart(@#n-obj(@#subt).n)=" &
                               decimal (OptionValue@#("dy")) & ";"; 
    else: % default case
      % 3: |ypart(root.s-subt.n)=1cm;|
      if OptionValue@#("treenodevsize")>0:
        eq:=eq & "ypart(obj(@#root).n-obj(@#subt).n)=" &
          decimal
            (OptionValue@#("vsep")+OptionValue@#("treenodevsize")) & ";";
      else:
        eq:=eq & "ypart(obj(@#root).s-obj(@#subt).n)=" &
                  decimal (OptionValue@#("vsep")) & ";";
      fi;
      % 4: |ypart(@#n-root.n)=0mm;|
      eq:=eq & "ypart(@#n-obj(@#root).n)=" &
                               decimal (OptionValue@#("dy")) & ";"; 
      % 5: |ypart(subt.s-@#s)=0mm;|
      eq:=eq & "ypart(obj(@#subt).s-@#s)=" &
                               decimal (OptionValue@#("dy")) & ";"; 

    fi;
  fi;  

  ObjCode StandardEquations,eq;
%    |"xpart(@#n)=xpart(@#s);ypart(@#ne)=ypart(@#nw);";|
  StandardTies;
 
  if OptionValue@#("hideleaves"):
    hideTreeLeaves(@#);
  fi;

  memorizeConnections_@#(true);
enddef;

% |t| is the tree, |n| is the child number, |par| is the parameter
% |val| is the new value
def setTreeEdge(suffix t)(expr n)(suffix par)(expr val)=
  t._spath_.par[n]:=val;
enddef;

% This function memorizes the connections between the root and the
% subtrees; it is also used when a subtree is replaced by another one,
% or when the number of subtrees changes.
% The value of |fromoptions| determines
% whether we take the connection information
% from the options, or from a memorized structure
vardef memorizeConnections_@#(expr fromoptions)=
  % we memorize the connection paths:
  for i:=1 upto @#nst:
    % only connections to non empty boxes
    if not isEmptyBox(obj(obj(@#subt).sb[i])): 
      if not(isHFan(Obj(TreeRootObj_(obj(obj(@#subt).sb[i]))))) and
        not(isVFan(Obj(TreeRootObj_(obj(obj(@#subt).sb[i]))))):
        % the next call will inherit the options of |Tree| that are
        % relevant to the |edge| argument, such as |cdraw|:
        if OptionValue@#("edge")<>"none":
          if fromoptions:
            sc_(connectionCommand_@#(i,true));
          else:
            % we use the |pp| variable which is defined in
            % |replaceTreeElement.expl|:
            sc_(connectionCommand_@#(i,false));
          fi;
        fi;
      else:
        ncfan@#(obj(@#root))(Obj(TreeRootObj_(obj(obj(@#subt).sb[i]))))(i);
      fi;
    fi;
  endfor;
enddef;

% |n| is the fan object and |i| is the rank in the subtrees
vardef fanconnection_@#(suffix root,n,a,b)(expr i)=
  if OptionValue.n("pointedfan"):
    addPath@#(_spath_,i,
      smoothen(((.5[n.a,n.b]--root.ic) intersectionpoint BpathObj(root))
        --n.a--.5[n.a,n.b],
        OptionValue.n("fanlinearc"))
      & smoothen(.5[n.a,n.b]--n.b--
        ((.5[n.a,n.b]--root.ic) intersectionpoint BpathObj(root)),
        OptionValue.n("fanlinearc")));
  else:
    addPath@#(_spath_,i,
        smoothen(((n.a--root.ic) intersectionpoint BpathObj(root))--n.a
                  --.5[n.a,n.b],
          OptionValue.n("fanlinearc"))
      & smoothen(.5[n.a,n.b]--n.b--
                  ((n.b--root.ic) intersectionpoint BpathObj(root)),
          OptionValue.n("fanlinearc")));
  fi;
  @#_spath_.n_:=@#_spath_.n_+1;
  % the value |"fandraw"| allows us to detect that the memorized path
  % corresponds to a fan
  @#_spath_.arrows[@#_spath_.n_]:="fandraw"; 
enddef;


vardef ncfan@#(suffix n)(suffix m)(expr i)=
  if isHFan(m):
    fanconnection_@#(n,m,ie,iw)(i);
  elseif isVFan(m):
    fanconnection_@#(n,m,in,is)(i);
  fi;    
enddef;
  
% temporary
def fandraw = draw enddef;

% This function builds a complex connection command from options.
% The result is a string.
vardef connectionCommand_@#(expr i,fromoptions)=
  save cmd;string cmd;
  hide(
    if fromoptions:
      cmd=OptionValue@#("edge");
    else:
      cmd=pp._connect_[i];
    fi;
    cmd:=cmd & "." & str @# & "(obj(" &
        str @# & ".root))(Obj(TreeRootObj_(obj(obj(" & str @# & ".subt).sb[" &
            decimal i & "]))))" &
         " " & quote("patharray(_spath_)")
    optionCase_("angleA",i,fromoptions)(decimal)(@#)
    optionCase_("angleB",i,fromoptions)(decimal)(@#)
    optionCase_("arcangleA",i,fromoptions)(decimal)(@#)
    optionCase_("arcangleB",i,fromoptions)(decimal)(@#)
    optionCase_("linewidth",i,fromoptions)(decimal)(@#)
    optionCase_("nodesepA",i,fromoptions)(decimal)(@#)
    optionCase_("nodesepB",i,fromoptions)(decimal)(@#)
    optionCase_("loopsize",i,fromoptions)(decimal)(@#)
    optionCase_("boxsize",i,fromoptions)(decimal)(@#)
    optionCase_("boxheight",i,fromoptions)(decimal)(@#)
    optionCase_("boxdepth",i,fromoptions)(decimal)(@#)
    optionCase_("visible",i,fromoptions)(booleantostring)(@#)
    optionCase_("pathfilled",i,fromoptions)(booleantostring)(@#)
    optionCase_("pathfillcolor",i,fromoptions)(colortostring)(@#)
    optionCase_("linearc",i,fromoptions)(decimal)(@#)
    optionCase_("linetensionA",i,fromoptions)(decimal)(@#)
    optionCase_("linetensionB",i,fromoptions)(decimal)(@#)
    optionCase_("coilarmA",i,fromoptions)(decimal)(@#)
    optionCase_("coilarmB",i,fromoptions)(decimal)(@#)
    optionCase_("coilheight",i,fromoptions)(decimal)(@#)
    optionCase_("coilwidth",i,fromoptions)(decimal)(@#)
    optionCase_("coilaspect",i,fromoptions)(decimal)(@#)
    optionCase_("coilinc",i,fromoptions)(decimal)(@#)
    optionCase_("posA",i,fromoptions)()(@#)
    optionCase_("posB",i,fromoptions)()(@#)
    optionCase_("armA",i,fromoptions)(decimal)(@#)
    optionCase_("armB",i,fromoptions)(decimal)(@#)
    optionCase_("offsetA",i,fromoptions)(pairtostring)(@#)
    optionCase_("offsetB",i,fromoptions)(pairtostring)(@#)
    optionCase_("name",i,fromoptions)()(@#)
    optionCase_("linecolor",i,fromoptions)(colortostring)(@#)
    optionCase_("border",i,fromoptions)(decimal)(@#)
    optionCase_("bordercolor",i,fromoptions)(colortostring)(@#)
    optionCase_("linestyle",i,fromoptions)()(@#)
    optionCase_("doubleline",i,fromoptions)(booleantostring)(@#)
    optionCase_("doublesep",i,fromoptions)(decimal)(@#)
    optionCase_("arrows",i,fromoptions)()(@#);
    )
  cmd
enddef;

def pairtostring(expr p)=
  "(" & decimal (xpart(p)) & "," & decimal(ypart(p)) & ")"
enddef;

def booleantostring(expr b)=
  if b:"true" else: "false" fi
enddef;

def colortostring(expr p)=
  "(" & decimal(redpart(p)) & "," & decimal(greenpart(p)) & "," &
        decimal(bluepart(p)) & ")"
enddef;

def optionCase_(expr opname,i,fromoptions)(text type)(suffix $)=
  if fromoptions:
        if expandafter known sc_("o_" & opname & "_val"):
          & "," & quote(opname &"(" & type (OptionValue$(opname)) & ")")
        fi
    else:
        if known pp.sc_(opname)[i]:
          & "," & quote(opname & "(" & type (pp.sc_(opname)[i]) & ")")
        fi
    fi
enddef;

streamline("Tree")("(expr theroot)(text subtrees)",
                   "suffixpar(theroot)suffixlist(subtrees)");

% useful shortcuts:
def  T =newTree enddef;
def _T =new_Tree enddef;
def  T_=new_Tree_ enddef;
                 
def BpathTree(suffix n)= StandardBpath(n) enddef;

% This returns the internal number of the root object
% In order to get the appropriate suffix, one should apply |Obj|
% to the result.
def TreeRootObj_(suffix sb)=
  (if isBB(sb): TreeRootObj_(obj(sb.sub))
   elseif isTree(sb): TreeRootObj_(obj(sb.root))
   else: sb
   fi
  )
enddef;

% CHOOSE A BETTER NAME
% This returns the center of the root object
def TreeRoot_(suffix sb)=
  Obj(TreeRootObj_(sb)).ic
enddef;

% This returns the bounding path of the root object
def TreeRootPath_(suffix sb)=
  BpathObj(Obj(TreeRootObj_(sb)))
enddef;

vardef drawTree(suffix n)=
  save fanchildren;
  boolean fanchildren;
  fanchildren=false;
  drawFramedOrFilledObject_(n);
%  pickup pencircle scaled 2pt;
%  draw n.nw--n.ne--n.se--n.sw--cycle withcolor red;
%  pickup pencircle scaled .4pt;
  drawMemorizedPaths_(n);
  drawObj(obj(n.subt));
  % and draw connections (this should be parameterized too)
  for i:=1 upto n.nst:
    % only connections to non empty boxes:
    if not isEmptyBox(obj(obj(n.subt).sb[i])): 
      if isHFan(Obj(TreeRootObj_(obj(obj(n.subt).sb[i])))) or
	  isVFan(Obj(TreeRootObj_(obj(obj(n.subt).sb[i])))):
	fanchildren:=true;
        drawfan_(n,Obj(TreeRootObj_(obj(obj(n.subt).sb[i]))))(i,false);
      else:
        % drawn by |drawMemorizedPaths_|
      fi;
    fi;
  endfor;
  % |unfill| is necessary to cut points of fans
  if fanchildren:
    unfill BpathObj(obj(n.root));
  fi;
  drawObj(obj(n.root));
enddef;

setObjectDefaultOption("Tree")("treemode")("D"); % default is top-down
setObjectDefaultOption("Tree")("treeflip")(false);
setObjectDefaultOption("Tree")("treenodehsize")(-1pt); % like PSTricks
setObjectDefaultOption("Tree")("treenodevsize")(-1pt); % like PSTricks
setObjectDefaultOption("Tree")("dx")(0mm); % left/right margins
setObjectDefaultOption("Tree")("dy")(0mm); % top/down margins
% internal horizontal separation between root and subtrees
setObjectDefaultOption("Tree")("hsep")(1cm);
% internal vertical separation between root and subtrees
setObjectDefaultOption("Tree")("vsep")(1cm);
% the next two options are passed to |newHBox| or |newVBox|
% and concern the separation between subtrees:
setObjectDefaultOption("Tree")("hbsep")(1cm);
setObjectDefaultOption("Tree")("vbsep")(1cm);
setObjectDefaultOption("Tree")("hideleaves")(false); % leaves are in the bb
setObjectDefaultOption("Tree")("edge")("ncline");
% we don't have a default for |cdraw|, which means |ncline|, |ncangle|, ...'s
% default will be used
setObjectDefaultOption("Tree")("framed")(false);
setObjectDefaultOption("Tree")("filled")(false);
setObjectDefaultOption("Tree")("fillcolor")(black);
setObjectDefaultOption("Tree")("framewidth")(.5bp);
setObjectDefaultOption("Tree")("framecolor")(black);
setObjectDefaultOption("Tree")("framestyle")("");
setObjectDefaultOption("Tree")("Dalign")("top");
setObjectDefaultOption("Tree")("Ualign")("bot");
setObjectDefaultOption("Tree")("Lalign")("right");
setObjectDefaultOption("Tree")("Ralign")("left");
setObjectDefaultOption("Tree")("shadow")(false); % no shadow by default
setObjectDefaultOption("Tree")("shadowcolor")(black);

% Declaration of a few arrays.
% This must be a |def| and not a |vardef|:
def declare_pp_variables_=
  save pp;
  string pp._draw_[],pp._connect_[],pp.posA[],pp.posB[],pp.name[],
       pp.linestyle[],pp.arrows[];
  numeric pp.angleA[],pp.angleB[],pp.arcangleA[],pp.arcangleB[],
        pp.linewidth[],pp.border[],pp.nodesepA[],pp.nodesepB[],
        pp.loopsize[],pp.boxsize[],pp.boxheight[],pp.boxdepth[],
        pp.linearc[],pp.linetensionA[],pp.linetensionB[],
        pp.armA[],pp.armB[],pp.doublesep[],
        pp.coilarmA[],pp.coilarmB[],pp.coilheight[],pp.coilwidth[],
        pp.coilaspect[],pp.coilinc[],
        pp.n_;
  boolean pp.visible[],pp.doubleline[],pp.pathfilled[];
  color pp.linecolor[],pp.bordercolor[],pp.pathfillcolor[];
  pair pp.offsetA[],pp.offsetB[];
enddef;

vardef resetPathArray@#(suffix $$)=
  % reset the user arrays:
  if known @#.$$n_:
    @#.$$n_:=0;
    forsuffixes $:=pathoptions_:
      @#.$$.$n_:=0;
    endfor;
    deletePaths@#($$);
  fi;
enddef;

% This function either replaces a subtree or adds a subtree at the end
% of the subtrees.
% This function always resets the tree.
vardef replaceTreeElement.expl@#(expr i)(suffix rep)=
  resetObj.expl@#;

  if isHBox(obj(@#subt)):
    replaceHBoxElement.expl.obj(@#subt)(i)(rep);
  else:
    replaceVBoxElement.expl.obj(@#subt)(i)(rep);
  fi;
  if i=@#nst+1:
    @#nst:=@#nst+1;
    % extend the path parameters
    % we use the same parameters as those for the last connection
    if OptionValue@#("edge")<>"none":
      @#_spath_.n_:=@#_spath_.n_+1;
      forsuffixes $:=pathoptions_:
        @#_spath_$[@#_spath_.n_]:=@#_spath_$[@#_spath_.n_-1];
      endfor;
    fi;
  fi;

  if OptionValue@#("edge")<>"none":
    % memorize the path parameters in a local array:
    declare_pp_variables_;
    pp.n_=@#_spath_.n_;
    for j:=1 upto pp.n_:
      forsuffixes $:=pathoptions_:
        pp$[j]=@#_spath_$[j];
      endfor;
    endfor;
  
    % reset the standard arrays:
    resetPathArray@#(_spath_);
  fi;    

  % reset the user arrays:
  resetPathArray@#(_upath_);
  
  resetObj.expl@#;

  % recreate the standard paths from the memorized information
  memorizeConnections_@#(false);
  
enddef;

% This function deletes a subtree.
% This function always resets the tree.
vardef deleteTreeElement.expl@#(expr i)=
  resetObj.expl@#;
  if isHBox(obj(@#subt)):
    deleteHBoxElement.expl.obj(@#subt)(i);
  else:
    deleteVBoxElement.expl.obj(@#subt)(i);
  fi;
  @#nst:=@#nst-1;

  if OptionValue@#("edge")<>"none":
    % memorize the path parameters in a local array:
    declare_pp_variables_;
    pp.n_=@#_spath_.n_-1;
    % first part (before the removed element)
    for j:=1 upto i-1:
      forsuffixes $:=pathoptions_:
        pp$[j]=@#_spath_$[j];
      endfor;
    endfor;
    
    % second part (after the removed element)
    for j:=i upto pp.n_:
      forsuffixes $:=pathoptions_:
        pp$[j]=@#_spath_$[j+1];
      endfor;
    endfor;
  
    % reset the standard arrays:
    resetPathArray@#(_spath_);
  fi;
  
  % reset the user arrays:
  resetPathArray@#(_upath_);

  resetObj.expl@#;

  % recreate the standard paths from the memorized information
  memorizeConnections_@#(false);
 
enddef;

% This function sets the bounding box of a tree to its root.
% It will be more general later.
def hideTreeLeaves(suffix $)=
  % we have merely to give the right shifts as parameters of
  % |rebindrelativeObj|:
  rebindrelativeObj($)(ypart(obj($root).n-$n),ypart(obj($root).s-$s),
                       xpart(obj($root).e-$e),xpart(obj($root).w-$w));
enddef;

% streamlined version
vardef hideTreeLeaves_(expr n)=
  % we have merely to give the correct shifts as parameters of
  % |rebindrelativeObj|:
  rebindrelative_Obj(obj(iname_[n]))
  (ypart(obj(obj(iname_[n]).root).n-obj(iname_[n]).n),
   ypart(obj(obj(iname_[n]).root).s-obj(iname_[n]).s),
   xpart(obj(obj(iname_[n]).root).e-obj(iname_[n]).e),
   xpart(obj(obj(iname_[n]).root).w-obj(iname_[n]).w)
  )
enddef;

%=====================================================================
% A fan is an object normally only used in trees. It is directly
% inspired of PSTricks' fans.
% This object is actually very similar to a HRazor or VRazor.
% It only behaves like a fan in a Tree context.

vardef newHFan@#(expr dx,dy) text options=
  ExecuteOptions(@#)(options);
  assignObj(@#,"HFan");
  StandardInterface;
  ObjCode StandardEquations,
          "@#ise-@#isw=(" & decimal dx & ",0)", 
          "@#ine-@#ise=(0," & decimal dy & ")"; 
enddef;

streamline("HFan")("(expr dx,dy)","(dx,dy)");

% won't be used
def BpathHFan(suffix n)=StandardBpath(n) enddef;

% This is not used, but the parent calls |drawfan_|
def drawHFan(suffix n)=
  % empty, because the fan is drawn by the parent
  %draw n.ise--n.isw;
  drawMemorizedPaths_(n);
enddef;

% |forceedge| is a boolean that can override the option value |"edge"|
def drawfan_(suffix n,fan)(expr i,forceedge)=
  if (OptionValue.fan("edge")="yes") or forceedge:
    if  OptionValue.fan("filled"):
      fill Path.n(_spath_,i)--cycle withcolor OptionValue.fan("fillcolor");
    else:
      if OptionValue.fan("fanlinestyle")<>"":
        draw Path.n(_spath_,i)
          scantokens(OptionValue.fan("fanlinestyle"))
          withcolor OptionValue.fan("fillcolor");
      else:
        draw Path.n(_spath_,i) withcolor OptionValue.fan("fillcolor");
      fi;
    fi;
  fi;
enddef;

vardef drawfan@#(suffix fan)(expr i)=
  drawfan_(@#,fan)(i,true);
enddef;

setObjectDefaultOption("HFan")("filled")(false);
setObjectDefaultOption("HFan")("edge")("yes");
setObjectDefaultOption("HFan")("pointedfan")(true);
setObjectDefaultOption("HFan")("fanlinestyle")("");
setObjectDefaultOption("HFan")("fanlinearc")(0);
setObjectDefaultOption("HFan")("fillcolor")(black);

%=====================================================================

vardef newVFan@#(expr dx,dy) text options=
  ExecuteOptions(@#)(options);
  assignObj(@#,"VFan");
  StandardInterface;
  ObjCode StandardEquations,
          "@#ise-@#isw=(" & decimal dx & ",0)",
          "@#ine-@#ise=(0," & decimal dy & ")"; 
enddef;

streamline("VFan")("(expr dx,dy)","(dx,dy)");

% won't be used
def BpathVFan(suffix n)=StandardBpath(n) enddef;

% This is not used, but the parent calls |drawfan_|
def drawVFan(suffix n)=
  % empty, because the fan is drawn by the parent
  %draw n.ine--n.ise;
  drawMemorizedPaths_(n);
enddef;

setObjectDefaultOption("VFan")("filled")(false);
setObjectDefaultOption("VFan")("edge")("yes");
setObjectDefaultOption("VFan")("pointedfan")(true);
setObjectDefaultOption("VFan")("fanlinestyle")("");
setObjectDefaultOption("VFan")("fanlinearc")(0);
setObjectDefaultOption("VFan")("fillcolor")(black);

%-------------------------------------------------------------------------

% PTree: Proof Trees
% |@#| is a name for an object (must be a suffix)
% |@#| will be the number of the object, but will also be used
% as a prefix for other variables.
% |left| and |right| are the rule names (they are pictures)
% |conclusion| is a picture too.
% Even though this object seems simple, its code is quite complex
% because we try to cover all special cases.
% However, we assume that there is at least either a conclusion
% or one subtree. Calling this function with no subtrees and
% no conclusion will produce an error.
vardef newPTree@#(expr conclusion)(text subtrees)(expr left,right)
                                     text options=
  ExecuteOptions(@#)(options);
  assignObj(@#,"PTree");
  % parameters that should be options:
  save vdist,rdistl,rdistr,dist_n,dist_s,dist_e,dist_w;
  % vertical distance between premisses and conclusion:
  vdist=OptionValue@#("vsep");  
  % rule distance left
  rdistl=OptionValue@#("lrsep");
  % rule distance right
  rdistr=OptionValue@#("rrsep"); 
  % distances around the proof:
  dist_n=dist_s=OptionValue@#("dy");
  dist_e=dist_w=OptionValue@#("dx");
  StandardInterface;
  ObjPoint ledge,redge, % a |PTree| has two additionnal points that
                        % are useful for a fine positionning of the
                        % horizontal line (actually, we could do without them,
                        % by analyzing the structure of the tree, but this
                        % is a first attempt)
           lstart,lend; % These are the points where the line starts and
                        % where it ends. These variables are not really
                        % necessary, but having them is convenient.
  save n,i,eq,spl,spr;numeric n,i,spl,spr;string eq;
  % we count the number of subtrees:   
  n=0;
  forsuffixes $:=subtrees:
    % we have to be careful because there is always at least one loop,
    % even if |subtrees| is empty (because an empty suffix is a valid suffix):
    if length(str $)>0:n:=n+1;fi;
  endfor;
  ObjNumeric nst;
  % the number of subtrees is stored in the object
  setNumeric(nst)(n);
  i=0;
  SubObject(subt,obj(newobjstring_));
  if not numeric conclusion:
    SubObject(conc,obj(newobjstring_));
  fi;
  if not numeric left:
    SubObject(lr,obj(newobjstring_));
  fi;
  if not numeric right:
    SubObject(rr,obj(newobjstring_));
  fi;
  % We put the subtrees in an HBox object except if there are no subtrees:
  if n>0:
    begingroup;
      % we define options passed to |newHBox|
      o_hbsep(OptionValue@#("hsep"));
      if Option@#("treemode","U"):
        o_align("top");
      else:
        o_align("bot");
      fi;
      newHBox.obj(@#subt)(subtrees);
    endgroup;
  else:
    newEmptyBox.obj(@#subt)(0,0);
  fi;
  %
  if string conclusion:if conclusion="": newEmptyBox.obj(@#conc)(0,0);
                       else:newBox.obj(@#conc)(conclusion) "framed(false)";fi;
  elseif picture conclusion:newBox.obj(@#conc)(conclusion) "framed(false)";
  else: % object
    SubObject(conc,Obj(conclusion));
  fi;
  if string left:if left="": newEmptyBox.obj(@#lr)(0,0);
                 else:newBox.obj(@#lr)(left) "framed(false)";fi;
  elseif picture left:newBox.obj(@#lr)(left) "framed(false)";
  else: % object
    SubObject(lr,Obj(left));
  fi;
  if string right:if right="": newEmptyBox.obj(@#rr)(0,0);
                  else:newBox.obj(@#rr)(right) "framed(false)";fi;
  elseif picture right:newBox.obj(@#rr)(right) "framed(false)";
  else: % object
    SubObject(rr,Obj(right));
  fi;
  % We now build the equations: here are the equations for a top-down tree
  %                              (the conclusion being under the subtrees)
  % 1 horizontal equation: the conclusion is in the middle
  %        of the last line of the subtree
  %   |xpart(conc.c)=xpart(.5[subt.ledge,subt.redge])|
  % 2 vertical equation: vertical distance between root and subtrees
  %   |ypart(subt.s-conc.n)=vdist;| % depends on option
  % 3 vertical equation: vertical space at the top
  %   |ypart(@#n-subt.n)=dist_n;|   % depends on option
  % 4 vertical equation: vertical space at the bottom
  %   |ypart(conc.s-@#s)=dist_s;|   % depends on option
  % 5 Edges:
  %   |@#ledge=conc.sw;@#redge=conc.se;| % depends on option
  % 6 Start and end of the line:
  %   |ypart(@#lstart)=ypart(@#lend)=.5[ypart(subt.s),ypart(conc.n)]|
  %   |xpart(@#lstart)=min(xpart(subt.ledge),xpart(conc.w))|
  %   |xpart(@#lend)=max(xpart(subt.redge),xpart(conc.e))|
  % 7 horizontal space at right of subtree
  %   |max(xpart(@#lend)+wd(@#rr)+rdistr-xpart(subt.e),0)|
  % 8 horizontal space at left of subtree
  %   |min(xpart(@#lstart)-wd(@#lr)-rdistl-xpart(subt.w),0)|
  % 9 Attachment of the rules:
  %   |@#lstart-(rdistl,0)=@#lr.e|
  %   |@#lend=@#rr.w-(rdistr,0)|
  %
  % Left and right edges of the subtree are actually not defined,
  % because it is an |HBox|. But even the components of the |HBox|
  % may lack these features if we are at the top of the proof tree.
  % So, what we do is that we compute the positions of the edges
  % with respect to the |.s| point of the subtree.
  save subledge,subredge;pair subledge,subredge;
  if not isEmptyBox(obj(@#subt)):
    if isPTree(obj(obj(@#subt).sb[1])):
      subledge=obj(obj(@#subt).sb[1]).ledge-obj(@#subt).s;
    else:
      subledge=obj(obj(@#subt).sb[1]).sw-obj(@#subt).s;
    fi;
    if isPTree(obj(obj(@#subt).sb[@#nst])):
      subredge=obj(obj(@#subt).sb[@#nst]).redge-obj(@#subt).s;
    else:
      subredge=obj(obj(@#subt).sb[@#nst]).se-obj(@#subt).s;
    fi;
  else: % if the subtree is empty, we use the edges of the conclusion
    % with respect to the |.n| point of the conclusion
    subledge=obj(@#conc).nw-obj(@#conc).n;
    subredge=obj(@#conc).ne-obj(@#conc).n;
    % see below how it is used when there are no subtrees
  fi;
  eq:="";
  % 1   |xpart(conc.c)=xpart(.5[subt.ledge,subt.redge])|
  %                  |=xpart(.5[subt.s+subledge,subt.s+subredge])|
  %          |=.5(xpart(subt.s)+xpart(subledge),xpart(subt.s)+xpart(subredge))|
  %  (if for some reason conc.ledge and conc.redge exist, we replace
  %    conc.c by .5[conc.ledge,conc.redge])
  if (not isEmptyBox(obj(@#subt))) and (not isEmptyBox(obj(@#conc))):
    eq:=eq & "xpart(";
    if pair obj(@#conc).ledge and pair obj(@#conc).redge:
      eq:=eq & ".5[obj(@#conc).ledge,obj(@#conc).redge]";
    else:
      eq:=eq & "obj(@#conc).c";
    fi;
    eq:=eq & ")=.5[xpart(obj(@#subt).s)" & (signeddecimal xpart(subledge)) &
            ",xpart(obj(@#subt).s)" & (signeddecimal xpart(subredge)) & "];";
  fi;
  % 2 |ypart(subt.s-conc.n)=vdist;| % depends on options
  if (not isEmptyBox(obj(@#subt))) and (not isEmptyBox(obj(@#conc))):
    if Option@#("treemode","U"):
      eq:=eq & "ypart(obj(@#conc).s-obj(@#subt).n)=" & decimal vdist & ";";
    else:
      eq:=eq & "ypart(obj(@#subt).s-obj(@#conc).n)=" & decimal vdist & ";";
    fi;    
  fi;
  % 3 |ypart(@#n-subt.n)=dist_n;|  % depends on option
  if Option@#("treemode","U"):
    if (not isEmptyBox(obj(@#conc))):
      eq:=eq & "ypart(@#n-obj(@#conc).n)=" & decimal dist_n & ";";
    else:
      eq:=eq & "ypart(@#n-obj(@#subt).n)=" & decimal (vdist/2) & ";";
    fi;
  else:
    if (not isEmptyBox(obj(@#subt))):
      eq:=eq & "ypart(@#n-obj(@#subt).n)=" & decimal dist_n & ";";
    else:
      eq:=eq & "ypart(@#n-obj(@#conc).n)=" & decimal (vdist/2) & ";";
    fi;
  fi;
  % 4 |ypart(conc.s-@#s)=dist_s;|  % depends on option
  if Option@#("treemode","U"):
    if (not isEmptyBox(obj(@#subt))):
      eq:=eq & "ypart(obj(@#subt).s-@#s)=" & decimal dist_s & ";";
    else:
      eq:=eq & "ypart(obj(@#conc).s-@#s)=" & decimal (vdist/2) & ";";
    fi;
  else:
    if (not isEmptyBox(obj(@#conc))):
      eq:=eq & "ypart(obj(@#conc).s-@#s)=" & decimal dist_s & ";";
    else:
      eq:=eq & "ypart(obj(@#subt).s-@#s)=" & decimal (vdist/2) & ";";
    fi;
  fi;
  % 5 |@#ledge=conc.sw;@#redge=conc.se;| % depends on option
  if (not isEmptyBox(obj(@#conc))):
    if Option@#("treemode","U"):
      eq:=eq & "@#ledge=obj(@#conc).nw;@#redge=obj(@#conc).ne;";
    else:
      eq:=eq & "@#ledge=obj(@#conc).sw;@#redge=obj(@#conc).se;";
    fi;
  else:
    % |@#ledge=@#lstart; @#redge=@#lend;|
    eq:=eq & "@#ledge=@#lstart;@#redge=@#lend;";
  fi;
  % 6 Start and end of the line:
  %   |ypart(@#lstart)=ypart(@#lend)=ypart(conc.n)+vdist/2|
  % |if xpart(subt.redge)-xpart(subt.ledge) > xpart(conc.e)-xpart(conc.w):|
  %   |xpart(@#lstart)=xpart(subt.ledge)|
  %   |xpart(@#lend)=xpart(subt.redge)|
  % |else:|
  % |  xpart(@#lstart)=xpart(conc.w)|
  % |  xpart(@#lend)=xpart(conc.e)|
  % |fi|
  if Option@#("treemode","U"):
    if not isEmptyBox(obj(@#conc)):
      eq:=eq & "ypart(@#lstart)=ypart(@#lend)" &
                "=ypart(obj(@#conc).s)-" & decimal (vdist/2) & ";";
    else:
      eq:=eq & "ypart(@#lstart)=ypart(@#lend)" &
                "=ypart(obj(@#subt).n)+" & decimal (vdist/2) & ";";
    fi;
  else:
    if not isEmptyBox(obj(@#conc)):
      eq:=eq & "ypart(@#lstart)=ypart(@#lend)" &
                "=ypart(obj(@#conc).n)+" & decimal (vdist/2) & ";";
    else:
      eq:=eq & "ypart(@#lstart)=ypart(@#lend)" &
                "=ypart(obj(@#subt).s)-" & decimal (vdist/2) & ";";
    fi;
  fi;
  if xpart(subredge)-xpart(subledge) >
    (if pair obj(@#conc).ledge:
        xpart(obj(@#conc).redge)-xpart(obj(@#conc).ledge)
     else:
       xpart(obj(@#conc).e)-xpart(obj(@#conc).w)
     fi):
    eq:=eq & "xpart(@#lstart)=xpart(obj(@#subt).c)" &
                            (signeddecimal xpart(subledge)) &
                            (signeddecimal(OptionValue@#("lstartdx")))  & ";";
    eq:=eq & "xpart(@#lend)=xpart(obj(@#subt).c)" &
                            (signeddecimal xpart(subredge)) &
                            (signeddecimal(OptionValue@#("lenddx")))  & ";";
    % 7 horizontal space at right of subtree
    %   |max(xpart(@#lend)+rdistr+wd(@#rr)-xpart(subt.e),0)|
    % |= max(xpart(obj(@#subt).redge)+rdistr+wd(@#rr)-xpart(obj(@#subt).e),0)|
    spr=xpart(obj(@#subt).s)+xpart(subredge)+rdistr
       +xpart(obj(@#rr).e-obj(@#rr).w)-xpart(obj(@#subt).e);
    if spr<0: spr:=0;fi;spr:=spr+dist_e;
    % 8 horizontal space at left of subtree
    %   |min(xpart(@#lstart)-wd(@#lr)-rdistl-xpart(subt.w),0)|
    % |= min(xpart(obj(@#subt).ledge)-wd(@#lr)-rdistl-xpart(obj(@#subt).w),0)|
    spl=xpart(obj(@#subt).s)+xpart(subledge)
       -xpart(obj(@#lr).e-obj(@#lr).w)-rdistl-xpart(obj(@#subt).w);
    if spl>0:spl:=0;fi;spl:=spl-dist_w;
    eq:=eq & "xpart(@#e)-xpart(obj(@#subt).e)=" & (signeddecimal spr) & ";";
    eq:=eq & "xpart(obj(@#subt).w)-xpart(@#w)=" & (signeddecimal (-spl)) & ";";
  else:
    if pair obj(@#conc).ledge:
      eq:=eq & "xpart(@#lstart)=xpart(obj(@#conc).ledge)" &
                            (signeddecimal(OptionValue@#("lstartdx"))) & ";";
      eq:=eq & "xpart(@#lend)=xpart(obj(@#conc).redge)" &
                            (signeddecimal(OptionValue@#("lenddx"))) & ";";
    else:
      eq:=eq & "xpart(@#lstart)=xpart(obj(@#conc).w)" &
                            (signeddecimal(OptionValue@#("lstartdx"))) & ";";
      eq:=eq & "xpart(@#lend)=xpart(obj(@#conc).e)" &
                            (signeddecimal(OptionValue@#("lenddx"))) & ";";
    fi;
    % 7 horizontal space at right of conclusion
    %   |max(xpart(@#lend)+rdistr+wd(@#rr)-xpart(conc.e),0)|
    % |= max(rdistr+wd(@#rr),0)|
    spr=rdistr+xpart(obj(@#rr).e-obj(@#rr).w);
    if spr<0: spr:=0;fi;spr:=spr+dist_e;
    % 8 horizontal space at left of conclusion
    %   |min(xpart(@#lstart)-wd(@#lr)-rdistl-xpart(conc.w),0)|
    % |= min(-wd(@#lr)-rdistl,0)|
    spl=-xpart(obj(@#lr).e-obj(@#lr).w)-rdistl;
    if spl>0:spl:=0;fi;spl:=spl-dist_w;
    if pair obj(@#conc).ledge:
      eq:=eq & "xpart(@#e)-xpart(obj(@#conc).redge)=" &
                           (signeddecimal spr) & ";";
      eq:=eq & "xpart(obj(@#conc).ledge)-xpart(@#w)=" &
                           (signeddecimal (-spl)) & ";";
    else:
      eq:=eq & "xpart(@#e)-xpart(obj(@#conc).e)=" &
                           (signeddecimal spr) & ";";
      eq:=eq & "xpart(obj(@#conc).w)-xpart(@#w)=" &
                           (signeddecimal (-spl)) & ";";
    fi;
  fi;
  %
  % 9 Attachment of the rules:
  %   |@#lstart=@#lr.e|
  %   |@#lend=@#rr.w|
  if not isEmptyBox(obj(@#lr)):
    eq:=eq & "@#lstart-(rdistl,0)=obj(@#lr).e;";
  fi;
  if not isEmptyBox(obj(@#rr)):
    eq:=eq & "@#lend=obj(@#rr).w-(rdistr,0);";
  fi;
  ObjCode StandardEquations,eq;
%    |"xpart(@#n)=xpart(@#s);ypart(@#ne)=ypart(@#nw);";|
  StandardTies;
enddef;

streamline("PTree")("(expr conclusion)(text subtrees)(expr left,right)",
                   "suffixpar(conclusion)suffixlist(subtrees)(left,right)");

def BpathPTree(suffix n)= StandardBpath(n) enddef;

% CHOOSE A BETTER NAME
def PTreeRoot_(suffix sb)=
  (if isBB(sb): PTreeRoot_(obj(sb.sub))
   elseif isPTree(sb): PTreeRoot_(obj(sb.root))
   else: sb.ic
   fi
  )
enddef;

def PTreeRootPath_(suffix sb)=
  (if isBB(sb): PTreeRootPath_(obj(sb.sub))
   elseif isPTree(sb): PTreeRootPath_(obj(sb.root))
   else: BpathObj(sb)
   fi
  )
enddef;

def drawPTree(suffix n)=
  drawFramedOrFilledObject_(n);
  if not isEmptyBox(obj(n.conc)): drawObj(obj(n.conc)); fi;
  if not isEmptyBox(obj(n.subt)): drawObj(obj(n.subt)); fi;
  if not isEmptyBox(obj(n.lr)):   drawObj(obj(n.lr));   fi;
  if not isEmptyBox(obj(n.rr)):   drawObj(obj(n.rr));   fi;
  if OptionValue.n("rule")>0:
    pickup pencircle scaled OptionValue.n("rule");
    draw n.lstart -- n.lend;
  fi;
%  pickup pencircle scaled 2pt;
%  draw n.ledge withcolor red;
%  draw n.redge withcolor red;
  pickup pencircle scaled .4pt;
  drawMemorizedPaths_(n);
enddef;

setObjectDefaultOption("PTree")("treemode")("D");    % default is down
setObjectDefaultOption("PTree")("dx")(0mm);     % left/right margins
setObjectDefaultOption("PTree")("dy")(0mm);     % top/down margins
setObjectDefaultOption("PTree")("hsep")(3mm);   % internal horizontal separation
                                          % between subtrees
setObjectDefaultOption("PTree")("vsep")(2mm);   % internal vertical separation
setObjectDefaultOption("PTree")("lrsep")(2mm);  % separation with left rule
setObjectDefaultOption("PTree")("rrsep")(2mm);  % separation with right rule
setObjectDefaultOption("PTree")("lstartdx")(0); % positive towards the right
setObjectDefaultOption("PTree")("lenddx")(0);   % positive towards the right
setObjectDefaultOption("PTree")("rule")(.5bp);  % rule thickness
setObjectDefaultOption("PTree")("framed")(false);
setObjectDefaultOption("PTree")("filled")(false);
setObjectDefaultOption("PTree")("fillcolor")(black);
setObjectDefaultOption("PTree")("framewidth")(.5bp);
setObjectDefaultOption("PTree")("framecolor")(black);
setObjectDefaultOption("PTree")("framestyle")("");
setObjectDefaultOption("PTree")("shadow")(false); % no shadow by default
setObjectDefaultOption("PTree")("shadowcolor")(black);

% Two simplified versions, where only one rule is given:
vardef newPTreeL@#(expr conclusion)(text subtrees)(expr left) text options=
  newPTree@#(conclusion)(subtrees)(left,"") options
enddef;

vardef newPTreeR@#(expr conclusion)(text subtrees)(expr right) text options=
  newPTree@#(conclusion)(subtrees)("",right) options
enddef;

% A version with no subtrees and no rules:
vardef newAxiom@#(expr axiom) text options=
  newPTree@#(axiom)("")("","") options
enddef;

vardef newAssumption@#(expr assumption)=
  newBox@#(assumption) "framed(false)", "dx(0)", "dy(0)"
enddef;

% This is identical to |newAssumption|, but it would be confusing
% to use |newAssumption| where a conclusion occurs.
vardef newConclusion@#(expr conclusion)=
  newBox@#(conclusion) "framed(false)", "dx(0)", "dy(0)"
enddef;

%=====================================================================
% |HBox| class

% |HBox|: Generic Horizontal Alignments
% |@#| is a name for an object (must be a suffix)
% |@#| will be the number of the object, but will also be used
% as a prefix for other variables.
vardef newHBox@#(text sublist) text options =
  ExecuteOptions(@#)(options);
  assignObj(@#,"HBox");
  StandardInterface;
  save n,i,eq;numeric n,i;string eq;
  n=0;
  forsuffixes $:=sublist:n:=n+1;endfor;
  ObjSubArray(sb)(n); % |n| is the number of horizontal elements
  ObjNumeric nst,tallest;
  setNumeric(nst)(n);
  i=0;
  if OptionValue@#("flip"):
    forsuffixes $:=sublist:i:=i+1;
      SubObjectOfArray(sb[n+1-i],$);
    endfor;
  else:
    forsuffixes $:=sublist:i:=i+1;
      SubObjectOfArray(sb[i],$);
    endfor;
  fi;
  % we now build the equations:
  % 1: horizontal equation: horizontal separation between elements
  %   if elementsize<0:
  %      |xpart(sb[2].w-sb[1].e)=xpart(sb[3].w-sb[2].e)=...|
  %                            |=xpart(sb[n].w-sb[n-1].e)=5mm;|
  %   if elementsize>=0:
  %      |xpart(sb[2].c-sb[1].c)=xpart(sb[3].c-sb[2].c)=...|
  %                            |=xpart(sb[n].c-sb[n-1].c)=hbsep+elementsize;|
  %
  % 2: horizontal equation: horizontal space at the edges
  % |xpart(sb[1].w-@#w)=xpart(@#e-sb[n].e)=0mm;|
  % 3: vertical equation: elements are lined up at the top
  %      |ypart(sb[1].n)=ypart(sb[2].n)=...=ypart(sb[n].n)|
  %   or at the bottom (default) (depending on the options)
  %      |ypart(sb[1].s)=ypart(sb[2].s)=...=ypart(sb[n].s)|
  %   or at the center
  %      |ypart(sb[1].c)=ypart(sb[2].c)=...=ypart(sb[n].c)|
  % 4: vertical equation: vertical space at the top
  %   |ypart(@#n-sb[i].n)=0mm;|  where |sb[i]| is the tallest
  % 5: vertical equation: vertical space at the bottom
  %     |ypart(sb[i].s-@#s)=0mm;| where |sb[i]| is the tallest
  % 1:
  if OptionValue@#("elementsize")<0:
    eq:="if @#sb.n_>1:" &
          "xpart(obj(@#sb[2]).w-obj(@#sb[1]).e) " &
          "if @#sb.n_>2:" & 
            "for i:=3 upto @#sb.n_: " &
               "=xpart(obj(@#sb[i]).w-obj(@#sb[i-1]).e)" &
            "endfor " &
          "fi" &
          "=" & decimal(OptionValue@#("hbsep")) & ";" & 
          "fi;";
  else:
    eq:="if @#sb.n_>1:" &
          "xpart(obj(@#sb[2]).c-obj(@#sb[1]).c) " &
          "if @#sb.n_>2:" & 
            "for i:=3 upto @#sb.n_: " &
               "=xpart(obj(@#sb[i]).c-obj(@#sb[i-1]).c)" &
            "endfor " &
          "fi" &
          "=" &
          decimal(OptionValue@#("hbsep")+OptionValue@#("elementsize")) & ";" & 
          "fi;";
  fi;    
  % 2: |xpart(sb[1].w-@#w)=xpart(@#e-sb[n].e)=5mm;|
  if OptionValue@#("elementsize")<0:
    eq:=eq & "xpart(obj(@#sb[1]).w-@#w)" &
          "=xpart(@#e-obj(@#sb[@#sb.n_]).e)=" &
          decimal(OptionValue@#("dx")) & ";";
  else:
    eq:=eq & "xpart(obj(@#sb[1]).c-@#w)" &
          "=xpart(@#e-obj(@#sb[@#sb.n_]).c)=" &
          decimal(OptionValue@#("dx")+.5*OptionValue@#("elementsize")) & ";";
  fi;
  % The next equation depends on an option:
  save alignsuffix;string alignsuffix;  alignsuffix="s";
  if Option@#("align","top"):alignsuffix:="n";
  elseif Option@#("align","center"):alignsuffix:="c";
  fi;
          
  % 3: |ypart(sb[1].alignsuffix)=ypart(sb[2].alignsuffix)=...|
                             % |=ypart(sb[n].alignsuffix)|
  eq:=eq & "if @#sb.n_>1:" &
             "ypart(obj(@#sb[1])." & alignsuffix & ")" &
             "for i:=2 upto @#sb.n_: " &
               "=ypart(obj(@#sb[i])." & alignsuffix & ")" &
             "endfor;" &
           "fi;";
  % first, we compute the tallest subtree:
  setTallest@#;
  % 4: |ypart(@#n-sb[tallest].n)=0mm;|
  eq:=eq & "ypart(@#n-obj(@#sb[@#tallest]).n)=" &
                              decimal(OptionValue@#("dy")) & ";";
  % 5: |ypart(sb[tallest].s-@#s)=0mm;|
  eq:=eq & "ypart(obj(@#sb[@#tallest]).s-@#s)=" &
                              decimal(OptionValue@#("dy")) & ";";
  
  ObjCode StandardEquations,eq;
%    |"xpart(@#n)=xpart(@#s);ypart(@#ne)=ypart(@#nw);";|
  StandardTies;
enddef;

% The result of |setTallest| must be greater than 0.
vardef setTallest@#=
  save tallest_height;
  @#tallest:=1;tallest_height=0;
  for i:=1 upto @#nst:
    if ypart(obj(@#sb[i]).n-obj(@#sb[i]).s)>tallest_height: 
      @#tallest:=i;
      tallest_height:=ypart(obj(@#sb[i]).n-obj(@#sb[i]).s);
    fi;
  endfor;
enddef;

streamline("HBox")("(text sublist)","suffixlist(sublist)");

def BpathHBox(suffix n)= StandardBpath(n) enddef;

def drawHBox(suffix n)=
  drawFramedOrFilledObject_(n);
  drawObjArray(n)(sb);
  drawMemorizedPaths_(n);
enddef;

% Default values of |HBox|:
setObjectDefaultOption("HBox")("dx")(0mm);
setObjectDefaultOption("HBox")("dy")(0mm);
setObjectDefaultOption("HBox")("hbsep")(1mm);
setObjectDefaultOption("HBox")("elementsize")(-1pt); % like PSTricks
setObjectDefaultOption("HBox")("align")("bot");
setObjectDefaultOption("HBox")("framed")(false);
setObjectDefaultOption("HBox")("filled")(false);
setObjectDefaultOption("HBox")("fillcolor")(black);
setObjectDefaultOption("HBox")("framewidth")(.5bp);
setObjectDefaultOption("HBox")("framecolor")(black);
setObjectDefaultOption("HBox")("framestyle")("");
setObjectDefaultOption("HBox")("flip")(false);
setObjectDefaultOption("HBox")("shadow")(false); % no shadow by default
setObjectDefaultOption("HBox")("shadowcolor")(black);


% Replace an element in an |HBox| or add an element at the end of the list.
% A succeeding call to this function resets the object.
vardef replaceHBoxElement.expl@#(expr i)(suffix rep)=
  setcurrentobjname_(str @#);
  if (i<1) or (i>@#sb.n_+1):
    errmessage "Value out of range";
  elseif i<@#sb.n_+1:
    % first, we reset the object in order to be sure we have its right
    % dimensions when we try to update  |tallest|
    resetObj.expl@#;
    @#sb[i]:=str rep;
    % we recompute the tallest element:
    setTallest@#;
    resetObj.expl@#;
  else: % |i=@#sb.n_+1|
    % we add |rep| at the end of the |HBox|
    % first, we reset the object in order to be sure we have its right
    % dimensions when we try to update  |tallest|
    resetObj.expl@#;
    @#sb.n_:=@#sb.n_+1;
    @#sb[@#sb.n_]:=str rep;
    setTallest@#; % not fast, but short
    resetObj.expl@#;
    % we need to add one tie, and the easiest is to recreate them all:
    @#nsubobjties_:=0;
    StandardTies;
  fi;
enddef;

% Delete an element in an |HBox|
% A succeeding call to this function resets the object.
vardef deleteHBoxElement.expl@#(expr i)=
  setcurrentobjname_(str @#);
  if (i<0) or (i>@#sb.n_):
    errmessage "Value out of range";
  else:
    resetObj.expl@#;
    for j:=i upto @#sb.n_-1:
      @#sb[j]:=@#sb[j+1];
    endfor;
    @#sb[@#sb.n_]:=whateverstring;
    @#sb.n_:=@#sb.n_-1;
    setTallest@#;
    resetObj.expl@#;
    % we reconstruct the standard ties
    @#nsubobjties_:=0;
    StandardTies;
  fi;
enddef;


% The next class is the vertical analog of |HBox|. It would have
% been possible to merge |newHBox| and |newVBox| in something like
% |newAlign| (|xpart| becoming |ypart|, |.w| becoming |.s|, etc.)
% but we didn't do it for the sake of clarity. It is left as an
% exercise.

%=====================================================================
% |VBox| class

% |VBox|: Generic Vertical Alignments
% The objects are stacked up (and not down as in \TeX).
% |@#| is a name for an object (must be a suffix)
% |@#| will be the number of the object, but will also be used
% as a prefix for other variables.
vardef newVBox@#(text sublist) text options =
  ExecuteOptions(@#)(options);
  assignObj(@#,"VBox");
  StandardInterface;
  save n,i,eq;numeric n,i;string eq;
  n=0;
  forsuffixes $:=sublist:n:=n+1;endfor;
  ObjSubArray(sb)(n); % |n| is the number of vertical elements
  ObjNumeric nst,widest;
  setNumeric(nst)(n);
  i=0;
  if OptionValue@#("flip"):
    forsuffixes $:=sublist:i:=i+1;
      SubObjectOfArray(sb[n+1-i],$);
    endfor;
  else:
    forsuffixes $:=sublist:i:=i+1;
      SubObjectOfArray(sb[i],$);
    endfor;
  fi;
  % we now build the equations:
  % 1: vertical equation: vertical separation between elements
  % |ypart(sb[2].s-sb[1].n)=ypart(sb[3].s-sb[2].n)=...|
  %                       |=ypart(sb[n].s-sb[n-1].n)=5mm;|
  % 2: vertical equation: vertical space at the edges
  % |ypart(sb[1].s-@#s)=ypart(@#n-sb[n].n)=0mm;|
  % 3: horizontal equation: elements are lined up at the left (default)
  %      |xpart(sb[1].w)=xpart(sb[2].w)=...=xpart(sb[n].w)|
  %   or at the right (depending on the options)
  %      |xpart(sb[1].e)=xpart(sb[2].e)=...=xpart(sb[n].e)|
  %   or at the center
  %      |xpart(sb[1].c)=xpart(sb[2].c)=...=xpart(sb[n].c)|
  % 4: horizontal equation: horizontal space at the right
  %   |xpart(@#e-sb[i].e)=0mm;|  where |sb[i]| is the widest
  % 5: horizontal equation: vertical space at the left
  %     |xpart(sb[i].w-@#w)=0mm;| where |sb[i]| is the widest
  % 1:
  if OptionValue@#("elementsize")<0:
    eq:="if @#sb.n_>1:" &
          "ypart(obj(@#sb[2]).s-obj(@#sb[1]).n)" &
          "if @#sb.n_>2:" &
            "for i:=3 upto @#sb.n_: " &
              "=ypart(obj(@#sb[i]).s-obj(@#sb[i-1]).n)" &
            "endfor " &
          "fi" &
          "=" & decimal(OptionValue@#("vbsep")) & ";" &
          "fi;";
  else:
    eq:="if @#sb.n_>1:" &
          "ypart(obj(@#sb[2]).c-obj(@#sb[1]).c)" &
          "if @#sb.n_>2:" &
            "for i:=3 upto @#sb.n_: " &
              "=ypart(obj(@#sb[i]).c-obj(@#sb[i-1]).c)" &
            "endfor " &
          "fi" &
          "=" &
           decimal(OptionValue@#("vbsep")+OptionValue@#("elementsize")) & ";" &
          "fi;";
  fi;
  % 2: |ypart(sb[1].s-@#s)=ypart(@#n-sb[n].n)=5mm;|
  if OptionValue@#("elementsize")<0:
    eq:=eq & "ypart(obj(@#sb[1]).s-@#s)" &
            "=ypart(@#n-obj(@#sb[@#sb.n_]).n)=" &
            decimal(OptionValue@#("dy")) & ";";
  else:
    eq:=eq & "ypart(obj(@#sb[1]).c-@#s)" &
            "=ypart(@#n-obj(@#sb[@#sb.n_]).c)=" &
            decimal(OptionValue@#("dy")+.5*OptionValue@#("elementsize")) & ";";
  fi;
  % The next equation depends on an option:
  save alignsuffix;string alignsuffix;  alignsuffix="w"; % default
  if Option@#("align","right"):alignsuffix:="e";
  elseif Option@#("align","center"):alignsuffix:="c";
  fi;
          
  % 3: |xpart(sb[1].alignsuffix)=xpart(sb[2].alignsuffix)=...|
                             % |=xpart(sb[n].alignsuffix)|
  eq:=eq & "if @#sb.n_>1:" &
             "xpart(obj(@#sb[1])." & alignsuffix & ")" &
             "for i:=2 upto @#sb.n_: " &
                "=xpart(obj(@#sb[i])." & alignsuffix & ")" &
             "endfor;" &
           "fi;";
  % first, we compute the widest subtree:
  setWidest@#;
  % 4: |xpart(@#e-sb[widest].e)=0mm;|
  eq:=eq & "xpart(@#e-obj(@#sb[@#widest]).e)=" &
                         decimal(OptionValue@#("dx")) & ";";
  % 5: |xpart(sb[widest].w-@#w)=0mm;|
  eq:=eq & "xpart(obj(@#sb[@#widest]).w-@#w)=" &
                         decimal(OptionValue@#("dx")) & ";";
  ObjCode StandardEquations,eq;
%    |"ypart(@#n)=ypart(@#s);xpart(@#ne)=xpart(@#nw);";|
  StandardTies;
enddef;

% The result of |setWidest| must be greater than 0.
vardef setWidest@#=
  save widest_width;@#widest:=1;widest_width=0;
  for i:=1 upto @#nst:
    if xpart(obj(@#sb[i]).e-obj(@#sb[i]).w)>widest_width: 
      @#widest:=i;
      widest_width:=xpart(obj(@#sb[i]).e-obj(@#sb[i]).w);
    fi;
  endfor;
enddef;

streamline("VBox")("(text sublist)","suffixlist(sublist)");

def BpathVBox(suffix n)= StandardBpath(n) enddef;

def drawVBox(suffix n)=
  drawFramedOrFilledObject_(n);
  drawObjArray(n)(sb);
  drawMemorizedPaths_(n);
enddef;

% Default values of |VBox|:
setObjectDefaultOption("VBox")("dx")(0mm);
setObjectDefaultOption("VBox")("dy")(0mm);
setObjectDefaultOption("VBox")("vbsep")(1mm);
setObjectDefaultOption("VBox")("elementsize")(-1pt); % like PSTricks
setObjectDefaultOption("VBox")("align")("left");
setObjectDefaultOption("VBox")("framed")(false);
setObjectDefaultOption("VBox")("filled")(false);
setObjectDefaultOption("VBox")("fillcolor")(black);
setObjectDefaultOption("VBox")("framewidth")(.5bp);
setObjectDefaultOption("VBox")("framecolor")(black);
setObjectDefaultOption("VBox")("framestyle")("");
setObjectDefaultOption("VBox")("flip")(false);
setObjectDefaultOption("VBox")("shadow")(false); % no shadow by default
setObjectDefaultOption("VBox")("shadowcolor")(black);

% Replace an element in an |VBox| or add an element at the end of the list.
% A succeeding call to this function resets the object.
vardef replaceVBoxElement.expl@#(expr i)(suffix rep)=
  setcurrentobjname_(str @#);
  if (i<1) or (i>@#sb.n_+1):
    errmessage "Value out of range";
  elseif i<@#sb.n_+1:
    % first, we reset the object in order to be sure we have its right
    % dimensions when we try to update  |widest|
    resetObj.expl@#;
    @#sb[i]:=str rep;
    % we recompute the widest element:
    setWidest@#;
    resetObj.expl@#;
  else: % |i=@#sb.n_+1|
    % we add |rep| at the end of the |VBox|
    % first, we reset the object in order to be sure we have its right
    % dimensions when we try to update  |widest|
    resetObj.expl@#;
    @#sb.n_:=@#sb.n_+1;
    @#sb[@#sb.n_]:=str rep;
    setWidest@#; % not fast, but short
    resetObj.expl@#;
    % we need to add one tie, and the easiest is to recreate them all:
    @#nsubobjties_:=0;
    StandardTies;
  fi;
enddef;

% Delete an element in an |VBox|
% A succeeding call to this function resets the object.
% This function should be merged with |deleteHBoxElement.expl|
vardef deleteVBoxElement.expl@#(expr i)=
  setcurrentobjname_(str @#);
  if (i<0) or (i>@#sb.n_):
    errmessage "Value out of range";
  else:
    resetObj.expl@#;
    for j:=i upto @#sb.n_-1:
      @#sb[j]:=@#sb[j+1];
    endfor;
    @#sb[@#sb.n_]:=whateverstring;
    @#sb.n_:=@#sb.n_-1;
    setWidest@#;
    resetObj.expl@#;
    % we reconstruct the standard ties
    @#nsubobjties_:=0;
    StandardTies;
  fi;
enddef;

%=====================================================================
% |Matrix| class

% |Matrix|: Generic Matrix
% |@#| is a name for an object (must be a suffix)
% |@#| will be the number of the object, but will also be used
% as a prefix for other variables.
vardef newMatrix@#(expr Nx,Ny)(text elements) text options =
  ExecuteOptions(@#)(options);
  assignObj(@#,"Matrix");
  StandardInterface;
  save i,eq;numeric i;string eq;
  ObjSubArray(sb)(Nx*Ny);
  ObjNumeric nx,ny;
  setNumeric(nx)(Nx);
  setNumeric(ny)(Ny);
  ObjNumericArray(wd)(Ny);
  ObjNumericArray(ht)(Nx);
  
  i=0;
  forsuffixes $:=elements:i:=i+1;
    if $<>0: % null box
      SubObjectOfArray(sb[i],$);
    fi;
  endfor;

  % We compute for each column, which element is the widest,
  % and for each line, which one is the tallest; the indices
  % are stored in the |wd| and |ht| arrays:
  % This assumes that there is at least one object in each column
  % and line.
  % First, the tallest elements in each line:
  if OptionValue@#("matrixnodevsize")<0:
    for i:=1 upto Nx:
      % find the first column which contains an object and initialize
      % |@#ht[i]| to its index:
      @#ht[i]=0;
      for k:=1 upto Ny:
        if known @#sb[(i-1)*Ny+k]: @#ht[i]:=k;fi;
        exitif @#ht[i]=k;
      endfor;
      for j:=@#ht[i]+1 upto Ny:
        if known @#sb[(i-1)*Ny+j]:
          if ypart(obj(@#sb[(i-1)*Ny+j]).n-obj(@#sb[(i-1)*Ny+j]).s)>
            ypart(obj(@#sb[(i-1)*Ny+@#ht[i]]).n-obj(@#sb[(i-1)*Ny+@#ht[i]]).s):
            @#ht[i]:=j;
          fi;
        fi;
      endfor;
      @#ht[i]:=(i-1)*Ny+@#ht[i];
    endfor;
  else:
    for i:=1 upto Nx:
      @#ht[i]=1+(i-1)*Ny; % bug corrected on October 5, 2005
    endfor;
  fi;
  
  % Then, the widest elements in each column:
  if OptionValue@#("matrixnodehsize")<0:
    for i:=1 upto Ny:
      @#wd[i]=0;
      % find the first line which contains an object and initialize
      % |@#wd[i]| to its index:
      for k:=1 upto Nx:
        if known @#sb[(k-1)*Ny+i]: @#wd[i]:=k;fi;
        exitif @#wd[i]=k;
      endfor;
      for j:=@#wd[i]+1 upto Nx:
        if known @#sb[(j-1)*Ny+i]:
          if xpart(obj(@#sb[(j-1)*Ny+i]).e-obj(@#sb[(j-1)*Ny+i]).w)>
            xpart(obj(@#sb[(@#wd[i]-1)*Ny+i]).e-obj(@#sb[(@#wd[i]-1)*Ny+i]).w):
            @#wd[i]:=j;
          fi;
        fi;
      endfor;
      @#wd[i]:=(@#wd[i]-1)*Ny+i;
    endfor;
  else:
    for i:=1 upto Ny:
      @#wd[i]=i; % bug corrected on October 5, 2005
    endfor;
  fi;
  % The basic equations are:
  % horizontally:
  %   |xpart(sb[wd(1)].w-@#w)=5mm;|
  %   |xpart(@#e-sb[wd(ny)].e)=5mm;|
  %   |for i=1 upto ny-1|
  %     |xpart(sb[wd(i+1)].w-sb[wd(i)].e)=5mm;| ****
  %   |for i=1 upto ny|
  %     |for j=1 upto nx|
  %       |xpart(sb[(j-1)*ny+i].c)=xpart(sb[wd(i)].c)|
  % vertically:
  %   |ypart(@#n-sb[ht(1)].n)=5mm;|
  %   |ypart(sb[ht(nx)].s-@#s)=5mm;|
  %   |for i=1 upto nx-1|
  %     |ypart(sb[ht(i)].s-sb[ht(i+1)].n)=5mm;| ****
  %   |for i=1 upto ny|
  %     |for j=1 upto nx|
  %       |ypart(sb[(j-1)*ny+i].c)=ypart(sb[ht(j)].c)|
  %
  %  `****' shows where matrixnode(h/v)size needs to be taken into account
  %  These two equations become:
  %    |xpart(sb[wd(i+1)].c-sb[wd(i)].c)=matrixnodehsize;|
  %    |ypart(sb[ht(i)].c-sb[ht(i+1)].c)=matrixnodevsize;|
  %
  % By not hardwiring the widest and tallest elements
  % we allow ourselves the possibility to replace elements
  % and still have the size adjusted (after resetting the object).
  % The only assumption is that there is always at least one non null
  % object in each column and each line.
  
  eq:="save fal_;" &
      "vardef fal_(expr i,s)=" &
        "save l;" &
        "hide(l=length(s);)" &
        "substring if i>l: (l-1,l) else: (i-1,i) fi of s " &
      "enddef; " &
  if OptionValue@#("matrixnodehsize")>=0:
      "xpart(obj(@#sb[@#wd[1]]).c-@#w)=" &
          decimal (OptionValue@#("matrixnodehsize")/2+OptionValue@#("dx")) &";" &
      "xpart(@#e-obj(@#sb[@#wd[@#ny]]).c)=" &
          decimal (OptionValue@#("matrixnodehsize")/2+OptionValue@#("dx")) &";" &
  else:
      "xpart(obj(@#sb[@#wd[1]]).w-@#w)=" & decimal (OptionValue@#("dx")) &";" &
      "xpart(@#e-obj(@#sb[@#wd[@#ny]]).e)=" &
                                           decimal (OptionValue@#("dx")) &";" &
  fi
      "for i:=1 upto @#ny-1:";
  if OptionValue@#("matrixnodehsize")>=0:
    eq:=eq &
        "xpart(obj(@#sb[@#wd[i+1]]).c-obj(@#sb[@#wd[i]]).c)=" &
	                              decimal (OptionValue@#("matrixnodehsize")) &";";	
  else:
    eq:=eq &
        "xpart(obj(@#sb[@#wd[i+1]]).w-obj(@#sb[@#wd[i]]).e)=" &
                                      decimal (OptionValue@#("hsep")) &";";
  fi;
  eq:=eq &                     
      "endfor;" &
      "for i:=1 upto @#ny:" &
        "for j:=1 upto @#nx:" &
          "if ((j-1)*@#ny+i<>@#wd[i]) and (known @#sb[(j-1)*@#ny+i]):" &
             "xpart(obj(@#sb[(j-1)*@#ny+i]).sc_(fal_(i," &
                      quote(OptionValue@#("halign")) & ")))" &
            "=xpart(obj(@#sb[@#wd[i]]).sc_(fal_(i," &
                      quote(OptionValue@#("halign")) & ")));" &
          "fi;" &
        "endfor;" &
      "endfor;" &
  if OptionValue@#("matrixnodevsize")>=0:
      "ypart(@#n-obj(@#sb[@#ht[1]]).c)=" &
         decimal (OptionValue@#("matrixnodevsize")/2+OptionValue@#("dy")) &";" &
      "ypart(obj(@#sb[@#ht[@#nx]]).c-@#s)=" &
         decimal (OptionValue@#("matrixnodevsize")/2+OptionValue@#("dy")) &";" &
  else:
      "ypart(@#n-obj(@#sb[@#ht[1]]).n)=" & decimal (OptionValue@#("dy")) &";" &
      "ypart(obj(@#sb[@#ht[@#nx]]).s-@#s)=" &
                                           decimal (OptionValue@#("dy")) &";" &
  fi
      "for i:=1 upto @#nx-1:";
  if OptionValue@#("matrixnodevsize")>=0:
    eq:=eq &
      "ypart(obj(@#sb[@#ht[i]]).c-obj(@#sb[@#ht[i+1]]).c)=" &
                              decimal (OptionValue@#("matrixnodevsize")) &";";
  else:
    eq:=eq &
      "ypart(obj(@#sb[@#ht[i]]).s-obj(@#sb[@#ht[i+1]]).n)=" &
                                         decimal (OptionValue@#("vsep")) &";";
  fi;
    eq:=eq &
      "endfor;" &
      "for i:=1 upto @#ny:" &
        "for j:=1 upto @#nx:" &
          "if ((j-1)*@#ny+i<>@#ht[j]) and (known @#sb[(j-1)*@#ny+i]):" &
              "ypart(obj(@#sb[(j-1)*@#ny+i]).sc_(fal_(i," &
                      quote(OptionValue@#("valign")) & ")))" &
             "=ypart(obj(@#sb[@#ht[j]]).sc_(fal_(i," &
                      quote(OptionValue@#("valign")) & ")));" &
          "fi;" &  
        "endfor;" &
      "endfor;";
    ObjCode StandardEquations,eq;
  StandardTies;
enddef;

streamline("Matrix")("(expr nx,ny)(text sublist)",
                     "(nx,ny)suffixlist(sublist)");

def BpathMatrix(suffix n)= StandardBpath(n) enddef;

def drawMatrix(suffix n)=
  drawFramedOrFilledObject_(n);
  drawObjArray(n)(sb);
  drawMemorizedPaths_(n);
enddef;

% Default values of |Matrix|:
setObjectDefaultOption("Matrix")("dx")(0mm);
setObjectDefaultOption("Matrix")("dy")(0mm);
setObjectDefaultOption("Matrix")("hsep")(1mm);
setObjectDefaultOption("Matrix")("vsep")(1mm);
setObjectDefaultOption("Matrix")("halign")("c");
setObjectDefaultOption("Matrix")("valign")("c");
setObjectDefaultOption("Matrix")("framed")(false);
setObjectDefaultOption("Matrix")("filled")(false);
setObjectDefaultOption("Matrix")("fillcolor")(black);
setObjectDefaultOption("Matrix")("framewidth")(.5bp);
setObjectDefaultOption("Matrix")("framecolor")(black);
setObjectDefaultOption("Matrix")("framestyle")("");
setObjectDefaultOption("Matrix")("shadow")(false); % no shadow by default
setObjectDefaultOption("Matrix")("shadowcolor")(black);
setObjectDefaultOption("Matrix")("matrixnodehsize")(-1pt);
setObjectDefaultOption("Matrix")("matrixnodevsize")(-1pt);


% Some special functions on matrices:

% This function replaces the element at position (i,j) by element |rep|
% Since we call |resetObj.expl|, this function cancels transformations.
% However, the new matrix has its equations correctly applied
% to the new object.
% |i| is the line, |j| the column
% It is possible to create new columns or new lines by giving to
% |i| (or |j|) the value of the number of lines (or columns) plus one.
vardef replaceMatrixElement.expl@#(expr i,j)(suffix rep)=
  % first, we reset the object in order to be sure we have its right
  % dimensions when we try to update  |ht[i]| and |wd[j]|
  resetObj.expl@#;

  % first, see if a new column or a new line are needed
  if i=@#nx+1:
    if (j>0) and (j<=@#ny):
      % create new line
      @#nx:=@#nx+1;
      @#sb.n_:=@#nx*@#ny;

      % increase size of |@#ht[]| array
      @#ht.n_:=@#nx;
      
      @#ht[i]=(i-1)*@#ny+j;
      if xpart(rep.e-rep.w)>xpart(obj(@#sb[@#wd[j]]).e-obj(@#sb[@#wd[j]]).w):
        @#wd[j]:=(i-1)*@#ny+j;
      fi;
      % we replace the string representing the subobject
      @#sb[(i-1)*@#ny+j]:= str rep;
      % we reset the object again, this time in order to take the changes
      % to |ht[i]| and |wd[j]| into account
      resetObj.expl@#;
      
    elseif j=@#ny+1:
      % in this case, we create a new line and a new column
      % first, a new column:
      addmatrixcolumn_@#;
      
      % create new line
      @#nx:=@#nx+1;
      @#sb.n_:=@#nx*@#ny;
      % increase sizes of |@#ht[]| array
      @#ht.n_:=@#nx;

      % we now update |@#ht| and |@#wd| because of the new object;
      % this is easy, because the object is alone on its line and column.
      @#ht[@#nx]:=@#nx*@#ny;
      @#wd[@#ny]:=@#nx*@#ny;
      % we add the subobject:
      @#sb[@#nx*@#ny]:= str rep;
      % and we reset the object

      resetObj.expl@#;
    else:
      errmessage "Column number out of range";
    fi;
  elseif (i>@#nx+1) or (i<1):
    errmessage "Line number out of range";
  else:
    if (j>0) and (j<=@#ny):
      % AVERAGE CASE
      % we replace the string representing the subobject
      @#sb[(i-1)*@#ny+j]:= str rep;
      % we recompute the |ht[i]| and |wd[j]| values; since it is possible
      % that we replace the largest element by a smaller one, the new largest
      % element can be different from both the previous largest and the
      % new element; so, in order to simplify the code, we recompute
      % |ht[i]| and |wd[j]| from scratch.
      @#ht[i]:=(i-1)*@#ny+j; % we are sure this element exists
      updateHeight_@#(i);
      @#wd[j]:=(i-1)*@#ny+j; % we are sure this element exists
      updateWidth_@#(j);
      % we reset the object again, this time in order to take the changes
      % to |ht[i]| and |wd[j]| into account
      resetObj.expl@#;
      
    elseif j=@#ny+1:
      addmatrixcolumn_@#;
      @#sb.n_:=@#nx*@#ny;

      % we now update |@#ht| and |@#wd| because of the new object;
      % the width is easy, because the object is alone on its column.
      
      @#wd[@#ny]:=i*@#ny;

      % for the height, we update |@#ht[i]|:
      if ypart(rep.n-rep.s) > ypart(obj(@#sb[@#ht[i]]).n-obj(@#sb[@#ht[i]]).s):
        @#ht[i]:=i*@#ny;
      fi;
      
      % we add the subobject:
      @#sb[i*@#ny]:= str rep;
      % and we reset the object
      resetObj.expl@#;
    else:
      errmessage "Column number out of range";
    fi;
  fi;
enddef;

% This function is only used by |replaceMatrixElement.expl|
vardef addmatrixcolumn_@#=
  % create a new column
  for k:=@#nx downto 1:
    for l:=@#ny downto 1:
      if known @#sb[(k-1)*@#ny+l]:
        @#sb[(k-1)*(@#ny+1)+l]:=@#sb[(k-1)*@#ny+l];
      else:
        @#sb[(k-1)*(@#ny+1)+l]:=whateverstring;
      fi;
    endfor;
  endfor;
  % we must also refresh the new column:
  for k:= 1 upto @#nx:
    @#sb[k*(@#ny+1)]:=whateverstring;
  endfor;

  % The values of |@#ht[i]| and |@#wd[i]| are now incorrect
  % because of the new column that changed the indices.
  %
  for k:=1 upto @#nx:
    @#ht[k]:=@#ht[k]+((@#ht[k]-1) div @#ny);
  endfor;
  for k:=1 upto @#ny:
    @#wd[k]:=@#wd[k]+((@#wd[k]-1) div @#ny);
  endfor;    
  @#ny:=@#ny+1;
  % increase sizes of |@#wd[]| array
  @#wd.n_:=@#ny;
enddef;


% This function is only used by |replaceMatrixElement.expl|
vardef updateHeight_@#(expr i)=
  for k:=1 upto @#ny:
    if known @#sb[(i-1)*@#ny+k]:
      if @#ht[i]>0:
        if ypart(obj(@#sb[(i-1)*@#ny+k]).n-obj(@#sb[(i-1)*@#ny+k]).s)>
           ypart(obj(@#sb[@#ht[i]]).n-obj(@#sb[@#ht[i]]).s):
          @#ht[i]:=(i-1)*@#ny+k;
        fi;
      else:
         @#ht[i]:=(i-1)*@#ny+k;     
      fi;
    fi;
  endfor;
enddef;
    
% This function is only used by |replaceMatrixElement.expl|
vardef updateWidth_@#(expr j)=
  for k:=1 upto @#nx:
    if known @#sb[(k-1)*@#ny+j]:
      if @#wd[j]>0:
        if xpart(obj(@#sb[(k-1)*@#ny+j]).e-obj(@#sb[(k-1)*@#ny+j]).w)>
           xpart(obj(@#sb[@#wd[j]]).e-obj(@#sb[@#wd[j]]).w):
          @#wd[j]:=(k-1)*@#ny+j;
        fi;
      else:
        @#wd[j]:=(k-1)*@#ny+j;
      fi;
    fi;
  endfor;
enddef;

% Delete matrix element (i,j). In certain cases, we reduce the number
% of columns or lines.
% We assume that after deletion the matrix is not empty.
vardef deleteMatrixElement.expl@#(expr i,j)=
  % The easy case is when the element we want to remove was neither
  % alone on its line, nor on its column
  if isaloneoncolumn_@#(i,j):
    if isaloneonline_@#(i,j): % case 1 (toughest case)
      % Here, we have to shift up to three whole blocks of the matrix
      for k:=1 upto (@#nx-1)*(@#ny-1):
        if known @#sb[transfer_@#(k,@#nx-1,@#ny-1,i,j)]:
          @#sb[k]:=@#sb[transfer_@#(k,@#nx-1,@#ny-1,i,j)];
        else:
          @#sb[k]:=whateverstring;
        fi;
      endfor;
      
      % the last column and line must be refreshed
      for k:=(@#nx-1)*(@#ny-1)+1 upto @#nx*@#ny:
        @#sb[k]:=whateverstring;
      endfor;
      
      % |@#wd[]| and |@#ht[]| must be updated,
      % as well as their number of elements.
      for k:=1 upto i-1:
        @#ht[k]:=transferi_@#(@#ht[k],@#nx-1,@#ny-1,i,j);
      endfor;
      for k:=i+1 upto @#nx:
        @#ht[k-1]:=transferi_@#(@#ht[k],@#nx-1,@#ny-1,i,j);
      endfor;
      for k:=1 upto j-1:
        @#wd[k]:=transferi_@#(@#wd[k],@#nx-1,@#ny-1,i,j);
      endfor;
      for k:=j+1 upto @#ny:
        @#wd[k-1]:=transferi_@#(@#wd[k],@#nx-1,@#ny-1,i,j);
      endfor;

      % |@#nx| and |@#ny| must be updated
      @#nx:=@#nx-1;@#ny:=@#ny-1;
      @#sb.n_:=@#nx*@#ny;
  
      @#ht.n_:=@#ht.n_-1;@#wd.n_:=@#wd.n_-1;

    else: % case 2: we remove column |j|
      for k:=1 upto @#nx*(@#ny-1):
        if known @#sb[transfer_@#(k,@#nx,@#ny-1,@#nx+1,j)]:
          @#sb[k]:=@#sb[transfer_@#(k,@#nx,@#ny-1,@#nx+1,j)];
        else:
          @#sb[k]:=whateverstring;
        fi;
      endfor;
      % the last column must be refreshed
      for k:=@#nx*(@#ny-1)+1 upto @#nx*@#ny:
        @#sb[k]:=whateverstring;
      endfor;

      % |@#wd[]| and |@#ht[]| must be updated,
      % as well as their number of elements.
      for k:=1 upto @#nx:
        @#ht[k]:=transferi_@#(@#ht[k],@#nx,@#ny-1,@#nx+1,j);
      endfor;
      % SPECIAL TREATMENT FOR |@#ht[i]|:
      @#ht[i]:=0;updateHeight_@#(i);
      
      for k:=1 upto j-1:
        @#wd[k]:=transferi_@#(@#wd[k],@#nx,@#ny-1,@#nx+1,j);
      endfor;
      for k:=j+1 upto @#ny:
        @#wd[k-1]:=transferi_@#(@#wd[k],@#nx,@#ny-1,@#nx+1,j);
      endfor;

      % |@#ny| must be updated
      @#ny:=@#ny-1;
      @#sb.n_:=@#nx*@#ny;
  
      @#wd.n_:=@#wd.n_-1;
      
    fi;
  else:
    if isaloneonline_@#(i,j): % case 3: we remove line |i|
      for k:=1 upto (@#nx-1)*@#ny:
        if known @#sb[transfer_@#(k,@#nx-1,@#ny,i,@#ny+1)]:
          @#sb[k]:=@#sb[transfer_@#(k,@#nx-1,@#ny,i,@#ny+1)];
        else:
          @#sb[k]:=whateverstring;
        fi;
      endfor;
      
      % the last line must be refreshed
      for k:=(@#nx-1)*@#ny+1 upto @#nx*@#ny:
        @#sb[k]:=whateverstring;
      endfor;
      
      % |@#wd[]| and |@#ht[]| must be updated,
      % as well as their number of elements.
      for k:=1 upto i-1:
        @#ht[k]:=transferi_@#(@#ht[k],@#nx-1,@#ny,i,@#ny+1);
      endfor;
      for k:=i+1 upto @#nx:
        @#ht[k-1]:=transferi_@#(@#ht[k],@#nx-1,@#ny,i,@#ny+1);
      endfor;
      for k:=1 upto @#ny:
        @#wd[k]:=transferi_@#(@#wd[k],@#nx-1,@#ny,i,@#ny+1);
        % SPECIAL TREATMENT FOR |@#wd[j]|:
      endfor;
      @#wd[j]:=0;updateWidth_@#(j);
      % |@#nx| and |@#ny| must be updated
      @#nx:=@#nx-1;
      @#sb.n_:=@#nx*@#ny;
  
      @#ht.n_:=@#ht.n_-1;
 
    else: % case 4 (easiest case)
      % we cancel the subobject
      @#sb[(i-1)*@#ny+j]:=whateverstring;
      % and we recompute the |@#ht[i]| and |@#wd[j]| values:
      @#ht[i]:=0;updateHeight_@#(i);
      @#wd[j]:=0;updateWidth_@#(j);
    fi;
  fi;
  resetObj.expl@#;
enddef;

% This function is only used by |deleteMatrixElement.expl|
% Given a slot |n| in a matrix |nnx|$\times$|nny|, where |nnx=@#nx| or
% |@#nx-1|, and |nny=@#ny| or |@#ny-1|, this function finds
% the slot number from the matrix |@#nx|$\times$|@#ny|.
% |i| and |j| are the missing line and column indexes
% If either |i| or |j| is equal to 0, only a line or only a column is missing.
vardef transfer_@#(expr n,nnx,nny,i,j)=
  save l,c,res;
  hide(
    % line and column of |n|:
    l=((n-1) div nny)+1;
    c=n-(l-1)*nny;
    if i*j>0:
      if (l>=1) and (l<i):
        if c<j: res=(l-1)*@#ny+c;
        else: res=(l-1)*@#ny+c+1;
        fi;
      elseif (l>=i):
        if c<j: res=l*@#ny+c;
        else: res=l*@#ny+c+1;
        fi;
      else:
        errmessage "Function not defined";
      fi;
    else:
      errmessage "This should not happen";
    fi;
  ) res
enddef;

% This is an inverse to |transfer_|.
% |n| is an index in the |@#nx|$\times$|@#ny| matrix,
% the new matrix is |nnx|$\times$|nny| and |i| and |j| are the cuts.
% The function returns the index in the new matrix.
vardef transferi_@#(expr n,nnx,nny,i,j)=
  save l,c,res;
  hide(
    % line and column of |n|:
    l=((n-1) div @#ny)+1;
    c=n-(l-1)*@#ny;
    % FIRST, THE CASE WHERE |i|*|j|>0:
    if i*j>0:
      if (l>=1) and (l<i):
        if c<j: res=(l-1)*nny+c;
        else: res=(l-1)*nny+c-1;
        fi;
      elseif (l>=i):
        if c<j: res=(l-2)*nny+c;
        else: res=(l-2)*nny+c-1;
        fi;
      else:
        errmessage "Function not defined";
      fi;
    else:
      errmessage "This should not happen";
    fi;
  ) res
enddef;

% This function is only used by |deleteMatrixElement.expl|
vardef isaloneoncolumn_@#(expr i,j)=
  save res;boolean res;res=true;
  for k:=1 upto @#nx:
    if (k<>i) and (known @#sb[(k-1)*@#ny+j]):
      res:=false;
    fi;
  endfor;
  res
enddef;

% This function is only used by |deleteMatrixElement.expl|
vardef isaloneonline_@#(expr i,j)=
  save res;boolean res;res=true;
  for k:=1 upto @#ny:
    if (k<>j) and (known @#sb[(i-1)*@#ny+k]):
      res:=false;
    fi;
  endfor;
  res
enddef;

% add brackets to an object
% the left bracket is |left| and the right bracket is |right|
vardef bracketit.expl(suffix $)(expr left,right)=
  save ratio;numeric ratio;
  ratio=ypart($n-$s)/ypart(urcorner left-lrcorner left);
  settodefaultifnotknown_("labshift")(pair)
             ((-.5ratio*xpart(urcorner left-ulcorner left),0));
  ObjLabel.$(left scaled ratio) "labpoint(w)";
  ratio:=ypart($n-$s)/ypart(urcorner right-lrcorner right);
  o_labshift_val:=(.5ratio*xpart(urcorner right-ulcorner right),0);
  ObjLabel.$(right scaled ratio) "labpoint(e)";
enddef;

%=====================================================================
% Definitions specific to the |EmptyBox| class

% |@#| is a name for a box (must be a suffix)
% |@#| will be the number of the box, but will also be used
% as a prefix for other variables.
vardef newEmptyBox@#(expr dx,dy) text options= 
  ExecuteOptions(@#)(options);
  assignObj(@#,"EmptyBox");
  StandardInterface;
  ObjCode StandardEquations,
          "@#ise-@#isw=(" & decimal dx & ",0)", 
          "@#ine-@#ise=(0," & decimal dy & ")"; 
enddef;

% shortcut (PSTricks compatibility)
def Tn=
  new_EmptyBox(0,0)
enddef;

streamline("EmptyBox")("(expr dx,dy)","(dx,dy)");

def BpathEmptyBox(suffix n)=StandardBpath(n) enddef;

def drawEmptyBox(suffix n)=
  if show_empty_boxes:
    drawFramedOrFilledObject_(n);
  fi;
  drawMemorizedPaths_(n);
enddef;

setObjectDefaultOption("EmptyBox")("filled")(false);
setObjectDefaultOption("EmptyBox")("fillcolor")(black);
setObjectDefaultOption("EmptyBox")("framed")(false);
setObjectDefaultOption("EmptyBox")("framewidth")(.5bp);
setObjectDefaultOption("EmptyBox")("framecolor")(black);
setObjectDefaultOption("EmptyBox")("framestyle")("");
setObjectDefaultOption("EmptyBox")("shadow")(false); % no shadow by default
setObjectDefaultOption("EmptyBox")("shadowcolor")(black);


% |HRazor| and |VRazor| are just wrappers around the |EmptyBox| class
vardef newHRazor@#(expr dx) text options =newEmptyBox@#(dx,0) options enddef;
vardef new_HRazor(expr dx)= new_EmptyBox(dx,0) enddef;
vardef newVRazor@#(expr dy) text options =newEmptyBox@#(0,dy) options enddef;
vardef new_VRazor(expr dy)= new_EmptyBox(0,dy) enddef;

% Moreover, we define two handy abbreviations for the streamlined versions:
def HR(expr dx)=new_HRazor(dx) enddef;
def VR(expr dy)=new_VRazor(dy) enddef;

%=====================================================================
% Definitions specific to the |RandomBox| class
% A class ``|RandomBox|'' with four random points. 

% |@#| is a name for a box (must be a suffix)
% |@#| will be the number of the box, but will also be used
% as a prefix for other variables.
% |wd| is the width, |ht| the height, and |dx| and |dy| are
% maximum allowed variations. Then to each point are
% added |(uniformdeviate(dx),uniformdeviate(dy))|
vardef newRandomBox@#(expr wd,ht,dx,dy) text options= 
  ExecuteOptions(@#)(options);
  assignObj(@#,"RandomBox");
  StandardInterface;
  % The random calculations are done only once, when the object
  % is created. So, there are no problems for duplicating such
  % an object.
  ObjCode MinimumStandardEquations,
    "xpart(@#ine)-xpart(@#inw)=" & decimal (wd+uniformdeviate(dx)-dx/2),
    "xpart(@#ise)-xpart(@#inw)=" & decimal (wd+uniformdeviate(dx)-dx/2),
    "xpart(@#isw)-xpart(@#inw)=" & decimal (uniformdeviate(dx)-dx/2),
    "ypart(@#inw)-ypart(@#ine)=" & decimal (uniformdeviate(dy)-dy/2),
    "ypart(@#inw)-ypart(@#ise)=" & decimal (ht+uniformdeviate(dy)-dy/2),
    "ypart(@#inw)-ypart(@#isw)=" & decimal (ht+uniformdeviate(dy)-dy/2);
enddef;

streamline("RandomBox")("(expr wd,ht,dx,dy)","(wd,ht,dx,dy)");

def BpathRandomBox(suffix n)=StandardBpath(n) enddef;

def drawRandomBox(suffix n)=
  drawFramedOrFilledObject_(n);
  drawMemorizedPaths_(n);
enddef;

setObjectDefaultOption("RandomBox")("filled")(false);
setObjectDefaultOption("RandomBox")("fillcolor")(black);
setObjectDefaultOption("RandomBox")("framed")(true);
setObjectDefaultOption("RandomBox")("framewidth")(.5bp);
setObjectDefaultOption("RandomBox")("framecolor")(black);
setObjectDefaultOption("RandomBox")("framestyle")("");
setObjectDefaultOption("RandomBox")("shadow")(false); % no shadow by default
setObjectDefaultOption("RandomBox")("shadowcolor")(black);

%=====================================================================
% Definitions specific to the |RecursiveBox| class
% A class ``|RecursiveBox|'' with four points. 

% A constructor initializing a box containing |n| levels of itself.
% |@#| is a name for a box (must be a suffix)
% |@#| will be the number of the box, but will also be used
% as a prefix for other variables.
vardef newRecursiveBox@#(expr n) text options= 
  ExecuteOptions(@#)(options);
  assignObj(@#,"RecursiveBox");
  StandardInterface;
  % we create a subobject only when |n|>0
  if n>0:
    % we find a name for the subobject:
    SubObject(sub,obj(newobjstring_));
    % and we continue to create the hierarchy:
    newRecursiveBox.obj(@#sub)(n-1);
    rotateObj(obj(@#sub),OptionValue@#("rotangle"));
    % the equations are slightly adapted from |newBB|:
    ObjCode StandardEquations,
     "save lftmost,rtmost,topmost,botmost;",
     "string lftmost,rtmost,topmost,botmost;",
     "lftmost=find_lft_most.obj(@#sub);",
     "rtmost =find_rt_most.obj(@#sub);",
     "topmost=find_top_most.obj(@#sub);",
     "botmost=find_bot_most.obj(@#sub);",
     "xpart(@#inw)=xpart(obj(@#sub).obj(lftmost));",
     "xpart(@#ine)=xpart(obj(@#sub).obj(rtmost));",
     "ypart(@#inw)=ypart(obj(@#sub).obj(topmost));",
     "ypart(@#isw)=ypart(obj(@#sub).obj(botmost));";
  else:
    ObjCode StandardEquations,
      "@#ise-@#isw=(" & decimal (OptionValue@#("dx")) & ",0)", 
      "@#ine-@#ise=(0," & decimal (OptionValue@#("dy")) & ")";
  fi;
  StandardTies;
enddef;

streamline("RecursiveBox")("(expr n)","(n)");

def BpathRecursiveBox(suffix n)=StandardBpath(n) enddef;

def drawRecursiveBox(suffix n)=
  drawFramedOrFilledObject_(n);
  if known n.sub:  
    drawObj(obj(n.sub));
  fi;
  drawMemorizedPaths_(n);
enddef;

setObjectDefaultOption("RecursiveBox")("filled")(false);
setObjectDefaultOption("RecursiveBox")("fillcolor")(black);
setObjectDefaultOption("RecursiveBox")("framed")(true);
setObjectDefaultOption("RecursiveBox")("framewidth")(.5bp);
setObjectDefaultOption("RecursiveBox")("framecolor")(black);
setObjectDefaultOption("RecursiveBox")("framestyle")("");
setObjectDefaultOption("RecursiveBox")("dx")(5cm);
setObjectDefaultOption("RecursiveBox")("dy")(5cm);
setObjectDefaultOption("RecursiveBox")("rotangle")(10);
setObjectDefaultOption("RecursiveBox")("shadow")(false); % no shadow by default
setObjectDefaultOption("RecursiveBox")("shadowcolor")(black);

%=====================================================================
% Definitions specific to the |VonKochFlake| class
% This class draws a generic Von Koch flake.

% |@#| is a name for a box (must be a suffix)
% |@#| will be the number of the box, but will also be used
% as a prefix for other variables.
vardef newVonKochFlake@#(expr n) text options= 
  ExecuteOptions(@#)(options);
  assignObj(@#,"VonKochFlake");
  StandardInterface;
  % define a triangle
  ObjPoint A,B,C;
  save p;
  pair p[];
  % Compute the three vertices:
  p2-p1=(10cm,0);p3-p1=(p2-p1) rotated 60;
  % we create subobjects only when |n|>0
  if n>0:
    % we find names for the three subobjects
    %  (one for each side of the triangle)
    SubObject(suba,obj(newobjstring_));
    SubObject(subb,obj(newobjstring_));
    SubObject(subc,obj(newobjstring_));
    % and we continue to create the hierarchy:
    newVonKochSide.obj(@#suba)(p1,p2,n-1);
    newVonKochSide.obj(@#subb)(p2,p3,n-1);
    newVonKochSide.obj(@#subc)(p3,p1,n-1);
    ObjCode StandardEquations,
      "@#B-@#A=(" & decimal xpart(p2-p1) & "," & decimal ypart(p2-p1) & ")",
      "@#C-@#A=(" & decimal xpart(p3-p1) & "," & decimal ypart(p3-p1) & ")",
      "@#A=@#isw","@#B=@#ise", "ypart(@#C)=ypart(@#inw)",
      "@#A=obj(@#suba).A=obj(@#subc).E",
      "@#B=obj(@#suba).E=obj(@#subb).A",
      "@#C=obj(@#subb).E=obj(@#subc).A";
  else:    
    ObjCode StandardEquations,
      "@#B-@#A=(" & decimal xpart(p2-p1) & "," & decimal ypart(p2-p1) & ")",
      "@#C-@#A=(" & decimal xpart(p3-p1) & "," & decimal ypart(p3-p1) & ")",
      "@#A=@#isw","@#B=@#ise","ypart(@#C)=ypart(@#inw)";
  fi;
  StandardTies;
enddef;

streamline("VonKochFlake")("(expr n)","(n)");

def BpathVonKochFlake(suffix n)=n.A--n.B--n.C--cycle enddef;

def drawVonKochFlake(suffix n)=
  if known n.suba:drawObj(obj(n.suba));else: draw n.A--n.B;fi;
  if known n.subb:drawObj(obj(n.subb));else: draw n.B--n.C;fi;
  if known n.subc:drawObj(obj(n.subc));else: draw n.C--n.A;fi;
  drawMemorizedPaths_(n);
enddef;

%=====================================================================
% Definitions specific to the |VonKochSide| class
% This class draws a generic Von Koch flake side.

% |@#| is a name for a box (must be a suffix)
% |@#| will be the number of the box, but will also be used
% as a prefix for other variables.
vardef newVonKochSide@#(expr pa,pb,n) text options= 
  ExecuteOptions(@#)(options);
  assignObj(@#,"VonKochSide");
  StandardInterface;
  % define a triangle
  ObjPoint A,B,C,D,E;
  save p;
  pair p[];
  % Compute the five vertices:
  p1=pa;p5=pb;p2-p1=p4-p2=p5-p4=(p4-p3) rotated -60=(p3-p2) rotated 60;
  % we create subobjects only when |n|>0
  if n>0:
    % we find names for the four subobjects
    %  (one for each of the subdivision of the sides)
    SubObject(suba,obj(newobjstring_));
    SubObject(subb,obj(newobjstring_));
    SubObject(subc,obj(newobjstring_));
    SubObject(subd,obj(newobjstring_));
    % and we continue to create the hierarchy:
    newVonKochSide.obj(@#suba)(p1,p2,n-1);
    newVonKochSide.obj(@#subb)(p2,p3,n-1);
    newVonKochSide.obj(@#subc)(p3,p4,n-1);
    newVonKochSide.obj(@#subd)(p4,p5,n-1);
    ObjCode StandardEquations,
      "@#B-@#A=(" & decimal xpart(p2-p1) & "," & decimal ypart(p2-p1) & ")",
      "@#C-@#A=(" & decimal xpart(p3-p1) & "," & decimal ypart(p3-p1) & ")",
      "@#D-@#A=(" & decimal xpart(p4-p1) & "," & decimal ypart(p4-p1) & ")",
      "@#E-@#A=(" & decimal xpart(p5-p1) & "," & decimal ypart(p5-p1) & ")",
      "@#isw=@#A","@#ine=@#E",
      "@#A=obj(@#suba).A",
      "@#B=obj(@#suba).E=obj(@#subb).A",
      "@#C=obj(@#subb).E=obj(@#subc).A",
      "@#D=obj(@#subc).E=obj(@#subd).A",
      "@#E=obj(@#subd).E";
  else:
    ObjCode StandardEquations,
      "@#B-@#A=(" & decimal xpart(p2-p1) & "," & decimal ypart(p2-p1) & ")",
      "@#C-@#A=(" & decimal xpart(p3-p1) & "," & decimal ypart(p3-p1) & ")",
      "@#D-@#A=(" & decimal xpart(p4-p1) & "," & decimal ypart(p4-p1) & ")",
      "@#E-@#A=(" & decimal xpart(p5-p1) & "," & decimal ypart(p5-p1) & ")",
      "@#isw=(xpart(@#A),ypart(@#A))", "@#ine=(xpart(@#E),ypart(@#E))";
  fi;
  StandardTies;
enddef;

streamline("VonKochSide")("(expr pa,pb,n)","(pa,pb,n)");

def BpathVonKochSide(suffix n)=n.A--n.B--n.C--n.D--n.E enddef;

def drawVonKochSide(suffix n)=
  if known n.suba:drawObj(obj(n.suba));else: draw n.A--n.B;fi;
  if known n.subb:drawObj(obj(n.subb));else: draw n.B--n.C;fi;
  if known n.subc:drawObj(obj(n.subc));else: draw n.C--n.D;fi;
  if known n.subd:drawObj(obj(n.subd));else: draw n.D--n.E;fi;
  drawMemorizedPaths_(n);
enddef;

%=====================================================================
% Definitions specific to the |Box| class
% A class ``Box'' with four points. 

% A constructor initializing the variable |p| (picture)
% |@#| is a name for a box (must be a suffix)
% |@#| will be the number of the box, but will also be used
% as a prefix for other variables.
% |v| is either a picture, a string or an object given by its number
vardef newBox@#(expr v) text options= 
  ExecuteOptions(@#)(options);
  assignObj(@#,"Box");
  StandardInterface;
  StandardObjectOrPictureContainerSetup(v);
  if OptionValue@#("rbox_radius")>0:
    ObjPoint ene,ese,sse,ssw,wsw,wnw,nnw,nne;
    % we use paths for the rounded corners if necessary
    addPathVariables@#(_spath_);
  fi;
  if not OptionValue@#("fit"):
    @#a:=max(@#a,@#b);@#b:=@#a; % square
  fi;
  ObjCode StandardEquations,
    if numeric v:
      ".5[@#isw,@#ine]=.5[obj(@#sub)ne,obj(@#sub)sw]", % object
    elseif (picture v) or (string v):
      ".5[@#isw,@#ine]=@#p.off", % picture offset
    fi
    if OptionValue@#("rbox_radius")>0:
      "@#ine-@#nne=@#ise-@#sse=@#nnw-@#inw=@#ssw-@#isw=(" &
        decimal (OptionValue@#("rbox_radius")) & ",0)",
      "@#ine-@#ene=@#ese-@#ise=@#inw-@#wnw=@#wsw-@#isw=(0," &
        decimal (OptionValue@#("rbox_radius")) & ")",
    fi
    "@#ise-@#isw=(" & decimal (2@#a+2*OptionValue@#("dx")) & ",0)",
    "@#ine-@#ise=(0," & decimal (2@#b+2*OptionValue@#("dy")) & ")";
  StandardTies;
  if OptionValue@#("rbox_radius")>0:
    addPath@#(_spath_,1,
      @#nnw{left}..{down}@#wnw--@#wsw{down}
      ..{right}@#ssw--@#sse{right}..{up}@#ese--@#ene{up}
      ..{left}@#nne--cycle
      );
    defineBox_pathparameters(@#);
  fi;
enddef;

def defineBox_pathparameters(suffix $)=
  $_spath_.n_:=1;
  $_spath_._draw_[1]:=LocalOptionValue("cdraw","cdraw_default");
  $_spath_.visible[1]:=true;
  $_spath_.pathfilled[1]:=false;
  $_spath_.pathfillcolor[1]:=black;
  $_spath_.border[1]:=CLOV_("border");
  $_spath_.bordercolor[1]:=CLOV_("bordercolor");
  $_spath_.linewidth[1]:=OptionValue$("framewidth");
  $_spath_.linecolor[1]:=OptionValue$("framecolor");
  $_spath_.nodesepA[1]:=0;
  $_spath_.nodesepB[1]:=0;
  $_spath_.arrows[1]:="draw";
  $_spath_.linestyle[1]:=CLOV_("linestyle");
  $_spath_.doubleline[1]:=false;
  forsuffixes $$=_draw_,visible,border,bordercolor,linewidth,linecolor,
    arrows,linestyle,nodesepA,nodesepB,doubleline,pathfilled,pathfillcolor:
    $_spath_$$n_:=1;
  endfor;
enddef;
  
def Tr_(expr p)=
  new_Box_(p)("framed(false)")
enddef;

def Tf=
  new_Box_("")("filled(true)")
enddef;

vardef newRBox@#(expr v) text options=
  newBox@#(v) "rbox_radius(1mm)", options;
enddef;

vardef new_RBox(expr v)=
  new_Box_(v)("rbox_radius(1mm)")
enddef;

streamline("Box")("(expr v)","(v)");

def BpathBox(suffix n)=
  (if OptionValue.n("rbox_radius")=0:
     StandardBpath(n)
   else:
     % good curve:
     % |cycle| was added because in certain cases, |unfill| is called
     % on the path returned by |BpathBox|.
     (Path.n(_spath_,1)--cycle)
     % bad curve:     
%     (n.nnw{n.nnw-n.nne}..{n.wsw-n.wnw}n.wnw--n.wsw{n.wsw-n.wnw}
%       ..{n.sse-n.ssw}n.ssw--n.sse{n.sse-n.ssw}
%       ..{n.ene-n.ese}n.ese--n.ene{n.ene-n.ese}
%       ..{n.nnw-n.nne}n.nne--cycle)
   fi
  )
enddef;
    
def drawBox(suffix n)=
  if OptionValue.n("rbox_radius")=0:
    drawFramedOrFilledObject_(n);
  else:
    if OptionValue.n("framed"):
      if OptionValue.n("shadow"):
        fill (BpathObj(n) shifted (1mm,-1mm))
             withcolor OptionValue.n("shadowcolor");
      fi;
      unfill BpathObj(n);
    fi;
    if OptionValue.n("filled"):
      fill BpathObj(n) withcolor OptionValue.n("fillcolor");
    fi;
  fi;
  drawPictureOrObject(n);
  drawMemorizedPaths_(n);
enddef;

setObjectDefaultOption("Box")("dx")(3bp); % same value as in |boxes.mp|
setObjectDefaultOption("Box")("dy")(3bp); % same value as in |boxes.mp|
setObjectDefaultOption("Box")("filled")(false);
setObjectDefaultOption("Box")("fillcolor")(black);
setObjectDefaultOption("Box")("framed")(true);
setObjectDefaultOption("Box")("shadow")(false); % no shadow by default
setObjectDefaultOption("Box")("shadowcolor")(black);
setObjectDefaultOption("Box")("fit")(true);
setObjectDefaultOption("Box")("framewidth")(.5bp);
setObjectDefaultOption("Box")("framecolor")(black);
setObjectDefaultOption("Box")("framestyle")("");
setObjectDefaultOption("Box")("rbox_radius")(0); % after rboxes.mp
setObjectDefaultOption("Box")("picturecolor")(black);


%=====================================================================
% Definitions specific to the |Polygon| class

% A polygon, either empty, or enclosing a picture or an object |v|.
% |@#| is a name for a box (must be a suffix)
% |@#| will be the number of the box, but will also be used
% as a prefix for other variables.
% |nsides| is the number of sides
vardef newPolygon@#(expr v,nsides) text options= 
  ExecuteOptions(@#)(options);
  assignObj(@#,"Polygon");
  StandardInterface;
  StandardObjectOrPictureContainerSetup(v);
  ObjPointArray(po)(nsides);
  % we can now use |po1|, |po2|, ..., |po[nsides]|
  ObjNumeric ns;
  setNumeric(ns)(nsides); % now, we can use |@#ns| in the |ObjCode|
  % we actually define an ellipse on which we build the polygon:
  ObjNumeric cdx,cdy; % computed dx and dy
  @#cdx=@#cdy=pathsel__(@#a,@#b)(max(@#a,@#b),OptionValue@#("polymargin"),
    (@#a+d_,0){up}...(0,@#b+d_){left});
  ObjCode StandardEquations,
    if numeric v:
      ".5[@#isw,@#ine]=.5[obj(@#sub)ne,obj(@#sub)sw]", % object
    elseif (picture v) or (string v):    
      ".5[@#isw,@#ine]=@#p.off", % picture offset
    fi
    % the size of the box is related to the size of its contents
    if OptionValue@#("fit"):
      "@#ise-@#isw=(" & decimal (2@#a+2*@#cdx) & ",0)",
      "@#ine-@#ise=(0," & decimal (2@#b+2*@#cdy) & ")",
    else:
      "@#ise-@#isw=(" & decimal(2(@#a++@#b)
                                 + OptionValue@#("polymargin")) & ",0);",
      "@#ine-@#ise=(0," & decimal(2(@#a++@#b)
                                 + OptionValue@#("polymargin")) & ");",
    fi
     "save ys,op;numeric ys;",
     "def op expr $=(.5(@#ine-@#inw)) rotated $ yscaled ys enddef;",
     if OptionValue@#("fit"):
       "ys=" & decimal((@#b+@#cdy)/(@#a+@#cdx)) & ";",
     else:
       "ys=1;",
     fi
     "save k;for k:=1 upto " & decimal nsides & ":",
     "@#po[k]-.5(@#isw+@#ine)=op (" & decimal(OptionValue@#("angle")) &
                                    "+(k-1)*(360/@#ns));",
     "endfor;";
  StandardTies;
enddef;

streamline("Polygon")("(expr v,nsides)","(v,nsides)");

def BpathPolygon(suffix n)= 
  (for i:=1 upto n.po.n_: n.po[i]--endfor cycle)
enddef;

def drawPolygon(suffix n)=
  drawFramedOrFilledObject_(n);
  drawPictureOrObject(n);
  drawMemorizedPaths_(n);
enddef;

% These are all the options that can be used with a |Polygon|.
setObjectDefaultOption("Polygon")("polymargin")(2mm); 
setObjectDefaultOption("Polygon")("angle")(0); 
setObjectDefaultOption("Polygon")("filled")(false);
setObjectDefaultOption("Polygon")("fillcolor")(black);
setObjectDefaultOption("Polygon")("framed")(true);
setObjectDefaultOption("Polygon")("fit")(true);
setObjectDefaultOption("Polygon")("framewidth")(.5bp);
setObjectDefaultOption("Polygon")("framecolor")(black);
setObjectDefaultOption("Polygon")("framestyle")("");
setObjectDefaultOption("Polygon")("picturecolor")(black);
setObjectDefaultOption("Polygon")("shadow")(false); % no shadow by default
setObjectDefaultOption("Polygon")("shadowcolor")(black);

% a few common shortcuts:
vardef newTriangle@#(expr v) text options=
  newPolygon@#(v,3) options;
enddef;

vardef newSquare@#(expr v) text options=
  newPolygon@#(v,4) options;
enddef;

vardef newPentagon@#(expr v) text options=
  newPolygon@#(v,5) options;
enddef;

vardef newHexagon@#(expr v) text options=
  newPolygon@#(v,6) options;
enddef;

vardef newHeptagon@#(expr v) text options=
  newPolygon@#(v,7) options;
enddef;

vardef newOctagon@#(expr v) text options=
  newPolygon@#(v,8) options;
enddef;

vardef newEnneagon@#(expr v) text options=
  newPolygon@#(v,9) options;
enddef;

vardef newDecagon@#(expr v) text options=
  newPolygon@#(v,10) options;
enddef;


% THESE SHORTCUTS SHOULD BE STREAMLINED (OR MAYBE NOT, TO DISCOURAGE THEIR USE
% FOR THE MORE GENERIC newPolygon)


%=====================================================================
% Definitions specific to the |Ellipse| class

% A constructor initializing the variable |p| (picture)
% |@#| is a name for a box (must be a suffix)
% |@#| will be the number of the box, but will also be used
% as a prefix for other variables.
vardef newEllipse@#(expr v) text options= 
  ExecuteOptions(@#)(options);
  assignObj(@#,"Ellipse");
  StandardInterface;
  StandardObjectOrPictureContainerSetup(v);
  if not OptionValue@#("fit"):
    @#a:=max(@#a,@#b);@#b:=@#a; % circle
  fi;
  ObjNumeric cdx,cdy; % computed dx and dy
  if (@#a=0) and (@#b=0):
    @#cdx=@#cdy=OptionValue@#("circmargin");
  else:
    @#cdx=@#cdy=pathsel__(@#a,@#b)(max(@#a,@#b),OptionValue@#("circmargin"),
      (@#a+d_,0){up}...(0,@#b+d_){left});
  fi;
  if not OptionValue@#("fit"):
    % we draw a circle that fits horizontally
    @#cdx:=OptionValue@#("circmargin");
    @#cdy:=@#cdx;
  fi;
  ObjCode StandardEquations,
    if numeric v:
      ".5[@#isw,@#ine]=.5[obj(@#sub)ne,obj(@#sub)sw]", % object
    elseif (picture v) or (string v):
      ".5[@#isw,@#ine]=@#p.off", % picture offset
    fi
    "@#ise-@#isw=(" & decimal (2@#a+2*@#cdx) & ",0)", 
    "@#ine-@#ise=(0," & decimal (2@#b+2*@#cdy) & ")";
  StandardTies;
enddef;

streamline("Ellipse")("(expr v)","(v)");

% shortcut (PSTricks compatibility)
def Toval_(expr p)=
  new_Ellipse(p)
enddef;

% The function drawing the ellipse uses the current transformation
% of the object to get the right shape. However, when doing so,
% we can't use the current points, since the current transformation
% applies to the initial points... We can either inverse
% the current transform (using |inverse|) or use some information
% stored on the initial status.
vardef ellipse@#(expr a_,b_,c_,d_)=
  (fullcircle 
    xscaled (2@#a+2*@#cdx)
    yscaled (2@#b+2*@#cdy)
    transformed @#ctransform_
    shifted ((a_+c_)/2)
    )  
enddef;

def BpathEllipse(suffix n)=
  ellipse.n(n.isw,n.ise,n.ine,n.inw)
enddef;

def drawEllipse(suffix n)=
  drawFramedOrFilledObject_(n);
  drawPictureOrObject(n);
  drawMemorizedPaths_(n);
enddef;

setObjectDefaultOption("Ellipse")("circmargin")(2bp); % same value as in |boxes.mp|
setObjectDefaultOption("Ellipse")("framed")(true);
setObjectDefaultOption("Ellipse")("filled")(false);
setObjectDefaultOption("Ellipse")("fillcolor")(black);
setObjectDefaultOption("Ellipse")("fit")(true);
setObjectDefaultOption("Ellipse")("framewidth")(.5bp);
setObjectDefaultOption("Ellipse")("framecolor")(black);
setObjectDefaultOption("Ellipse")("framestyle")("");
setObjectDefaultOption("Ellipse")("picturecolor")(black);
setObjectDefaultOption("Ellipse")("shadow")(false); % no shadow by default
setObjectDefaultOption("Ellipse")("shadowcolor")(black);


%=====================================================================
% Definitions specific to the |Circle| class

vardef newCircle@#(expr v) text options= 
  ExecuteOptions(@#)(options);
  assignObj(@#,"Circle");
  StandardInterface;
  StandardObjectOrPictureContainerSetup(v);
  ObjNumeric cdx,cdy; % computed dx and dy
  if (numeric v) or (picture v) or (string v): % object or picture
    % correction of bug discovered by Stephan Hennig
    %   (comp.text.tex, 2004-03-18)
    @#cdx=(@#a++@#b)+OptionValue@#("circmargin")-@#a;
    %@#cdy=(@#a++@#b)+OptionValue@#("circmargin")-@#b; % DR 23/3/2004
    @#cdy=@#cdx+@#a-@#b; % DR 23/3/2004
    %@#cdx=@#cdy=pathsel__(@#a,@#b)(max(@#a,@#b),OptionValue@#("circmargin"),
    %  (@#a+d_,0){up}...(0,@#b+d_){left});
  else:
    @#cdx=@#cdy=OptionValue@#("circmargin");
  fi;    
  ObjCode StandardEquations,
    if numeric v:
      ".5[@#isw,@#ine]=.5[obj(@#sub)ne,obj(@#sub)sw]", % object
    elseif (picture v) or (string v):
      ".5[@#isw,@#ine]=@#p.off", % picture offset
    fi
      % correction of bug discovered by Stephan Hennig
      %   (comp.text.tex, 2004-03-18)
      % "@#ise-@#isw=(" & decimal(2*max(@#a,@#b)+2*@#cdx) % DR 23/3/2004
      "@#ise-@#isw=(" & decimal(2*(@#a+@#cdx)) % DR 23/3/2004
      %decimal(@#a++@#b+OptionValue@#("circmargin"))
      & ",0)",
      %"@#ine-@#ise=(0," & decimal(2*max(@#a,@#b)+2*@#cdy)  % DR 23/3/2004
      "@#ine-@#ise=(0," & decimal(2*(@#b+@#cdy)) % DR 23/3/2004
      %decimal(@#a++@#b+OptionValue@#("circmargin"))
      & ")";
  StandardTies;
enddef;

streamline("Circle")("(expr v)","(v)");

% shortcuts (PSTricks compatibility)
def Tcircle_(expr p)=
  new_Circle(p)
enddef;

% circle with a 1mm radius
def Tc=
  new_Circle_("")("circmargin(1mm)")
enddef;

def Tc_(expr s)=
  new_Circle_("")("circmargin(" & decimal(s) & ")")
enddef;

% filled circle with a 1mm radius
def TC=
  new_Circle_("")("filled(true)","circmargin(1mm)")
enddef;

% default filled circle
def TCs=
  new_Circle_("")("filled(true)")
enddef;

def TC_(expr s)=
  new_Circle_("")("filled(true)","circmargin(" & decimal(s) & ")")
enddef;

vardef circle@#(expr a_,b_,c_,d_)=
  (fullcircle 
    scaled 2(@#a+@#cdx)
    transformed @#ctransform_
    shifted ((a_+c_)/2)
    )  
enddef;

def BpathCircle(suffix n)=
  circle.n(n.isw,n.ise,n.ine,n.inw)
enddef;

def drawCircle(suffix n_)=
  drawFramedOrFilledObject_(n_);
  drawPictureOrObject(n_);
  drawMemorizedPaths_(n_);
enddef;

setObjectDefaultOption("Circle")("circmargin")(2bp); % same value as in |boxes.mp|
setObjectDefaultOption("Circle")("filled")(false);
setObjectDefaultOption("Circle")("fillcolor")(black);
setObjectDefaultOption("Circle")("framed")(true);
setObjectDefaultOption("Circle")("framewidth")(.5bp);
setObjectDefaultOption("Circle")("framecolor")(black);
setObjectDefaultOption("Circle")("framestyle")("");
setObjectDefaultOption("Circle")("picturecolor")(black);
setObjectDefaultOption("Circle")("shadow")(false); % no shadow by default
setObjectDefaultOption("Circle")("shadowcolor")(black);

%=====================================================================
% Double Box
vardef newDBox@#(expr v) text options= 
  ExecuteOptions(@#)(options);
  assignObj(@#,"DBox");
  StandardInterface;
  StandardObjectOrPictureContainerSetup(v);
  if not OptionValue@#("fit"):
    @#a:=max(@#a,@#b);@#b:=@#a; % square
  fi;
  ObjPoint swi,nwi,sei,nei;
  ObjCode StandardEquations,
    if numeric v:
      ".5[@#isw,@#ine]=.5[obj(@#sub)ne,obj(@#sub)sw]", % object
    elseif (picture v) or (string v):
      ".5[@#isw,@#ine]=@#p.off", % picture offset
    fi
    % inner/outer:
    "@#isw-@#swi=@#nei-@#ine=(-" & decimal(OptionValue@#("hsep")) & ",-" &
           decimal(OptionValue@#("vsep"))  & ");", 
    "@#ise-@#sei=@#nwi-@#inw=(" & decimal(OptionValue@#("hsep")) & ",-" &
           decimal(OptionValue@#("vsep"))  & ");", 
     % the size of the inner box is related to the size of its contents
    "@#sei-@#swi=(" & decimal(2@#a+2*OptionValue@#("dx")) & ",0)",
    "@#nei-@#sei=(0," & decimal(2@#b+2*OptionValue@#("dy")) & ")";
  StandardTies;
enddef;

streamline("DBox")("(expr v)","(v)");

def BpathDBox(suffix n)=StandardBpath(n) enddef;

def drawDBox(suffix n)=
  drawFramedOrFilledObject_(n);
  if OptionValue.n("framed"):
    draw n.swi--n.sei--n.nei--n.nwi--cycle
      withcolor OptionValue.n("framecolor") sc_(OptionValue.n("framestyle"));
  fi;
  drawPictureOrObject(n);
  drawMemorizedPaths_(n);
enddef;

setObjectDefaultOption("DBox")("filled")(false);
setObjectDefaultOption("DBox")("fillcolor")(black);
setObjectDefaultOption("DBox")("framed")(true);
setObjectDefaultOption("DBox")("hsep")(1mm);
setObjectDefaultOption("DBox")("vsep")(1mm);
setObjectDefaultOption("DBox")("dx")(3bp); % same value as in |boxes.mp|
setObjectDefaultOption("DBox")("dy")(3bp); % same value as in |boxes.mp|
setObjectDefaultOption("DBox")("fit")(true);
setObjectDefaultOption("DBox")("framewidth")(.5bp);
setObjectDefaultOption("DBox")("framecolor")(black);
setObjectDefaultOption("DBox")("framestyle")("");
setObjectDefaultOption("DBox")("picturecolor")(black);
setObjectDefaultOption("DBox")("shadow")(false); % no shadow by default
setObjectDefaultOption("DBox")("shadowcolor")(black);

%=====================================================================
% Double Ellipse
vardef newDEllipse@#(expr v) text options= 
  ExecuteOptions(@#)(options);
  assignObj(@#,"DEllipse");
  StandardInterface;
  StandardObjectOrPictureContainerSetup(v);
  if not OptionValue@#("fit"):
    @#a:=max(@#a,@#b);@#b:=@#a; % circle
  fi;
  ObjPoint swi,nwi,sei,nei;
  ObjNumeric cdx,cdy; % computed dx and dy
  @#a:=@#a+OptionValue@#("hsep");@#b:=@#b+OptionValue@#("vsep");
  if (@#a=0) and (@#b=0):
    @#cdx=@#cdy=OptionValue@#("circmargin");
  else:
    @#cdx=@#cdy=pathsel__(@#a,@#b)(max(@#a,@#b),OptionValue@#("circmargin"),
      (@#a+d_,0){up}...(0,@#b+d_){left});
  fi;
  if not OptionValue@#("fit"):
    % we draw a circle that fits horizontally
    @#cdx:=OptionValue@#("circmargin");
    @#cdy:=@#cdx;
  fi;
  ObjCode StandardEquations,
     if numeric v:
      ".5[@#isw,@#ine]=.5[obj(@#sub)ne,obj(@#sub)sw]", % object
     elseif (picture v) or (string v):
      ".5[@#isw,@#ine]=@#p.off", % picture offset
     fi
     % inner/outer:
     "@#isw-@#swi=@#nei-@#ine=(-" & decimal(OptionValue@#("hsep")) & ",-" &
           decimal(OptionValue@#("vsep"))  & ");", 
     "@#ise-@#sei=@#nwi-@#inw=(" & decimal(OptionValue@#("hsep")) & ",-" &
           decimal(OptionValue@#("vsep"))  & ");",  
     "@#ise-@#isw=(" & decimal(2@#a+2*@#cdx) & ",0)",
     "@#ine-@#ise=(0," & decimal(2@#b+2*@#cdx) & ")";  
  StandardTies;
enddef;

streamline("DEllipse")("(expr v)","(v)");

vardef innerellipse@#(expr a_,b_,c_,d_)=
  (fullcircle 
    xscaled (2@#a+2*@#cdx-2*OptionValue@#("hsep"))
    yscaled (2@#b+2*@#cdx-2*OptionValue@#("vsep"))
    transformed @#ctransform_
    shifted ((a_+c_)/2)
    )  
enddef;

def BpathDEllipse(suffix n)=BpathEllipse(n) enddef;

def drawDEllipse(suffix n)=
  drawFramedOrFilledObject_(n);
  if OptionValue.n("framed"):
    draw innerellipse.n(n.swi,n.sei,n.nei,n.nwi)
      withcolor OptionValue.n("framecolor") sc_(OptionValue.n("framestyle"));
  fi;
  drawPictureOrObject(n);
  drawMemorizedPaths_(n);
enddef;

setObjectDefaultOption("DEllipse")("circmargin")(2bp); % same value as in |boxes.mp|
setObjectDefaultOption("DEllipse")("filled")(false);
setObjectDefaultOption("DEllipse")("fillcolor")(black);
setObjectDefaultOption("DEllipse")("framed")(true);
setObjectDefaultOption("DEllipse")("hsep")(1mm);
setObjectDefaultOption("DEllipse")("vsep")(1mm);
setObjectDefaultOption("DEllipse")("fit")(true);
setObjectDefaultOption("DEllipse")("framewidth")(.5bp);
setObjectDefaultOption("DEllipse")("framecolor")(black);
setObjectDefaultOption("DEllipse")("framestyle")("");
setObjectDefaultOption("DEllipse")("picturecolor")(black);
setObjectDefaultOption("DEllipse")("shadow")(false); % no shadow by default
setObjectDefaultOption("DEllipse")("shadowcolor")(black);

% It would of course be easy to create triple boxes, triple circles, etc.

%=====================================================================
% The Container class was suggested by Michael Schwarz
% (<mi-schwarz@gmx.de>)
% (Emails from May 20, 2006)
% THIS CODE HAS NOT YET BEEN CHECKED (added October 8, 2006)
% CODE IMPROVED ON December 3, 2006.

setObjectDefaultOption("Container")("filled")(false);
setObjectDefaultOption("Container")("fillcolor")(black);
setObjectDefaultOption("Container")("framed")(false);
setObjectDefaultOption("Container")("framewidth")(.5bp);
setObjectDefaultOption("Container")("framecolor")(black);
setObjectDefaultOption("Container")("framestyle")("");
setObjectDefaultOption("Container")("shadow")(false);
setObjectDefaultOption("Container")("shadowcolor")(black);
setObjectDefaultOption("Container")("dx")(0);
setObjectDefaultOption("Container")("dy")(0);

vardef newContainer@#(text sublist) text options =
  save i,topC, botC, lftC, rtC, topS, botS, lftS, rtS, floating,
       n, firstsub, $;
  boolean floating;
  string firstsub; 
  ExecuteOptions(@#)(options);
  assignObj(@#,"Container");
  StandardInterface;

  n:=0;
  forsuffixes $=sublist:
    if incr(n)=1 : firstsub:= str $; fi;
  endfor;
  ObjSubArray(sub_)(n); % |n| is the number of elements
  i=0;
  forsuffixes $:=sublist:i:=i+1;
    SubObjectOfArray(sub_[i],$);
  endfor;

  if known(obj(firstsub).c):
    floating := false;
  else:
    floating := true;
    obj(firstsub).scantokens(firstPointOf_(firstsub)) = origin;
  fi;

  forsuffixes $=sublist:
    topS := findrec_top_most.$;
    botS := findrec_bot_most.$;
    lftS := findrec_lft_most.$;
    rtS := findrec_rt_most.$;
    if known topC:
      if topS > topC : topC := topS; fi;
    else:
      topC := topS;
    fi;

    if known botC:
      if botS < botC : botC := botS; fi;
    else:
      botC := botS;
    fi;

    if known lftC:
      if lftS < lftC : lftC := lftS; fi;
    else:
      lftC := lftS;
    fi;

    if known rtC:
      if rtS > rtC : rtC := rtS; fi;
    else:
      rtC := rtS;
    fi;
  endfor;

  ObjCode StandardEquations,
            "@#nw = (" & decimal (lftC-OptionValue@#("dx")) & "," &
            decimal (topC+OptionValue@#("dy")) & ")",
            "@#se = (" & decimal (rtC+OptionValue@#("dx")) & "," &
            decimal (botC-OptionValue@#("dy")) & ")";
  StandardTies;
  if floating: untieObj(@#); fi;
enddef;

streamline("Container")("(text t)")("suffixlist(t)");

def BpathContainer(suffix n)= StandardBpath(n) enddef;

vardef drawContainer(suffix n) =
  save i;
  drawFramedOrFilledObject_(n);
    for i=1 upto n.sub_.n_:
      drawObj(obj(n.sub_[i]));
    endfor;
  drawMemorizedPaths_(n);
enddef;


%=====================================================================
% Definitions specific to the |BB| class (Bounding Box)
% Sometimes, we want to make a new object hiding the positions
% of an object. For instance, if we rotate an object upside down,
% the |.s| component will be at the top, etc., and this is likely
% to produce unwanted effects when such an object is a subobject
% somewhere. One solution is to move the bounding points,
% without moving the contents (with respect to the whole bounding box).
% This may be a problem if the drawing macros of the object rely
% on the bounding box (which would be bad practice).
% So here we provide another solution which is simply a class
% to encapsulate cleanly a strange object. This class merely adds a layer.
%
% The computation of the new bounding box only looks at the corners
% of the object, not at other points or subobjects. |rebindObj| might
% be used to ensure that nothing protrudes.

vardef newBB@#(suffix t) text options=
  ExecuteOptions(@#)(options);
  assignObj(@#,"BB");
  StandardInterface;
  SubObject(sub,t);
  % We inject the following in the equations, using |obj(@#sub)|
  % instead of |t|, so that |resetObj.expl|, or any other function
  % using the object code, can reexecute the function code.
  %   |lftmost=find_lft_most.t;|
  %   |rtmost =find_rt_most.t;|
  %   |topmost=find_top_most.t;|
  %   |botmost=find_bot_most.t;|
  % The equations are now:
  % |xpart(@#nw)=xpart(obj(@#sub).obj(lftmost))|
  % |xpart(@#ne)=xpart(obj(@#sub).obj(rtmost))|
  % |ypart(@#nw)=ypart(obj(@#sub).obj(topmost))|
  % |ypart(@#sw)=ypart(obj(@#sub).obj(botmost))|
  % (the other points are found with the standard equations)
  ObjCode StandardEquations,
     "save lftmost,rtmost,topmost,botmost;",
     "string lftmost,rtmost,topmost,botmost;",
     "lftmost=find_lft_most.obj(@#sub);",
     "rtmost =find_rt_most.obj(@#sub);",
     "topmost=find_top_most.obj(@#sub);",
     "botmost=find_bot_most.obj(@#sub);",
     "xpart(@#inw)=xpart(obj(@#sub).obj(lftmost));",
     "xpart(@#ine)=xpart(obj(@#sub).obj(rtmost));",
     "ypart(@#inw)=ypart(obj(@#sub).obj(topmost));",
     "ypart(@#isw)=ypart(obj(@#sub).obj(botmost));";
  StandardTies;
enddef;

% create a streamlined version
streamline("BB")("(expr t)","suffixpar(t)");

def BpathBB(suffix n)= StandardBpath(n) enddef;

def drawBB(suffix n)=
  drawFramedOrFilledObject_(n);
  drawObj(obj(n.sub));
  drawMemorizedPaths_(n);
enddef;

setObjectDefaultOption("BB")("filled")(false);
setObjectDefaultOption("BB")("fillcolor")(black);
setObjectDefaultOption("BB")("framed")(false);
setObjectDefaultOption("BB")("framewidth")(.5bp);
setObjectDefaultOption("BB")("framecolor")(black);
setObjectDefaultOption("BB")("framestyle")("");
setObjectDefaultOption("BB")("shadow")(false); % no shadow by default
setObjectDefaultOption("BB")("shadowcolor")(black);

endinput