home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 5 Edit / 05-Edit.zip / texlatex.zip / txmflb75.zip / share / texmf / metapost / base / boxes.mp next >
Text File  |  1996-03-26  |  7KB  |  260 lines
  1. % Macros for boxes
  2.  
  3.  
  4. % Find the length of the prefix of string s for which cond is true for each
  5. % character c of the prefix
  6. vardef str_prefix(expr s)(text cond) =
  7.   save i_, c; string c;
  8.   i_ = 0;
  9.   forever:
  10.     c := substring (i_,i_+1) of s;
  11.     exitunless cond;
  12.     exitif incr i_=length s;
  13.   endfor
  14.   i_
  15. enddef;
  16.  
  17. % Take a string returned by the str operator and return the same string
  18. % with explicit numeric subscripts replaced by generic subscript symbols [].
  19. vardef generisize(expr ss) =
  20.   save res, s, l; string res, s;
  21.   res = "";             % result so far
  22.   s = ss;               % left to process
  23.   forever: exitif s="";
  24.     l := str_prefix(s, (c<>"[") and ((c<"0") or (c>"9")));
  25.     res := res & substring (0,l) of s;
  26.     s := substring (l,infinity) of s;
  27.     if s<>"":
  28.       res := res & "[]";
  29.       l := if s>="[":  1 + str_prefix(s, c<>"]")
  30.            else:  str_prefix(s, (c=".") or ("0"<=c) and (c<="9"))
  31.            fi;
  32.       s := substring(l,infinity) of s;
  33.     fi
  34.   endfor
  35.   res
  36. enddef;
  37.  
  38.  
  39. % Make sure the string _n_gen_ is generisize(_n_):
  40. vardef set_n_gen_ =
  41.   if _n_ <> _n_cur_:
  42.     _n_cur_:=_n_;
  43.     _n_gen_:=generisize(_n_);
  44.   fi
  45. enddef;
  46.  
  47. string _n_, _n_cur_, _n_gen_;
  48. _n_cur_ := "]";              % this won't match _n_
  49.  
  50.  
  51. % Given a type t and list of variable names vars, make sure that they are
  52. % of type t and redeclare them as necessary.  In the vars list _n represents
  53. % scantokens _n_, a suffix that might contain numeric subscripts.
  54. % This suffix needs to be replaced by scantokens _n_gen_ in order to get
  55. % a variable that can be declared to be of type t.
  56. vardef generic_declare(text t) text vars =
  57.   set_n_gen_;
  58.   forsuffixes v_=vars:
  59.     if  forsuffixes _n=scantokens _n_: not t v_ endfor:
  60.       def _gdmac_ text _n = t v_ enddef;
  61.       expandafter _gdmac_ scantokens _n_gen_;
  62.     fi
  63.   endfor
  64. enddef;
  65.  
  66. % Here is another version that redeclares the vars even if they are already
  67. % of the right type.
  68. vardef generic_redeclare(text t) text vars =
  69.   set_n_gen_;
  70.   def _gdmac_ text _n = t vars enddef;
  71.   expandafter _gdmac_ scantokens _n_gen_;
  72. enddef;
  73.  
  74.  
  75.  
  76.  
  77.  
  78.  
  79.  
  80. % pp should be a string giving the name of a macro that finds the boundary path
  81. % sp should be a string that names a macro for fixing the size and shape
  82. % The suffix $ is the name of the box
  83. % The text t gives the box contents: either empty, a picture, or a string to
  84. % typeset
  85. def beginbox_(expr pp,sp)(suffix $)(text t) =
  86.   _n_ := str $;
  87.   generic_declare(pair) _n.off, _n.c;
  88.   generic_declare(string) pproc_._n, sproc_._n;
  89.   generic_declare(picture) pic_._n;
  90.   pproc_$:=pp; sproc_$:=sp;
  91.   pic_$ = nullpicture;
  92.   for _p_=t:
  93.     pic_$:=
  94.       if picture _p_: _p_
  95.       else: _p_ infont defaultfont scaled defaultscale
  96.       fi;
  97.   endfor
  98.   $c = $off + .5[llcorner pic_$, urcorner pic_$]
  99. enddef;
  100.  
  101.  
  102. % The suffix cl names a vardef macro that clears box-related variables
  103. % The suffix $ is the name of the box being ended.
  104. def endbox_(suffix cl, $) =
  105.   if known pic_.prevbox: _dojoin(prevbox,$); fi
  106.   def prevbox = $ enddef;
  107.   expandafter def expandafter clearboxes expandafter =
  108.     clearboxes cl($);
  109.   enddef
  110. enddef;
  111.  
  112.  
  113. % Text t gives equations for joining box a to box b.
  114. def boxjoin(text t) =
  115.   def prevbox=_ enddef;
  116.   def _dojoin(suffix a,b) = t enddef;
  117. enddef;
  118.  
  119.  
  120. extra_beginfig := extra_beginfig
  121.   & "boxjoin();save pic_,sproc_,pproc_;def clearboxes=enddef;";
  122. extra_endfig := extra_endfig & "clearboxes";
  123.  
  124.  
  125. % Given a list of box names, give whatever default values are necessary
  126. % in order to fix the size and shape of each box.
  127. vardef fixsize(text t) =
  128.   forsuffixes $=t:  scantokens sproc_$($);  endfor
  129. enddef;
  130.  
  131.  
  132. % Given a list of box names, give default values for any unknown positioning
  133. % offsets
  134. vardef fixpos(text t) =
  135.   forsuffixes $=t:
  136.     if unknown xpart $.off:  xpart $.off=0; fi
  137.     if unknown ypart $.off:  ypart $.off=0; fi
  138.   endfor
  139. enddef;
  140.  
  141.  
  142. % Return the boundary path for the given box
  143. vardef bpath suffix $ =
  144.   fixsize($); fixpos($);
  145.   scantokens pproc_$($)
  146. enddef;
  147.  
  148.  
  149. % Return the contents of the given box.  First define a private version that
  150. % the user can't accidently clobber.
  151. vardef pic_mac_ suffix $ =
  152.   fixsize($); fixpos($);
  153.   pic_$ shifted $off
  154. enddef;
  155.  
  156. vardef pic suffix $ = pic_mac_ $ enddef;
  157.  
  158.  
  159. def drawboxed(text t) =         % Draw each box
  160.   fixsize(t); fixpos(t);
  161.   forsuffixes s=t: draw pic_mac_.s; draw bpath.s; endfor
  162. enddef;
  163.  
  164. def drawunboxed(text t) =       % Draw contents of each box
  165.   fixsize(t); fixpos(t);
  166.   forsuffixes s=t: draw pic_mac_.s; endfor
  167. enddef;
  168.  
  169. def drawboxes(text t) =         % Draw boundary path for each box
  170.   forsuffixes s=t: draw bpath.s; endfor
  171. enddef;
  172.  
  173.  
  174.  
  175.  
  176.  
  177. % Rectangular boxes
  178.  
  179. newinternal defaultdx, defaultdy;
  180. defaultdx := defaultdy := 3bp;
  181.  
  182. vardef boxit@#(text tt) =
  183.   beginbox_("boxpath_","sizebox_",@#,tt);
  184.   generic_declare(pair) _n.sw, _n.s, _n.se, _n.e, _n.ne, _n.n, _n.nw, _n.w;
  185.   0 = xpart (@#nw-@#sw) = ypart(@#se-@#sw);
  186.   0 = xpart(@#ne-@#se) = ypart(@#ne-@#nw);
  187.   @#w = .5[@#nw,@#sw];
  188.   @#s = .5[@#sw,@#se];
  189.   @#e = .5[@#ne,@#se];
  190.   @#n = .5[@#ne,@#nw];
  191.   @#ne-@#c = @#c-@#sw = (@#dx,@#dy) + .5*(urcorner pic_@# - llcorner pic_@#);
  192.   endbox_(clearb_,@#);
  193. enddef;
  194.  
  195. def boxpath_(suffix $) =
  196.   $.sw -- $.se -- $.ne -- $.nw -- cycle
  197. enddef;
  198.  
  199. def sizebox_(suffix $) =
  200.   if unknown $.dx: $.dx=defaultdx; fi
  201.   if unknown $.dy: $.dy=defaultdy; fi
  202. enddef;
  203.  
  204. vardef clearb_(suffix $) =
  205.   _n_ := str $;
  206.   generic_redeclare(numeric) _n.sw, _n.s, _n.se, _n.e, _n.ne, _n.n, _n.nw, _n.w,
  207.     _n.c, _n.off, _n.dx, _n.dy;
  208. enddef;
  209.  
  210.  
  211.  
  212.  
  213.  
  214. % Circular and oval boxes
  215.  
  216. newinternal circmargin; circmargin:=2bp;  % default clearance for picture corner
  217.  
  218. vardef circleit@#(text tt) =
  219.   beginbox_("thecirc_","sizecirc_",@#,tt);
  220.   generic_declare(pair) _n.n, _n.s, _n.e, _n.w;
  221.   @#e-@#c = @#c-@#w = (@#dx,0) + .5*(lrcorner pic_@#-llcorner pic_@#);
  222.   @#n-@#c = @#c-@#s = (0,@#dy) + .5*(ulcorner pic_@#-llcorner pic_@#);
  223.   endbox_(clearc_,@#);
  224. enddef;
  225.  
  226. def thecirc_(suffix $) =
  227.   $.e{up} ... $.n{left} ... $.w{down} ... $.s{right} ... cycle
  228. enddef;
  229.  
  230. vardef clearc_(suffix $) =
  231.   _n_ := str $;
  232.   generic_redeclare(numeric) _n.n, _n.s, _n.e, _n.w, _n.c, _n.off, _n.dx, _n.dy;
  233. enddef;
  234.  
  235. vardef sizecirc_(suffix $) =
  236.   save a_, b_;
  237.   (a_,b_) = .5*(urcorner pic_$ - llcorner pic_$);
  238.   if unknown $dx:
  239.     if unknown $dy:
  240.       if unknown($dy-$dx): a_+$dx=b_+$dy; fi
  241.       if a_+$dx=b_+$dy: a_+$dx = a_++b_ + circmargin;
  242.       else: $dx =
  243.         pathsel_(max(a_,b_+$dx-$dy), (a_+d_,0){up}...(0,b_+d_+$dy-$dx){left});
  244.       fi
  245.     else: $dx = pathsel_(a_, (a_+d_,0){up}...(0,b_+$dy){left});
  246.     fi
  247.   elseif unknown $dy:
  248.     $dy = pathsel_(b_, (a_+$dx,0){up}...(0,b_+d_){left});
  249.   fi
  250. enddef;
  251.  
  252. vardef pathsel_(expr dhi)(text tt) =
  253.   save f_, p_; path p_;
  254.   p_ = origin..(a_,b_)+circmargin*unitvector(a_,b_);
  255.   vardef f_(expr d_) =
  256.     xpart((tt) intersectiontimes p_) >= 0
  257.   enddef;
  258.   solve f_(0,dhi+1.5circmargin)
  259. enddef;
  260.