%%EndComments

/bd{bind def}bind def/e{exch}bd/mv{moveto}bd/rm{rmoveto}bd/i{index}bd
/r{roll}bd/l{lineto}bd/ed{e def}bd/a{add}bd/s{sub}bd/m{mul}bd/d{div}bd
/np{newpath}bd/df{findfont definefont}bd/c{setrgbcolor}bd

% Expects nothing
% This is used to set /t and /acc in such a way that they don't actually
% draw anything (to determine bouding box, e.g.)
% Returns nothing
/invis{/t{true charpath}bd/acc{true charpath pop pop}bd}bd

% Expects nothing
% The opposite of /invis... We make /t and /acc draw their arguments
% Returns nothing
/vis{/t{show}bd/acc{
  currentpoint 5 2 r dup 3 1 r stringwidth pop
  e dup stringwidth pop 3 2 r e s 2 div 
  4 3 r fs m rm show 3 1 roll mv show}bd}bd

% Explaination on /t and /accent (which return nothing)
% /t expects a (text) to display
% /acc expects a 'height', indicating where to put the accent,
% a (text1) to display, centered on a (text2)

% Expects '{ text }'
% Computes the bounding box of the text relative to the insertion point
% Returns 'x1 y1 x2 y2'
/bbox{gsave np 0 0 mv invis exec flattenpath pathbbox grestore}bd

% Expects 'x y { text }'
% Displays the given text centered on (x,y)
% Returns nothing
/center-text{
  dup 4 1 r bbox 6 4 r np mv 3 i 3 i 6 4 r e neg e neg rm e 4 3 r s 2 d
  3 1 r s 2 d neg rm vis exec
}bd

% Expects 'x y { text1 } { text2 }'
% Displays (text1) centered on (x,y) and appends (text2)
% Returns nothing
/left-text{
  4 1 r dup 4 1 r bbox 6 4 r np mv 3 i 3 i 6 4 r e neg e neg
  rm e 4 3 r s 2 d 3 1 r s 2 d neg rm
  vis exec currentpoint fill np mv exec
}bd

% Expects 'x y { text1 } { text2 }'
% Displays (text1text2), with (text2) centered on (x,y)
% Returns nothing
/right-text{
  4 2 r 3 2 r dup 4 1 r bbox 6 4 r np mv 3 i 3 i 6 4 r
  e neg e neg rm e 4 3 r s 2 d 3 1 r s 2 d neg
  rm currentpoint 4 2 r vis exec
  fill dup bbox pop 3 1 r pop s 4 -1 r s neg 3 -1 r np mv vis exec
}bd

% Expects '{ text }'
% Computes the half-width and half-height of the bounding box
% Returns 'width/2 height/2'
/halfbbox{bbox 2 i s 2 d 4 1 r e pop s neg 2 d e}bd

% Expects 'x1 y1 x2 y2 { text }'
% Computes the sp needed to display (text) centered on (x1,y1). Returns
% the X and Y coordinates of the end of the bond.
% Returns 'X Y x2 y2'
/b1{
  halfbbox /h ed /w ed /y1 ed /x1 ed /y2 ed /x2 ed
  x2 x1 ge{/ex 1 def}{/ex -1 def}ifelse
  y2 y1 ge{/ey 1 def}{/ey -1 def}ifelse
  x2 x1 eq{/X x2 def /Y y2 ey h m s def}if
  y2 y1 eq{/Y y2 def /X x2 ex w m s def}if
  y2 y1 eq x2 x1 eq or not{
  /Xv x2 ex w m s def /Yh y2 ey h m s def
  /Yv y2 ex w m x1 x2 s d y2 y1 s m a def
  /Xh x2 ey h m y1 y2 s d x2 x1 s m a def
  Xv Xh s ex m 0 ge{/X Xv def /Y Yv def}{/X Xh def /Y Yh def}ifelse}if
  /px X x1 s def /py Y y1 s def px px m py py m a sqrt
  dup px e d /px ed py e d /py ed X px atom-sp m s Y py atom-sp m s x1 y1
}bd

% Expects 'x1 y1 x2 y2 { text }'
% Computes the sp needed to display (text) centered on (x2,y2). Returns
% the X and Y coordinates of the end of the bond.
% Returns 'x1 y1 X Y'
/b2{3 1 r 5 2 r b1 4 2 r}bd

% Expects 'x1 y1 x2 y2 { text1 } { text2 }'
% Computes the sp needed to display (text1) centered on (x1,y1) and
% (text2) centered on (x2,y2). Returns the X1, Y1, X2 and Y2 coordinates
% of the ends of the bond.
% Returns 'X1 Y1 X2 Y2'
/b12{6 1 r b1 5 4 r b2}bd

% Expects 'x1 y1 x2 y2'
% Draws a spl bond
% Returns nothing
/b-spl{np mv l stroke}bd

% Expects 'x1 y1 x2 y2 style'
% Draws a dbl bond, with a given style
% Returns nothing
/b-dbl{
  /sh dbl-sh 3 -1 r m def
  /st ed/y2 ed/x2 ed/y1 ed/x1 ed
  /px x2 x1 s def /py y2 y1 s def px px m py py m a sqrt
  dup px e d /px ed py e d /py ed
  
  3 st eq 5 st eq or{/x2 x2 dbl-adj px m a def /y2 y2 dbl-adj py m a def}if
  4 st eq 5 st eq or{/x1 x1 dbl-adj px m s def /y1 y1 dbl-adj py m s def}if

  0 st eq 3 st eq or 4 st eq 5 st eq or or{
    x1 py sh m s y1 px sh m a x2 py sh m s y2 px sh m a
    x1 py sh m a y1 px sh m s x2 py sh m a y2 px sh m s
  }if

  1 st eq{x1 y1 x2 y2
    x1 2 py m sh m s sh px m a y1 2 px m sh m a sh py m a
    x2 2 py m sh m s sh px m s y2 2 px m sh m a sh py m s
  }if

  2 st eq{x1 y1 x2 y2
    x1 2 py m sh m a sh px m a y1 2 px m sh m s sh py m a
    x2 2 py m sh m a sh px m s y2 2 px m sh m s sh py m s
  }if
 
  6 st eq{x1 y1 x2 y2 x1 2 py m sh m s y1 2 px m sh m a
    x2 2 py m sh m s sh px m s y2 2 px m sh m a sh py m s
  }if

  7 st eq{x1 y1 x2 y2 x1 2 py m sh m a y1 2 px m sh m s
    x2 2 py m sh m a sh px m s y2 2 px m sh m s sh py m s
  }if
  
  8 st eq{x1 y1 x2 y2
    x1 2 py m sh m s sh px m a y1 2 px m sh m a sh py m a
    x2 2 py m sh m s y2 2 px m sh m a}if

  9 st eq{x1 y1 x2 y2
    x1 2 py m sh m a sh px m a y1 2 px m sh m s sh py m a
    x2 2 py m sh m a y2 2 px m sh m s}if

  np mv l stroke np mv l stroke
}bd

% Expects 'x1 y1 x2 y2'
% Draws a tpl bond between two points
% Returns nothing
/b-tpl{
  /sh tpl-sh 3 -1 r m def
  /y2 ed /x2 ed /y1 ed /x1 ed
  /px x2 x1 s def /py y2 y1 s def
  px px m py py m a sqrt dup px e d /px ed
  py e d /py ed

  x1 y1 x2 y2
  x1 sh py m s y1 sh px m a
  x2 sh py m s y2 sh px m a
  x1 sh py m a y1 sh px m s
  x2 sh py m a y2 sh px m s

  np mv l stroke np mv l stroke np mv l stroke
}bd

% Expects 'x1 y1 x2 y2'
% Draws a bond up from point 1 to point 2
% Returns nothing
/b-up{
  /sh ste-sh 3 -1 r m def
  /y2 ed /x2 ed /y1 ed /x1 ed /px x2 x1 s def /py y2 y1 s def
  px px m py py m a sqrt dup px e d /px ed py e d /py ed x1 y1
  x2 sh py m s y2 sh px m a x2 sh py m a y2 sh px m s
  np mv l l fill
}bd

% Expects 'x1 y1 x2 y2'
% Draws a bond down from point 1 to point 2
% Returns nothing
/b-down{
  /sh ste-sh 3 -1 r m def
  /y2 ed /x2 ed /y1 ed /x1 ed /px x2 x1 s def /py y2 y1 s def
  px px m py py m a sqrt dup px e d /px ed py e d /py ed
  0 1 8{/j ed /cx 2 j m 1 a x2 x1 s m 18 d x1 a def
    /cy 2 j m 1 a y2 y1 s m 18 d y1 a def
    cx sh py m j 1 a m 9 d s cy sh px m j 1 a m 9 d a
    cx sh py m j 1 a m 9 d a cy sh px m j 1 a m 9 d s
    np mv l stroke}for
}bd

% Expects 'type width x y px py'
% Draws a arrow-head on (x,y) whose direction is vector (px,py)
% Returns nothing
/arrowhead{
  1 i arrow-len arrow-cor m m neg
  1 i arrow-len arrow-cor m m neg
% type width x y px py dx dy
  2 copy
% type width x y px py dx dy dx dy
  10 2 r
% dx dy type width x y px py dx dy
  translate
% dx dy type width x y px py
  2 copy
  6 2 r
  3 1 r
  4 -1 r
  e arrow-len
  7 i m
  1 arrow-shape s
  m m a 
  3 1 r e
% type width px py py y x 
  arrow-len 6 i m 1 arrow-shape s m m a 4 2 r 3 i 3 i arrow-len 7 i m 4 i m
  neg arrow-sh 8 i m 4 i m neg 3 i a a arrow-len 8 i m 
  4 i m neg arrow-sh 9 i m 6 i m 3 i a a arrow-len 9 i m arrow-shape m
  6 i m neg 4 i a arrow-len 10 i m arrow-shape m 6 i m neg 4 i a arrow-len
  11 i m 8 i m neg arrow-sh 12 i m 8 i m 7 i a a arrow-len 12 i m
  8 i m neg arrow-sh 13 i m 10 i m neg 7 i a a np
  13 i 1 eq{mv l l l}{13 i 2 eq{pop pop mv l l}{13 i 3 eq{mv l pop pop l}if
  }ifelse}ifelse closepath fill pop pop pop pop pop pop
% dx dy
  neg e neg e translate
}bd

% And this is used to manage progressive changes
/it{ft 0 eq{/ft{1}bd}{ft 1 eq{/ft{0}bd}{ft 2
    eq{/ft{3}bd}{/ft{2}bd}ifelse}ifelse}ifelse sf}bd
/bold{ft 0 eq{/ft{2}bd}{ft 1 eq{/ft{3}bd}{ft 2 
      eq{/ft{0}bd}{/ft{1}bd}ifelse}ifelse}ifelse sf}bd
/bsub{0 -2 rm /fs{7}bd sf}bd/esub{0 2 rm /fs{10}bd sf}bd
/bsup{0 3 rm /fs{7}bd sf}bd/esup{0 -3 rm /fs{10}bd sf}bd

/atom-sp 2.1 def
/dbl-adj 0.7 def
/dbl-sh 1.5 def
/tpl-sh 2.7 def
/ste-sh 2.7 def
/arrow-len 4 def
/arrow-sh 1.33 def
/arrow-shape 0.6 def
/arrow-cor 0.3 def
0 0 0 c
1 setlinejoin
0.6 setlinewidth
1 setlinecap
% Current size of the font
/fs{10}bd
% Current type of the font (0: regular, 1: italic, 2: bold)
/ft{0}bd