path: root/Master/texmf-dist/tex/eplain/arrow.tex

% arrow.tex: macros for commutative diagrams.
% 
% Copyright (C) 1991,1992 Steven T. Smith.
%                         stsmith@ll.mit.edu
%
% This program is free software; you can redistribute it and/or modify
% it under the terms of the GNU General Public License as published by
% the Free Software Foundation; either version 2, or (at your option)
% any later version.
%
% This program is distributed in the hope that it will be useful,
% but WITHOUT ANY WARRANTY; without even the implied warranty of
% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
% GNU General Public License for more details.
%
% You should have received a copy of the GNU General Public License
% along with this file; see the file COPYING.  If not, write to the
% Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
% Boston, MA 02110-1301, USA.
%
% As a special exception, when this file is read by TeX when
% processing a TeX source document, you may use the result without
% restriction.

% Version 0   Released for alpha testing, November 16, 1991.
% Version 0.1 Morphism positions for slanted lines improved, Nov. 17, 1991.
% Version 0.11 \biline changed to \bisline for compatible naming. 11/21/91
% Version 0.2 Equate \lft & \rt w. _ and ^ instead of L_{12} & R_{12}. 1/20/92
% Version 1.0 Distributed with Eplain. 1/20/92
% Version 1.1 Purged \newcount's, etc.; Warner ref.; \getch@nnel logic. 4/21/92
% Version 1.11 Replace \smash with \smash@@ (for amstex compatibility) 3/27/96



% Syntax: \[arrow](X,Y) or
%         \[arrow](X,Y)\lft{MOR} (morphism placed left of arrow) or
%         \[arrow](X,Y)\rt{MOR} (morphism placed right of arrow)
%
% [arrow] is one of
%    sline     (straight line)
%    dotline   (dotted line)             * Unimplemented
%    arrow     (straight arrow)
%    dotarrow  (dotted arrow)            * Unimplemented
%
% The following allow plain versions and some combination of \lft and \rt.
%    biarrow   (two straight arrows)
%    adjarrow  (two adjoint arrows)
%    bisline   (two straight lines)
%
% Also, for left, right, up, and down mappings:
%
% \mapright     (or \mapright^{f_*}, \mapright_{f_*})
% \mapleft      (ditto)
% \mapup        (use \rt and \lft as above)
% \mapdown      (ditto)
%
% And variants of these (can use combinations of ^/_ and lft/rt):
%
% \bimapright   (two right arrows)
% \bimapleft    (two left arrows)
% \adjmapright  (two adjoint arrows; <- over ->)
% \adjmapleft   (two adjoint arrows; -> over <-)
% \hline        (horizontal line)
% \dothline     (dotted horizontal line)     * Unimplemented
% \bihline      (two horizontal lines)
%
% \bimapdown    (two down arrows)
% \bimapup      (two left arrows)
% \adjmapdown   (two adjoint arrows; down then up)
% \adjmapup     (two adjoint arrows; up then down)
% \vline        (vertical line)
% \dotvline     (dotted vertical line)       * Unimplemented
% \bivline      (two vertical lines)

% Use \thinlines temporarily to find the current catcode of @, so we can
% restore it at the end.
\edef\thinlines{\the\catcode`@ }%
\catcode`@ = 11
\let\@oldatcatcode = \thinlines


% I changed \smash to \smash@@ in these macros to avoid AMSTEX conflict.

\def\smash@@{\relax % \relax, in case this comes first in \halign
  \ifmmode\def\next{\mathpalette\mathsm@sh}\else\let\next\makesm@sh
  \fi\next}
\def\makesm@sh#1{\setbox\z@\hbox{#1}\finsm@sh}
\def\mathsm@sh#1#2{\setbox\z@\hbox{$\m@th#1{#2}$}\finsm@sh}
\def\finsm@sh{\ht\z@\z@ \dp\z@\z@ \box\z@}

% Adapted LaTeX code for drawing lines and vectors

% Note: to ensure compatibility with LaTeX, all LaTeX control
% sequences have been renamed.  Control sequence names containing the
% at sign (@) have been changed to contain an ampersand (&) instead.
\edef\@oldandcatcode{\the\catcode`& }%
\catcode`& = 11

% LaTeX macros changed here:
% \line - changed to \drawline
% \vector - changed to \drawvector
% \@badlinearg - simply uses \errmessage now
% \@height, \@width, and \@depth are changed to height, width, and depth
% \@sline and \@svector - changed so that \hbox{\drawline...} yields
%  a box of positive width and positive height for a positive slope
%  and positive depth for a negative slope.
% \@hline and \@hvector - likewise
% \unitlength eliminated; pass dimensions to \drawline and \drawvector.

% LaTeX's while loop
\def\&whilenoop#1{}%
\def\&whiledim#1\do #2{\ifdim #1\relax#2\&iwhiledim{#1\relax#2}\fi}%
\def\&iwhiledim#1{\ifdim #1\let\&nextwhile=\&iwhiledim 
        \else\let\&nextwhile=\&whilenoop\fi\&nextwhile{#1}}%

% LaTeX's \line and \vector macros:
\newif\if&negarg
\newdimen\&wholewidth
\newdimen\&halfwidth

\font\tenln=line10

\def\thinlines{\let\&linefnt\tenln \let\&circlefnt\tencirc
  \&wholewidth\fontdimen8\tenln \&halfwidth .5\&wholewidth}%
\def\thicklines{\let\&linefnt\tenlnw \let\&circlefnt\tencircw
  \&wholewidth\fontdimen8\tenlnw \&halfwidth .5\&wholewidth}%

\def\drawline(#1,#2)#3{\&xarg #1\relax \&yarg #2\relax \&linelen=#3\relax
  \ifnum\&xarg =0 \&vline \else \ifnum\&yarg =0 \&hline \else \&sline\fi\fi}%

\def\&sline{\leavevmode
  \ifnum\&xarg< 0 \&negargtrue \&xarg -\&xarg \&yyarg -\&yarg
  \else \&negargfalse \&yyarg \&yarg \fi
  \ifnum \&yyarg >0 \&tempcnta\&yyarg \else \&tempcnta -\&yyarg \fi
  \ifnum\&tempcnta>6 \&badlinearg \&yyarg0 \fi
  \ifnum\&xarg>6 \&badlinearg \&xarg1 \fi
  \setbox\&linechar\hbox{\&linefnt\&getlinechar(\&xarg,\&yyarg)}%
  \ifnum \&yyarg >0 \let\&upordown\raise \&clnht\z@
  \else\let\&upordown\lower \&clnht \ht\&linechar\fi
  \&clnwd=\wd\&linechar
  \&whiledim \&clnwd <\&linelen \do {%
    \&upordown\&clnht\copy\&linechar
    \advance\&clnht \ht\&linechar
    \advance\&clnwd \wd\&linechar
  }%
  \advance\&clnht -\ht\&linechar
  \advance\&clnwd -\wd\&linechar
  \&tempdima\&linelen\advance\&tempdima -\&clnwd
  \&tempdimb\&tempdima\advance\&tempdimb -\wd\&linechar
  \hskip\&tempdimb \multiply\&tempdima \@m
  \&tempcnta \&tempdima \&tempdima \wd\&linechar \divide\&tempcnta \&tempdima
  \&tempdima \ht\&linechar \multiply\&tempdima \&tempcnta
  \divide\&tempdima \@m
  \advance\&clnht \&tempdima
  \ifdim \&linelen <\wd\&linechar \hskip \wd\&linechar
  \else\&upordown\&clnht\copy\&linechar\fi}%

\def\&hline{\vrule height \&halfwidth depth \&halfwidth width \&linelen}%

\def\&getlinechar(#1,#2){\&tempcnta#1\relax\multiply\&tempcnta 8
  \advance\&tempcnta -9 \ifnum #2>0 \advance\&tempcnta #2\relax\else
  \advance\&tempcnta -#2\relax\advance\&tempcnta 64 \fi
  \char\&tempcnta}%

\def\drawvector(#1,#2)#3{\&xarg #1\relax \&yarg #2\relax
  \&tempcnta \ifnum\&xarg<0 -\&xarg\else\&xarg\fi
  \ifnum\&tempcnta<5\relax \&linelen=#3\relax
    \ifnum\&xarg =0 \&vvector \else \ifnum\&yarg =0 \&hvector
    \else \&svector\fi\fi\else\&badlinearg\fi}%

\def\&hvector{\ifnum\&xarg<0 \rlap{\&linefnt\&getlarrow(1,0)}\fi \&hline
  \ifnum\&xarg>0 \llap{\&linefnt\&getrarrow(1,0)}\fi}%

\def\&vvector{\ifnum \&yarg <0 \&downvector \else \&upvector \fi}%

\def\&svector{\&sline
  \&tempcnta\&yarg \ifnum\&tempcnta <0 \&tempcnta=-\&tempcnta\fi
  \ifnum\&tempcnta <5 
    \if&negarg\ifnum\&yarg>0                   % 3d quadrant; dp > 0
      \llap{\lower\ht\&linechar\hbox to\&linelen{\&linefnt
        \&getlarrow(\&xarg,\&yyarg)\hss}}\else % 4th quadrant; ht > 0
      \llap{\hbox to\&linelen{\&linefnt\&getlarrow(\&xarg,\&yyarg)\hss}}\fi
    \else\ifnum\&yarg>0                        % 1st quadrant; ht > 0
      \&tempdima\&linelen \multiply\&tempdima\&yarg
      \divide\&tempdima\&xarg \advance\&tempdima-\ht\&linechar
      \raise\&tempdima\llap{\&linefnt\&getrarrow(\&xarg,\&yyarg)}\else
      \&tempdima\&linelen \multiply\&tempdima-\&yarg % 2d quadrant; dp > 0
      \divide\&tempdima\&xarg
      \lower\&tempdima\llap{\&linefnt\&getrarrow(\&xarg,\&yyarg)}\fi\fi
  \else\&badlinearg\fi}%

\def\&getlarrow(#1,#2){\ifnum #2 =\z@ \&tempcnta='33\else
\&tempcnta=#1\relax\multiply\&tempcnta \sixt@@n \advance\&tempcnta
-9 \&tempcntb=#2\relax\multiply\&tempcntb \tw@
\ifnum \&tempcntb >0 \advance\&tempcnta \&tempcntb\relax
\else\advance\&tempcnta -\&tempcntb\advance\&tempcnta 64
\fi\fi\char\&tempcnta}%

\def\&getrarrow(#1,#2){\&tempcntb=#2\relax
\ifnum\&tempcntb < 0 \&tempcntb=-\&tempcntb\relax\fi
\ifcase \&tempcntb\relax \&tempcnta='55 \or 
\ifnum #1<3 \&tempcnta=#1\relax\multiply\&tempcnta
24 \advance\&tempcnta -6 \else \ifnum #1=3 \&tempcnta=49
\else\&tempcnta=58 \fi\fi\or 
\ifnum #1<3 \&tempcnta=#1\relax\multiply\&tempcnta
24 \advance\&tempcnta -3 \else \&tempcnta=51\fi\or 
\&tempcnta=#1\relax\multiply\&tempcnta
\sixt@@n \advance\&tempcnta -\tw@ \else
\&tempcnta=#1\relax\multiply\&tempcnta
\sixt@@n \advance\&tempcnta 7 \fi\ifnum #2<0 \advance\&tempcnta 64 \fi
\char\&tempcnta}%

\def\&vline{\ifnum \&yarg <0 \&downline \else \&upline\fi}%

\def\&upline{\hbox to \z@{\hskip -\&halfwidth \vrule width \&wholewidth
   height \&linelen depth \z@\hss}}%

\def\&downline{\hbox to \z@{\hskip -\&halfwidth \vrule width \&wholewidth
   height \z@ depth \&linelen \hss}}%

\def\&upvector{\&upline\setbox\&tempboxa\hbox{\&linefnt\char'66}\raise 
     \&linelen \hbox to\z@{\lower \ht\&tempboxa\box\&tempboxa\hss}}%

\def\&downvector{\&downline\lower \&linelen
      \hbox to \z@{\&linefnt\char'77\hss}}%

\def\&badlinearg{\errmessage{Bad \string\arrow\space argument.}}%

%INITIALIZATION
\thinlines

% Allocate registers using the rules of p.~346 of {\sl The \TeX book}.
\countdef\&xarg     0
\countdef\&yarg     2
\countdef\&yyarg    4
\countdef\&tempcnta 6
\countdef\&tempcntb 8

\dimendef\&linelen  0
\dimendef\&clnwd    2
\dimendef\&clnht    4
\dimendef\&tempdima 6
\dimendef\&tempdimb 8

\chardef\@arrbox    0
\chardef\&linechar  2
\chardef\&tempboxa  2           % \&linechar and \&tempboxa don't interfere.


% Macros for abstract nonsense

% Macros for slanted lines and arrows.

\let\lft^%
\let\rt_% distinguish between \rt and \lft

\newif\if@pslope % test for positive slope
\def\@findslope(#1,#2){\ifnum#1>0
  \ifnum#2>0 \@pslopetrue \else\@pslopefalse\fi \else
  \ifnum#2>0 \@pslopefalse \else\@pslopetrue\fi\fi}%

\def\generalsmap(#1,#2){\getm@rphposn(#1,#2)\plnmorph\futurelet\next\addm@rph}%

% Put arrow in \@arrbox, then add morphisms later.

% Single lines and arrows.
\def\sline(#1,#2){\setbox\@arrbox=\hbox{\drawline(#1,#2){\sarrowlength}}%
  \@findslope(#1,#2)\d@@blearrfalse\generalsmap(#1,#2)}%
\def\arrow(#1,#2){\setbox\@arrbox=\hbox{\drawvector(#1,#2){\sarrowlength}}%
  \@findslope(#1,#2)\d@@blearrfalse\generalsmap(#1,#2)}%

% Double lines, arrows, and adjoint arrows.
\newif\ifd@@blearr

\def\bisline(#1,#2){\@findslope(#1,#2)%
  \if@pslope \let\@upordown\raise \else \let\@upordown\lower\fi
  \getch@nnel(#1,#2)\setbox\@arrbox=\hbox{\@upordown\@vchannel
    \rlap{\drawline(#1,#2){\sarrowlength}}%
      \hskip\@hchannel\hbox{\drawline(#1,#2){\sarrowlength}}}%
  \d@@blearrtrue\generalsmap(#1,#2)}%
\def\biarrow(#1,#2){\@findslope(#1,#2)%
  \if@pslope \let\@upordown\raise \else \let\@upordown\lower\fi
  \getch@nnel(#1,#2)\setbox\@arrbox=\hbox{\@upordown\@vchannel
    \rlap{\drawvector(#1,#2){\sarrowlength}}%
      \hskip\@hchannel\hbox{\drawvector(#1,#2){\sarrowlength}}}%
  \d@@blearrtrue\generalsmap(#1,#2)}%
\def\adjarrow(#1,#2){\@findslope(#1,#2)%
  \if@pslope \let\@upordown\raise \else \let\@upordown\lower\fi
  \getch@nnel(#1,#2)\setbox\@arrbox=\hbox{\@upordown\@vchannel
    \rlap{\drawvector(#1,#2){\sarrowlength}}%
      \hskip\@hchannel\hbox{\drawvector(-#1,-#2){\sarrowlength}}}%
  \d@@blearrtrue\generalsmap(#1,#2)}%

% Morphism placement.

% Logic for positioning morphisms on slanted arrows:
% If \lft then
%   \hskip by -\@hmorphdflt
%   if \@pslopetrue then \raise by \@vmorphdflt
%   else \lower by \@vmorphdflt
% Else if \rt then
%   \hskip by \@hmorphdflt
%   if \@pslopetrue then \lower by \@vmorphdflt
%   else \raise by \@vmorphdflt
%
% \@hmorphdflt and \@vmorphdflt defined by \getm@rphposn
% Advance \morphdist by .5\channelwidth if double arrows
%
% Use \@shiftmorph to allow users to move morphisms

% Logic for \@shiftmorph:
% If \rtm@rph then
%   if \hmorphposnrt=0 then hshift by\hmorphposn else hshift by\hmorphposnrt
%   if \vmorphposnrt=0 then vshift by\vmorphposn else vshift by\vmorphposnrt
% Else
%   if \hmorphposnlft=0 then hshift by\hmorphposn else hshift by\hmorphposnlft
%   if \vmorphposnlft=0 then vshift by\vmorphposn else vshift by\vmorphposnlft

\newif\ifrtm@rph
\def\@shiftmorph#1{\hbox{\setbox0=\hbox{$\scriptstyle#1$}%
  \setbox1=\hbox{\hskip\@hm@rphshift\raise\@vm@rphshift\copy0}%
  \wd1=\wd0 \ht1=\ht0 \dp1=\dp0 \box1}}%
\def\@hm@rphshift{\ifrtm@rph
  \ifdim\hmorphposnrt=\z@\hmorphposn\else\hmorphposnrt\fi \else
  \ifdim\hmorphposnlft=\z@\hmorphposn\else\hmorphposnlft\fi \fi}%
\def\@vm@rphshift{\ifrtm@rph
  \ifdim\vmorphposnrt=\z@\vmorphposn\else\vmorphposnrt\fi \else
  \ifdim\vmorphposnlft=\z@\vmorphposn\else\vmorphposnlft\fi \fi}%

\def\addm@rph{\ifx\next\lft\let\temp=\lftmorph\else
  \ifx\next\rt\let\temp=\rtmorph\else\let\temp\relax\fi\fi \temp}%

\def\plnmorph{\dimen1\wd\@arrbox \ifdim\dimen1<\z@ \dimen1-\dimen1\fi
  \vcenter{\box\@arrbox}}%
\def\lftmorph\lft#1{\rtm@rphfalse \setbox0=\@shiftmorph{#1}%
  \if@pslope \let\@upordown\raise \else \let\@upordown\lower\fi
  \llap{\@upordown\@vmorphdflt\hbox to\dimen1{\hss % \dimen1=\wd\@arrbox
    \llap{\box0}\hss}\hskip\@hmorphdflt}\futurelet\next\addm@rph}%
\def\rtmorph\rt#1{\rtm@rphtrue \setbox0=\@shiftmorph{#1}%
  \if@pslope \let\@upordown\lower \else \let\@upordown\raise\fi
  \llap{\@upordown\@vmorphdflt\hbox to\dimen1{\hss
    \rlap{\box0}\hss}\hskip-\@hmorphdflt}\futurelet\next\addm@rph}%

% Get appropriate shifts for morphisms and double lines at various slopes
% Syntax e.g.: \@getshift(1,2){\@hchannel}{\@vchannel}{\channelwidth}%

\def\getm@rphposn(#1,#2){\ifd@@blearr \dimen@\morphdist \advance\dimen@ by
  .5\channelwidth \@getshift(#1,#2){\@hmorphdflt}{\@vmorphdflt}{\dimen@}\else
  \@getshift(#1,#2){\@hmorphdflt}{\@vmorphdflt}{\morphdist}\fi}%

\def\getch@nnel(#1,#2){\ifdim\hchannel=\z@ \ifdim\vchannel=\z@
    \@getshift(#1,#2){\@hchannel}{\@vchannel}{\channelwidth}%
    \else \@hchannel\hchannel \@vchannel\vchannel \fi
  \else \@hchannel\hchannel \@vchannel\vchannel \fi}%

\def\@getshift(#1,#2)#3#4#5{\dimen@ #5\relax
  \&xarg #1\relax \&yarg #2\relax
  \ifnum\&xarg<0 \&xarg -\&xarg \fi
  \ifnum\&yarg<0 \&yarg -\&yarg \fi
  \ifnum\&xarg<\&yarg \&negargtrue \&yyarg\&xarg \&xarg\&yarg \&yarg\&yyarg\fi
  \ifcase\&xarg \or  % There is no case 0
    \ifcase\&yarg    % case 1
      \dimen@i \z@ \dimen@ii \dimen@ \or % case (1,0)
      \dimen@i .7071\dimen@ \dimen@ii .7071\dimen@ \fi \or
    \ifcase\&yarg    % case 2
      \or % case 0,2 wrong
      \dimen@i .4472\dimen@ \dimen@ii .8944\dimen@ \fi \or
    \ifcase\&yarg    % case 3
      \or % case 0,3 wrong
      \dimen@i .3162\dimen@ \dimen@ii .9486\dimen@ \or
      \dimen@i .5547\dimen@ \dimen@ii .8321\dimen@ \fi \or
    \ifcase\&yarg    % case 4
      \or % case 0,2,4 wrong
      \dimen@i .2425\dimen@ \dimen@ii .9701\dimen@ \or\or
      \dimen@i .6\dimen@ \dimen@ii .8\dimen@ \fi \or
    \ifcase\&yarg    % case 5
      \or % case 0,5 wrong
      \dimen@i .1961\dimen@ \dimen@ii .9801\dimen@ \or
      \dimen@i .3714\dimen@ \dimen@ii .9284\dimen@ \or
      \dimen@i .5144\dimen@ \dimen@ii .8575\dimen@ \or
      \dimen@i .6247\dimen@ \dimen@ii .7801\dimen@ \fi \or
    \ifcase\&yarg    % case 6
      \or % case 0,2,3,4,6 wrong
      \dimen@i .1645\dimen@ \dimen@ii .9864\dimen@ \or\or\or\or
      \dimen@i .6402\dimen@ \dimen@ii .7682\dimen@ \fi \fi
  \if&negarg \&tempdima\dimen@i \dimen@i\dimen@ii \dimen@ii\&tempdima\fi
  #3\dimen@i\relax #4\dimen@ii\relax }%

\catcode`\&=4  % Back to alignment tab


% Macros for horizontal and vertical lines and arrows.
% These macros use an idea from Appendix~D, p.~374 of the Texbook.
% Usage: `\mapright^f', `\mapleft', etc.
%        `\mapdown\lft{f}', `\mapup\rt{g}', `\mapdown', etc.

% \toks@ will contain the token sequence that defines the arrow and morphisms;
% ensure that \toks@={\mathop{\vcenter{\smash@@{horiz. arrow}}}\limits} to start.
\def\generalhmap{\futurelet\next\@generalhmap}%
\def\@generalhmap{\ifx\next^ \let\temp\generalhm@rph\else
  \ifx\next_ \let\temp\generalhm@rph\else \let\temp\m@kehmap\fi\fi \temp}%
\def\generalhm@rph#1#2{\ifx#1^
    \toks@=\expandafter{\the\toks@#1{\rtm@rphtrue\@shiftmorph{#2}}}\else
    \toks@=\expandafter{\the\toks@#1{\rtm@rphfalse\@shiftmorph{#2}}}\fi
  \generalhmap}%
\def\m@kehmap{\mathrel{\smash@@{\the\toks@}}}%

\def\mapright{\toks@={\mathop{\vcenter{\smash@@{\drawrightarrow}}}\limits}%
  \generalhmap}%
\def\mapleft{\toks@={\mathop{\vcenter{\smash@@{\drawleftarrow}}}\limits}%
  \generalhmap}%
\def\bimapright{\toks@={\mathop{\vcenter{\smash@@{\drawbirightarrow}}}\limits}%
  \generalhmap}%
\def\bimapleft{\toks@={\mathop{\vcenter{\smash@@{\drawbileftarrow}}}\limits}%
  \generalhmap}%
\def\adjmapright{\toks@={\mathop{\vcenter{\smash@@{\drawadjrightarrow}}}\limits}%
  \generalhmap}%
\def\adjmapleft{\toks@={\mathop{\vcenter{\smash@@{\drawadjleftarrow}}}\limits}%
  \generalhmap}%
\def\hline{\toks@={\mathop{\vcenter{\smash@@{\drawhline}}}\limits}%
  \generalhmap}%
\def\bihline{\toks@={\mathop{\vcenter{\smash@@{\drawbihline}}}\limits}%
  \generalhmap}%

\def\drawrightarrow{\hbox{\drawvector(1,0){\harrowlength}}}%
\def\drawleftarrow{\hbox{\drawvector(-1,0){\harrowlength}}}%
\def\drawbirightarrow{\hbox{\raise.5\channelwidth
  \hbox{\drawvector(1,0){\harrowlength}}\lower.5\channelwidth
  \llap{\drawvector(1,0){\harrowlength}}}}%
\def\drawbileftarrow{\hbox{\raise.5\channelwidth
  \hbox{\drawvector(-1,0){\harrowlength}}\lower.5\channelwidth
  \llap{\drawvector(-1,0){\harrowlength}}}}%
\def\drawadjrightarrow{\hbox{\raise.5\channelwidth
  \hbox{\drawvector(-1,0){\harrowlength}}\lower.5\channelwidth
  \llap{\drawvector(1,0){\harrowlength}}}}%
\def\drawadjleftarrow{\hbox{\raise.5\channelwidth
  \hbox{\drawvector(1,0){\harrowlength}}\lower.5\channelwidth
  \llap{\drawvector(-1,0){\harrowlength}}}}%
\def\drawhline{\hbox{\drawline(1,0){\harrowlength}}}%
\def\drawbihline{\hbox{\raise.5\channelwidth
  \hbox{\drawline(1,0){\harrowlength}}\lower.5\channelwidth
  \llap{\drawline(1,0){\harrowlength}}}}%

% Vertical arrows are handled differently because there is no \mathop.
% \toks@ will contain the token sequence that defines the arrow and morphisms;
% ensure that \toks@={\vcenter{vertical arrow}} to start.
\def\generalvmap{\futurelet\next\@generalvmap}%
\def\@generalvmap{\ifx\next\lft \let\temp\generalvm@rph\else
  \ifx\next\rt \let\temp\generalvm@rph\else \let\temp\m@kevmap\fi\fi \temp}%
% Prepend or append to \toks@ depending on \rt or \lft.
\toksdef\toks@@=1
\def\generalvm@rph#1#2{\ifx#1\rt % append
    \toks@=\expandafter{\the\toks@
      \rlap{$\vcenter{\rtm@rphtrue\@shiftmorph{#2}}$}}\else % prepend
    \toks@@={\llap{$\vcenter{\rtm@rphfalse\@shiftmorph{#2}}$}}%
    \toks@=\expandafter\expandafter\expandafter{\expandafter\the\expandafter
      \toks@@ \the\toks@}\fi \generalvmap}%
\def\m@kevmap{\the\toks@}%

\def\mapdown{\toks@={\vcenter{\drawdownarrow}}\generalvmap}%
\def\mapup{\toks@={\vcenter{\drawuparrow}}\generalvmap}%
\def\bimapdown{\toks@={\vcenter{\drawbidownarrow}}\generalvmap}%
\def\bimapup{\toks@={\vcenter{\drawbiuparrow}}\generalvmap}%
\def\adjmapdown{\toks@={\vcenter{\drawadjdownarrow}}\generalvmap}%
\def\adjmapup{\toks@={\vcenter{\drawadjuparrow}}\generalvmap}%
\def\vline{\toks@={\vcenter{\drawvline}}\generalvmap}%
\def\bivline{\toks@={\vcenter{\drawbivline}}\generalvmap}%

\def\drawdownarrow{\hbox to5pt{\hss\drawvector(0,-1){\varrowlength}\hss}}%
\def\drawuparrow{\hbox to5pt{\hss\drawvector(0,1){\varrowlength}\hss}}%
\def\drawbidownarrow{\hbox to5pt{\hss\hbox{\drawvector(0,-1){\varrowlength}}%
  \hskip\channelwidth\hbox{\drawvector(0,-1){\varrowlength}}\hss}}%
\def\drawbiuparrow{\hbox to5pt{\hss\hbox{\drawvector(0,1){\varrowlength}}%
  \hskip\channelwidth\hbox{\drawvector(0,1){\varrowlength}}\hss}}%
\def\drawadjdownarrow{\hbox to5pt{\hss\hbox{\drawvector(0,-1){\varrowlength}}%
  \hskip\channelwidth\lower\varrowlength
  \hbox{\drawvector(0,1){\varrowlength}}\hss}}%
\def\drawadjuparrow{\hbox to5pt{\hss\hbox{\drawvector(0,1){\varrowlength}}%
  \hskip\channelwidth\raise\varrowlength
  \hbox{\drawvector(0,-1){\varrowlength}}\hss}}%
\def\drawvline{\hbox to5pt{\hss\drawline(0,1){\varrowlength}\hss}}%
\def\drawbivline{\hbox to5pt{\hss\hbox{\drawline(0,1){\varrowlength}}%
  \hskip\channelwidth\hbox{\drawline(0,1){\varrowlength}}\hss}}%


% Macros for setting commutative diagrams.

% A macro inspired by Ex.~18.46 of the TeXbook.
\def\commdiag#1{\null\,
  \vcenter{\commdiagbaselines
  \m@th\ialign{\hfil$##$\hfil&&\hfil$\mkern4mu ##$\hfil\crcr
      \mathstrut\crcr\noalign{\kern-\baselineskip}
      #1\crcr\mathstrut\crcr\noalign{\kern-\baselineskip}}}\,}%

\def\commdiagbaselines{\baselineskip15pt \lineskip3pt \lineskiplimit3pt }%
% A macro inspired by Francis Borceux's Diagram macros for LaTeX
% (FBORCEUX@BUCLLN11.BITNET).
\def\gridcommdiag#1{\null\,
  \vcenter{\offinterlineskip
  \m@th\ialign{&\vbox to\vgrid{\vss
    \hbox to\hgrid{\hss\smash@@{$##$}\hss}}\crcr
      \mathstrut\crcr\noalign{\kern-\vgrid}
      #1\crcr\mathstrut\crcr\noalign{\kern-.5\vgrid}}}\,}%

% Default parameters
% Define default heights and widths for arrows using the golden ratio.
% Note that 5:3 (for sline) and 3:2 (for vector) approximate this ratio.
\newdimen\harrowlength \harrowlength=60pt
\newdimen\varrowlength \varrowlength=.618\harrowlength
\newdimen\sarrowlength \sarrowlength=\harrowlength

% Morphism placement
\newdimen\hmorphposn \hmorphposn=\z@
\newdimen\vmorphposn \vmorphposn=\z@
\newdimen\morphdist  \morphdist=4pt

\dimendef\@hmorphdflt 0       % These two dimensions are
\dimendef\@vmorphdflt 2       % defined by \getm@rphposn

\newdimen\hmorphposnrt  \hmorphposnrt=\z@
\newdimen\hmorphposnlft \hmorphposnlft=\z@
\newdimen\vmorphposnrt  \vmorphposnrt=\z@
\newdimen\vmorphposnlft \vmorphposnlft=\z@
\let\hmorphposnup=\hmorphposnrt
\let\hmorphposndn=\hmorphposnlft
\let\vmorphposnup=\vmorphposnrt
\let\vmorphposndn=\vmorphposnlft

% Default grid size for \gridcommdiag
\newdimen\hgrid \hgrid=15pt
\newdimen\vgrid \vgrid=15pt

% Horizontal and vertical distance between double lines and arrows. 
\newdimen\hchannel  \hchannel=0pt
\newdimen\vchannel  \vchannel=0pt
\newdimen\channelwidth \channelwidth=3pt

\dimendef\@hchannel 0         % Defined via the
\dimendef\@vchannel 2         % macro \getch@nnel

\catcode`& = \@oldandcatcode
\catcode`@ = \@oldatcatcode


% Some examples

%\parskip=20pt
%
%The first example:
%$$\commdiag{A&\mapright^f&B&\mapleft^g&C\cr
%\mapdown\lft\psi&\arrow(3,-2)\rt s&\mapup\rt\phi&
%\arrow(-3,2)\lft l&\mapdown\rt\theta\cr
%D&\mapright_h&E&\mapleft_{\int_0^t{\bf A}\,d\sigma}&F\cr}$$
%
%
%Covering homotopy property (Bott and Tu, {\it Differential Forms in
%Algebraic Topology}):
%$$\commdiag{Y&\mapright^f&E\cr \mapdown&\arrow(3,2)\lft{f_t}&\mapdown\cr
%Y\times I&\mapright^{\bar f_t}&X}$$
%
%
%Universal mapping property (Warner, {\it Foundations of Differentiable
%Manifolds and Lie Groups}): $$\varrowlength=20pt
%\commdiag{V\otimes W\cr \mapup\lft\phi&\arrow(3,-1)\rt{\tilde l}\cr
%V\times W&\mapright^l&U\cr}$$
%
%
%A cube (Francis Borceux):
%$$\harrowlength=48pt \varrowlength=48pt \sarrowlength=20pt
%\def\cross#1#2{\setbox0=\hbox{$#1$}%
%  \hbox to\wd0{\hss\hbox{$#2$}\hss}\llap{\unhbox0}}
%\gridcommdiag{&&B&&\mapright^b&&D\cr
%&\arrow(1,1)\lft a&&&&\arrow(1,1)\lft d\cr
%A&&\cross{\hmorphposn=12pt\mapright^c}{\vmorphposn=-12pt\mapdown\lft f}
%&&C&&\mapdown\rt h\cr\cr
%\mapdown\lft e&&F&&\cross{\hmorphposn=-12pt\mapright_j}
%{\vmorphposn=12pt\mapdown\rt g}&&H\cr
%&\arrow(1,1)\lft i&&&&\arrow(1,1)\rt l\cr
%E&&\mapright_k&&G\cr}$$
%
%Zassenhaus's Butterfly Lemma (Lang, {\it Algebra}):
%$$\hgrid=16pt \vgrid=8pt \sarrowlength=32pt
%\def\cross#1#2{\setbox0=\hbox{$#1$}%
%  \hbox to\wd0{\hss\hbox{$#2$}\hss}\llap{\unhbox0}}
%\def\l#1{\llap{$#1$\hskip.5em}}
%\def\r#1{\rlap{\hskip.5em$#1$}}
%\gridcommdiag{&&U&&&&V\cr &&\bullet&&&&\bullet\cr
%&&\sarrowlength=16pt\sline(0,1)&&&&\sarrowlength=16pt\sline(0,1)\cr
%&&\l{u(U\cap V)}\bullet&&&&\bullet\r{(U\cap V)v}\cr
%&&&\sline(2,-1)&&\sline(2,1)\cr
%&&\cross{=}{\sline(0,1)}&&\bullet&&\cross{=}{\sline(0,1)}\cr\cr
%&&\l{^{\textstyle u(U\cap v)}}\bullet&&\cross{=}{\sline(0,1)}&&
% \bullet\r{^{\textstyle(u\cap V)v}}\cr
%&\sline(2,1)&&\sline(2,-1)&&\sline(2,1)&&\sline(2,-1)\cr
%\l{u}\bullet&&&&\bullet&&&&\bullet\r{v}\cr
%&\sline(2,-1)&&\sline(2,1)&&\sline(2,-1)&&\sline(2,1)\cr
%&&\bullet&&&&\bullet\cr &&u\cap V&&&&U\cap v\cr}$$