path: root/Master/texmf-dist/metapost/mcf2graph/mcf2graph.mf

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% mcf2graph ver 4.29     Copyright (c) 2013-2017   Akira Yamaji
%
% Permission is hereby granted, free of charge, to any person obtaining a copy of this software
% and associated documentation files (the "Software"), to deal in the Software without restriction,
% including without limitation the rights to use, copy, modify, merge, publish, distribute,
% sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is
% furnished to do so, subject to the following conditions:
%
% The above copyright notice and this permission notice shall be included in all copies
% or substantial portions of the Software.
%
% THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,EXPRESS OR IMPLIED,
% INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,FITNESS FOR A PARTICULAR PURPOSE
% AND NONINFRINGEMENT.  IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM,
% DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
% OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%  mcf2graph is METAFONT/METAPOST macro package convert
%  Molecular Coding Format(MCF) to font(pk)/eps/sgv/png/mdl molfile(V2000)
%----------------------------------------------------------------------------------------------
% This package is located at : http://www.ctan.org/pkg/mcf2graph
% Suggestion or request mail to : mcf2graph@gmail.com 
%----------------------------------------------------------------------------------------------
% Set output no image file        : mpost -s ahangle=0  FILENAME
% Set outputformat to "png"       : mpost -s ahangle=1  FILENAME
% Set outputformat to "svg"       : mpost -s ahangle=2  FILENAME
% Set outputformat to MDL Molfile : mpost -s ahangle=3  FILENAME
% Set make first font only        : mpost -s ahlength=1 FILENAME
% Set output report               : mpost -s ahlength=2 FILENAME
% Set to use plain.mp label,arrow : mpost -s ahlength=3 FILENAME
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
tracingstats:=1;
message " This is mcf2graph ver 4.2  2017.10";
%-------------------------------------------------------------------------------------------------
newinternal nA,nB,nC,nD,nE,nF,char_num,str_cnt,sub_usr,sub_int,tbl_cnt;
numeric save_para[],comD[][],parD[][],cntD[],tbl_str_wd[],tbl_atom[],tbl_subst[][],tbl_atom_wt[],
        tbl_atom_mi[],tbl_char_wd[],tbl_char_ht[];
string  tbl_atom_str[],strD[],var[],tag[],mp_log_name,aux_delimiter,atomfont,
        save_atomfont,save_defaultfont;
picture mol_stru[];
path    arrow_path,arrow_head;
%-------------------------------------------------------------------------------------------------
char_num:=str_cnt:=proc_end:=sw_label_emu:=0;
sw_numberA:=sw_numberB:=sw_mol_frame:=sw_auxout:=sw_solid:=sw_expand:=sw_font_frame:=sw_clip:=0;
sw_atom_frame:=sw_report:=sw_MOLout:=sw_subst_off:=sw_bond_single:=sw_auxfix:=sw_arrow:=0;
numberA_start:=numberB_start:=1; numberA_end:=numberB_end:=4095; aux_max:=max_inf_num:=20;
aux_delimiter:=";";  var1:="jobname";  tag1:="F";  var2:="char_num"; tag2:="C";
for i=3 upto aux_max: var[i]:=tag[i]:=""; endfor
%=================================================================================================
if (known green)and(known ahlength):
  f_MP:=1;
  color color_list[];
  atomfont:=defaultfont:="";
  mp_log_name:=jobname&"-info.aux";
  if     ahlength=1: proc_end:=1;                                   % first molecular only
  elseif ahlength=2: sw_report:=1; def shipit = enddef;             % report on
  elseif ahlength=3: sw_arrow:=1; defaultfont:="uhvr8r";            % use mp label
  elseif ahlength=5: sw_arrow:=1; defaultfont:=atomfont:="uhvr8r";  % use mp atom,label
  fi
  if     ahangle=0: def shipit = enddef;                            % No image file
  elseif ahangle=1: outputformat:="png"; hppp:=vppp:=0.1;           % PNG format
  elseif ahangle=2: outputformat:="svg";                            % SVG format
  elseif ahangle=3: sw_MOLout:=1; def shipit = enddef;              % MDL Molefile on
  fi
  outputtemplate:="%j-%3c."&outputformat;
  def beginchar(expr a,b,c,d)= beginfig(a) w:=b*pt; h:=c*pt; enddef;
  def endchar = endfig enddef;
  def printf expr s= write s to mp_log_name enddef;
  def # = enddef;
  def Cp(expr s) = if known s: if s<>0: withcolor color_list[s] fi fi enddef;
  if atomfont="":    atomfont:="draw";    fi % default atom font
  if defaultfont="": defaultfont:="draw"; fi % default label font
else: f_MP:=0;
  string defaultfont;
  dotlabeldiam:=3bp;
  def Cp(expr s) = enddef;
  def color = transform enddef;
  def printf expr s= message s enddef;
  %-----------------------------------------------------------------------
  sw_arrow:=0;
  dotlabeldiam:=3bp;
  %-----------------------------------------------------------------------
  atomfont:="draw";
  defaultfont:="draw";
  mode_setup;
fi
clearit;
for i=0 upto 20: mol_stru[i]:=nullpicture; endfor
%--------------------------------------------------------------------------------------------------
let DIV= /; let MUL= *; let LT= <; let GT= >; let AND= &; let :: = : ; let == = =;
%--------------------------------------------------------------------------------------------------
?3:=?20:=Ph:=Ph1:=Ph2:=hz:=0; vt:=1;
margin_left_right:=margin_top_bottom:=0.4mm;             ratio_bond_width:=0.1;
ratio_chain_ring:= 0.66;      ratio_atom_bond:=0.36;     ratio_thickness_bond:=0.015;  
ratio_char_bond:=1.5;         ratio_bondgap_bond:=0.15;  ratio_zebragap_bond:=0.12;
ratio_zebra_black:=0.4;       ratio_wedge_bond:=0.12;    ratio_atomgap_atom:=0.050;
offset_thickness:=0.2pt;      offset_bond_gap:=0.3pt;    offset_zebra_gap:=0.1pt;
offset_atom:=0.8pt;           offset_wedge:=0.4pt;       thickness_font_frame:=0.2pt;
max_bond_length:=10mm;        bond_len:=8mm;
font_wd:=30mm;                font_ht:=20mm;
%==================================================================================================
ahangle:=45;
ahlength:=4bp;
defaultsize:=8bp;
atomfontsize:=8bp;
defaultscale:=1;
labeloffset:=3bp;
ext_defaultline:=0.5bp;
%==================================================================================================
sub_emb_start:=500;      % 500  => 2499   for embedded sub structure (max 2000)
sub_usr_start:=2500;     % 2500 => 2999   for user     sub structure (max 500)
sub_int_start:=3000;     % 3000 => 4000   for internal sub structure (max 1000)
%--------------------------------------------------------------------------------------------------
def def_com(expr n)(text tx)= nA:=n; forsuffixes list=tx:: list:=nA; nA:=nA+1; endfor enddef;
def_com(-4000)(_term,_jp_atom,_jp_atom_abs,_jp_bond,_cyc,_cyc_sB,_cyc_eB,_set_line,_chg_line,
  _dl,_mb,_N,_O,_S,_H,_tmp_line,_chg_len,_get_len,_ring_len,_tmp_len,_rot_ang,_adj_ang,_chg_env,
  _tmp_env,_set_colorA,_set_colorB,_postA,_postB,_postC,_postD,_postE,_postF,_postH,_stack_reset,
  _set_clr,_set_adr,_mk_bond,_set_atom,_arg_ang,_chg_atom,_tmp_rot,_fuse,_push,_pop,
  _size_a,_numeric);
def_com(1)(si,dl,dr,db,dm,tm,wf,wb,bd,bz,zf,zb,dt,wv,nl,vf,vb,si_,wf_,wb_,bd_);
%--------------------------------------------------------------------------------------------------
def parameter_list=
  sw_report,sw_numberA,sw_numberB,sw_mol_frame,sw_auxout,sw_solid,sw_expand,sw_MOLout,
  sw_atom_frame,sw_font_frame,sw_subst_off,sw_bond_single,sw_clip,sw_arrow,sw_label_emu,
  margin_left_right,margin_top_bottom,ratio_atom_bond,ratio_thickness_bond,ratio_char_bond,
  ratio_chain_ring,ratio_bondgap_bond,ratio_zebra_black,ratio_zebragap_bond,
  ratio_wedge_bond,ratio_atomgap_atom,ratio_bond_width,font_wd,font_ht,
  bond_len,offset_atom,offset_wedge,max_bond_length,offset_zebra_gap,offset_bond_gap,
  thickness_font_frame,offset_thickness,numberA_start,numberA_end,numberB_start,numberB_end,
  atomfontsize,defaultsize,defaultscale,labeloffset
enddef;
%--------------------------------------------------------------------------------------------------
vardef pic_c(expr i,s)= substring(i,i+1) of s enddef;
%--------------------------------------------------------------------------------------------------
nA:=0; for list=parameter_list: save_para[incr nA]:=list; endfor
def store_par(text t)=
  nA:=0; for list=t: if save_para[incr nA]<>list: save_para[nA]:=list; fi endfor enddef;
def restore_par(text t)=  nA:=0;
  forsuffixes list=t: if list<>save_para[incr nA]: list:=save_para[nA]; fi endfor enddef;
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
def beginfont(text s)=
  char_num:=char_num+1;
  store_par(parameter_list);
  save_atomfont:=atomfont;
  save_defaultfont:=defaultfont;
  begingroup
  save cntA,cntB,cntM,minX,minY,f_beginchar,numS,sftX,sftY,f_ext,
       cal_FM,cal_MW,cal_MW_str,cal_MI,cal_MI_str,wdM,htM,
       inf_NO,inf_EN,inf_JN,inf_FM,inf_CAS,inf_USE,inf_EXA,inf_EXB,inf_MW,
       posBs,posBe,posA,posM,lineB,sB,eB,angB,angA,lenB,ang_br,info,pT;
  numeric lineB[],sB[],eB[],angB[],angA[],lenB[],ang_br[],numS[],wdM[],htM[];
  pair posA[],posM[][],pT,posBs,posBe;
  string info[],cal_FM,cal_MW,cal_MW_str,cal_MI,cal_MI_str,
         inf_NO,inf_EN,inf_JN,inf_FM,inf_CAS,inf_USE,inf_EXA,inf_EXB,inf_MW;
  %------------------------------------------------------------------------------------------------
  for i:=1 upto max_inf_num: info[i]:=":"; endfor
  f_ext:=inf_num:=cntM:=0;
  for list=s: info[incr inf_num]:=list; endfor
enddef;
%==================================================================================================
def endfont=
  if sw_clip>0:
    nA:=4095; nB:=-4095; nC:=4095; nD:=-4095;
    for i=1 upto cntM:
      if xpart(posM[1][i])<nA: nA:=xpart(posM[1][i]); fi
      if xpart(posM[2][i])>nB: nB:=xpart(posM[2][i]); fi
      if ypart(posM[1][i])<nC: nC:=ypart(posM[1][i]); fi
      if ypart(posM[2][i])>nD: nD:=ypart(posM[2][i]); fi
    endfor
    font_wd:=nB-nA+2margin_left_right;
    font_ht:=nD-nC+2margin_top_bottom;
    for i=1 upto cntM:
      posM[0][i]:=posM[0][i]+(margin_left_right-nA,margin_top_bottom-nC);
    endfor
  fi
  %-----------------------------------------------------------------------------------------------
  beginchar(char_num,font_wd/bp*bp#,font_ht/bp*bp#,0)
  if (sw_font_frame=1)or(sw_font_frame=3): draw_frame((0,0),w,h,thickness_font_frame); fi
  if (sw_font_frame=2)or(sw_font_frame=3):
    nA:=w-2margin_left_right; nB:=h-2margin_top_bottom;
    pT:=(margin_left_right,margin_top_bottom);
    draw_frame(pT,nA,nB,thickness_font_frame);  fi
  if sw_font_frame=4: draw_corner(w,h,thickness_font_frame); fi
  for i=1 upto cntM:
    addto currentpicture also mol_stru[i] shifted posM[0][i]; mol_stru[i]:=nullpicture;
  endfor
  if f_ext=1: addto currentpicture also mol_stru[0]; mol_stru[0]:=nullpicture; fi
  endchar;
  clearit;
  endgroup;
  restore_par(parameter_list);
  atomfont:=save_atomfont;
  defaultfont:=save_defaultfont;
  if proc_end=1: scantokens("bye"); fi
enddef;
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
def set_def_MC=
  save /,//,/*,*/,**,~,~~,^,^^,`,'`,<,>,>>,:>,&,&$,:,=,\,\\,*\,\*,@,$,{,},
       |,||,|<,>|,|:,:|,_,d,w,z,inside_def_MC;
  inside_def_MC:=1;
  _:=Me; d:=db; w:=wf; z:=zf;
  tertiarydef a=b == change_bond(a)(b) enddef; 
  tertiarydef a:b == change_atom(a)(b) enddef;
  def { == '''( enddef;  let } == );
  vardef $primary a == a-4095 enddef;
  def &primary n ==(_cyc,n) enddef;
  def &$ == & $ enddef;
  def ^^primary n == (_tmp_rot,n) enddef; def ~~primary n == (_tmp_line,n) enddef;
  def '`primary n == (_tmp_len,n) enddef; def :>primary n == (_tmp_env,n) enddef;
  def >>primary n == (_chg_env,n) enddef; def ``primary n == (_chg_len,n) enddef;
  def <primary n  == (_rot_ang,n) enddef;
  tertiarydef a^b == ^^b,a enddef;  tertiarydef a`b == '`b,a enddef;
  tertiarydef a~b == ~~b,a enddef;  tertiarydef a>b == :>b,a enddef;
  def @ == JP_AT enddef; def \ == @,0 enddef;
  def \\ == \~dm enddef; def *\ == \~wf enddef; def \* == \~zf enddef;
  def |< == (_push,1) enddef; def >| == (_pop,1)  enddef;
  def | == |<,>| enddef;      def || == (_stack_reset,0) enddef;
  def |: == (_push,0) enddef; def :| == (_pop,0)  enddef;
  def /secondary n ==   (_postA,n) enddef;  def //secondary n == (_postB,n) enddef;
  def */secondary n ==  (_postC,n) enddef;  def /*secondary n == (_postD,n) enddef;
  def */*secondary n == (_postE,n) enddef;  def **secondary n == (_postF,n) enddef;
enddef;
%=================================================================================================
vardef '(text s)= ''(incr sub_usr)(s); sub_usr enddef;
%-------------------------------------------------------------------------------------------------
def ''(expr k)(text TXT)=
  begingroup
  if unknown inside_def_MC:: set_def_MC fi
  cntD[k]:=0;
  for list==TXT::
    if known list::
      if pair list:: comD[k][incr cntD[k]]:=xpart(list); parD[k][cntD[k]]:=ypart(list);
      elseif numeric list::
        if list>=sub_emb_start::
          for i==1 upto cntD[list]::
             comD[k][incr cntD[k]]:=comD[list][i]; parD[k][cntD[k]]:=parD[list][i];
            endfor 
        else:: comD[k][incr cntD[k]]:=_mk_bond; parD[k][cntD[k]]:=list; fi
      elseif string list:: strD[incr str_cnt]:=list;
        comD[k][incr cntD[k]]:=_set_atom; parD[k][cntD[k]]:=str_cnt;
        if pic_c(0,list)=="{":: tbl_str_wd[str_cnt]:=1.6; else:: tbl_str_wd[str_cnt]:=1; fi
      fi
    fi
  endfor
  endgroup
enddef;
%-------------------------------------------------------------------------------------------------
vardef '''(text TXT)=
  sub_int:=sub_int+1;
  cntD[sub_int]:=0;
  for list==TXT:: cntD[sub_int]:=cntD[sub_int]+1;
    if     numeric list::
      comD[sub_int][cntD[sub_int]]:=_numeric;    parD[sub_int][cntD[sub_int]]:=list;
    elseif pair list::
      comD[sub_int][cntD[sub_int]]:=xpart(list); parD[sub_int][cntD[sub_int]]:=ypart(list);
    fi
  endfor
  sub_int    %------- Retern value -------
enddef;
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
def FR(expr a)(expr b) =
  PA(_jp_bond,a) PA(_rot_ang,180) PA(_get_len,a) PA(_push,0)
  PA(_chg_len,_ring_len) for i==1 upto b-2:: PA(_mk_bond,360 DIV b) endfor  PA(_pop,0)
  if a>=1:: PA(_cyc_eB,0) elseif a>=-999:: PA(_cyc_eB,a-b+2) else:: PA(_cyc_eB,a) fi
enddef;
%-------------------------------------------------------------------------------------------------
def FFR(expr a)(expr b)(expr c) =
  PA(_jp_bond,xpart(a)) PA(_rot_ang,180) PA(_push,0)
  if     b==6:: PA(_chg_len,0) for i==1 upto c-1:: PA(_mk_bond,60) endfor
  elseif b==5:: if     c==2:: PA(_chg_len,1.25) PA(_mk_bond,80)
                elseif c==3:: PA(_chg_len,1.1)  PA(_mk_bond,78) PA(_mk_bond,72) fi
  elseif b==4:: PA(_chg_len,1.225) PA(_mk_bond,105) fi
  PA(_pop,0) if ypart(a)<=0:: PA(_cyc_eB,ypart(a)-c+1) else:: PA(_cyc_eB,ypart(a)) fi
enddef;
%-------------------------------------------------------------------------------------------------
def FRR(expr a)(expr b)(expr c) =
  PA(_jp_bond,a) PA(_rot_ang,180) PA(_push,0) PA(_chg_len,c DIV 10)
  if     b==5:: PA(_mk_bond,72-((c-9) MUL 1.5)) PA(_mk_bond,72+(c-9)) PA(_mk_bond,72+(c-9))
  elseif b==6:: PA(_mk_bond,60-(c-8)) for i==1 upto 3:: PA(_mk_bond,60+((c-8) DIV 2)) endfor
  elseif b==7:: PA(_mk_bond,360 DIV 7-(c-8))
                for i==1 upto 4:: PA(_mk_bond,360 DIV 7+((c-8) DIV 2.5)) endfor
  elseif b==8:: PA(_mk_bond,45-(c-8))  for i==1 upto 5:: PA(_mk_bond,45+((c-8) DIV 3)) endfor
  fi
  PA(_pop,0) if a>=1:: PA(_cyc_eB,0) else:: PA(_cyc_eB,list) fi
enddef;
%==================================================================================================
vardef change_bond(expr a)(expr e) =
  sub_int:=sub_int+1;
  cntD[sub_int]:=0;
  if known e:: if numeric e::
    if (e>=si)and(e<=bd_):: if e==dl:: PP(a)(_dl) else:: PX(a)(_set_line,e) fi
    elseif (e>=?3)and(e<=?20)::
        if a>=sub_int_start:: for i==1 upto cntD[a]:: FR(parD[a][i])(e-?3+3) endfor
        else::                FR(a)(e-?3+3)
        fi
    elseif e==Ph1:: FR(a)(6) PA(_dl,-2) PA(_dl,-4)
    elseif e==Ph2:: FR(a)(6) PA(_dl,-1) PA(_dl,-3) PA(_dl,-5)
    elseif e==JP_AT:: PA(_jp_bond,a)
    elseif comD[e][1]==_fuse::
      if      comD[e][2]<=6::                      FFR(a)(parD[e][1])(comD[e][2])
      elseif (comD[e][2]>=11)and(comD[e][2]<=15):: FRR(a)(parD[e][1])(comD[e][2])
      fi
    fi
  elseif color e:: color_list[incr cntC]:=e; PX(a)(_set_colorB,cntC)
  fi fi
  sub_int    %------- Retern value -------
enddef;
%-------------------------------------------------------------------------------------------------
vardef change_atom(expr a)(expr e)=
  sub_int:=sub_int+1;
  cntD[sub_int]:=0;
  if known e:: if numeric e::
    if (e>=H)and(e<=U):: if e==N:: PP(a)(_N) elseif e==O:: PP(a)(_O) elseif e==S:: PP(a)(_S)
                         else::    PX(a)(_chg_atom,e)
                         fi
    elseif e==NH::    PA(_set_clr,1) PP(a)(_N) PX(a)(_postH,H) PA(_set_clr,0)
    elseif e==JP_AT:: PA(_jp_atom,a)
    fi
  elseif pair e::  PA(_set_clr,1) PX(a)(xpart(e),ypart(e)) PA(_set_clr,0)
  elseif color e:: color_list[incr cntC]:=e; PX(a)(_set_colorA,cntC)
  fi fi
  sub_int  %------- Retern value -------
enddef;
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
def ext_setup=
  pickup pencircle scaled ext_defaultline;
  dotlabeldiam:=3bp;
  labeloffset:=3bp;
  save em;
  em=defaultscale*defaultsize;
  if (defaultfont="draw")or(f_MP=0)or(sw_label_emu=1):
    save label,dotlabel;
    def label = label_emu enddef;
    def dotlabel = dotlabel_emu enddef;
  fi
  if (sw_arrow=0)or(f_MP=0):
    save drawarrow,drawdblarrow;
    def drawarrow = drawarrow_emu enddef;
    def drawdblarrow = drawdblarrow_emu enddef;
  fi
enddef;
%--------------------------------------------------------------------------------------------------
def EXT(text TXT)=
  begingroup
  save w,h,wd,ht,n,p,am,aw;
  pair p[];
  ext_setup;
  w:=font_wd;
  h:=font_ht;
  w0:=w-2margin_left_right;
  h0:=h-2margin_top_bottom;
  p0:=(margin_left_right,margin_top_bottom);
  aw:=atom_wd;
  n:=cntM;
  for i=1 upto n: p[i]:=posM[1][i]; w[i]:=wdM[i]; h[i]:=htM[i]; endfor
  TXT addto mol_stru[0] also currentpicture; clearit; f_ext:=1;
  endgroup;
enddef;
%--------------------------------------------------------------------------------------------------
def ext(text TXT)=
  begingroup
  save w,h,n,l,p,am,aw,A,B;
  numeric A[]dir,B[]dir;
  pair p[],A[],B[],B[]s,B[]e;
  ext_setup;
  w:=mol_wd; h:=mol_ht; l:=bond_len; aw:=atom_wd;
  p0:=(minX,minY); An:=cntA; Bn:=cntB;
  for i=1 upto An: A[i]:=posA[i]; A[i]dir:=ang_br[i]; endfor
  for i=1 upto Bn:
    B[i]s:=posA[sB[i]]; B[i]e:=posA[eB[i]]; B[i]:=0.5[B[i]s,B[i]e]; B[i]dir:=angB[i];
  endfor
  TXT addto mol_stru[cntM] also currentpicture; clearit;
  endgroup;
enddef;
%==================================================================================================
def ext_puts(expr a)(expr STR)=
  begingroup
  save cp,sA,pC;
  pair cp;
  string sA;
  picture pC;
  cp:=a;
  nB:=defaultscale*defaultsize;
  nC:=0;
  %------------------------------------------------------------------------------------------------
  for i=0 upto length(STR)-1:
    sA:=pic_c(i,STR);
    nA:=ASCII(sA);
    if sw_label_emu=1:
      if     sA="_": if nC=-0.5: nC:=0; else: nC:=-0.5; fi
      elseif sA="^": if nC= 0.5: nC:=0; else: nC:= 0.5;  fi
      else:
        if defaultfont="draw":
          draw_char(sA,cp+(0,nB*nC),nB,0.35*ratio_char_bond*bp,0);
          cp:=cp+(nB*tbl_char_wd[nA],0);
        else:
          pC:=sA infont defaultfont scaled defaultscale;
          addto currentpicture also pC shifted (cp+(0,nB*nC));
          cp:=cp+(lrcorner pC-llcorner pC);
        fi
      fi
    else:   draw_char(sA,cp,nB,0.35*ratio_char_bond*bp,0);
            cp:=cp+(nB*tbl_char_wd[nA],0);
    fi
  endfor
  endgroup;
enddef;
%--------------------------------------------------------------------------------------------------
vardef label_emu@#(expr STR,POS) = %% modified 'thelabel@#(expr s,z)' of plain.mp
  save oft,fx,fy,wds,sC,pC;
  pair oft,oft.lft,oft.rt,oft.top,oft.bot,oft.ulft,oft.llft,oft.urt,oft.lrt;
  string sC;
  picture pC;
  wds:=0;
  for i=0 upto length(STR)-1:
    sC:=pic_c(i,STR);
    if not((sw_label_emu=1)and((sC="_")or(sC="^"))):
      if (defaultfont="draw")or(f_MP=0):
        wds:=wds+defaultscale*defaultsize*tbl_char_wd[ASCII(sC)];
      else:
        pC:=sC infont defaultfont scaled defaultscale;
        wds:=wds+xpart(lrcorner pC-llcorner pC);
      fi
    fi
  endfor
  oft:=     (  0,  0);   fx:=0.5;      fy:=0.5;
  oft.lft:= ( -1,  0);   fx.lft:=1;    fy.lft:=0.5;
  oft.rt := (  1,  0);   fx.rt :=0;    fy.rt :=0.5;
  oft.bot:= (  0, -1);   fx.bot:=0.5;  fy.bot:=1;
  oft.top:= (  0,  1);   fx.top:=0.5;  fy.top:=0;
  oft.ulft:=(-.7, .7);   fx.ulft:=1;   fy.ulft:=0;
  oft.urt:= ( .7, .7);   fx.urt:=0;    fy.urt:=0;
  oft.llft:=(-.7,-.7);   fx.llft:=1;   fy.llft:=1;
  oft.lrt:= ( .7,-.7);   fx.lrt:=0;    fy.lrt:=1;
  ext_puts(POS+(labeloffset*oft@#)-(wds*fx@#,defaultscale*defaultsize*fy@#))(STR);
enddef;
%-------------------------------------------------------------------------------------------------
vardef dotlabel_emu@#(expr STR,POS)=
  label_emu@#(STR,POS);
  draw POS withpen pencircle scaled dotlabeldiam;
enddef;
%==================================================================================================
def drawarrow_emu expr PAT = arrow_path:=PAT; draw_arrow enddef;
%-------------------------------------------------------------------------------------------------
def draw_arrow text t =  %% modified 'drawarrow' of plain.mp
  filldraw arrow_head rotated ahead_angle(reverse arrow_path)
    shifted point infinity of arrow_path t;
  draw arrow_path t
enddef;
%-------------------------------------------------------------------------------------------------
def drawdblarrow_emu expr PAT = arrow_path:=PAT; draw_dblarrow enddef;
%-------------------------------------------------------------------------------------------------
def draw_dblarrow text t =
  filldraw arrow_head rotated ahead_angle(arrow_path) shifted point 0 of arrow_path t;
  filldraw arrow_head rotated ahead_angle(reverse arrow_path)
     shifted point infinity of arrow_path t;
  draw arrow_path t
enddef;
%-------------------------------------------------------------------------------------------------
arrow_head:=(ahlength,-(sind 0.5ahangle)*ahlength)--(0,0)--
            (ahlength, (sind 0.5ahangle)*ahlength)--cycle;
%-------------------------------------------------------------------------------------------------
def ahead_angle(expr p) =
  angle direction .5ahlength/length(point 1 of p - point 0 of p)  of p
enddef;
%=================================================================================================
def sub_add(expr a,b)=
  cntD[sub_int]:=cntD[sub_int]+1; comD[sub_int][cntD[sub_int]]:=a; parD[sub_int][cntD[sub_int]]:=b;
enddef;
%-------------------------------------------------------------------------------------------------
def sub_add_op(expr a,b)=
  op_cnt[cntP]:=op_cnt[cntP]+1; op_com[cntP][op_cnt[cntP]]:=a; op_par[cntP][op_cnt[cntP]]:=b;
enddef;
%-------------------------------------------------------------------------------------------------
def sub_pro(expr c)(expr a)=
  if c>=sub_int_start:: for i==1 upto cntD[c]:: sub_add(a,parD[c][i]) endfor
  else:: sub_add(a,c) fi
enddef;
%-------------------------------------------------------------------------------------------------
def sub_ext(expr c)(expr a,b)=
  if c>=sub_int_start::
    for i==1 upto cntD[c]::
      if comD[c][i]<>_numeric:: sub_add(comD[c][i],parD[c][i])
      else:: sub_add(_set_adr,parD[c][i]) sub_add(a,b) fi
    endfor
  else:: sub_add(_set_adr,c) sub_add(a,b) fi
enddef;
%=================================================================================================
def MCa(expr FW,FH)(text s)= MCd(1,1)(FW,FH)(s) enddef;
def MCc(expr RW,RH)(text s)= MCd(RW,RH)(0.5,0.5)(s) enddef;
def MCf(text s)=             MCd(1,1)(0.5,0.5)(s) enddef;
%-------------------------------------------------------------------------------------------------
def MCd(expr RW,RH)(expr FW,FH)(text TX)=
  begingroup
  save com,par,adrA,adrB,f_bra,envT,envB,lenT,lineT,strAT,stkA,stkB,stkL,stkM,cntP,bondL,temp_len,
       temp_cntB,f_end,f_term,rotT,adrS,f_at,f_lineT,f_rotT,f_lenT,f_envT,angT,tempB,glu,xpos,ypos,
       str_len,max_x,max_y,par_s,par_e,score_u,hat,f_char,ps_adr,ps_com,op_com,op_par,op_cnt,crR,
       colorA,colorB,PA,PO,PP,PX;
  %-----------------------------------------------------------------------------------------------
  def PA= sub_add enddef;
  def PO= sub_add_op enddef;
  def PP= sub_pro enddef;
  def PX= sub_ext enddef;
  %-----------------------------------------------------------------------------------------------
  numeric stkB[],stkA[],stkL[],stkM[],f_char[],ps_adr[],ps_com[],colorA[],colorB[],
          op_com[][],op_par[][],op_cnt[];
  %-----------------------------------------------------------------------------------------------
  if (sw_numberA>=1)or(sw_numberB>=1): ratio_atom_bond:=0.25; fi
  if (sw_expand=1)or(sw_MOLout=1): expand_set; fi
  sub_usr:=sub_usr_start;
  sub_int:=sub_int_start;
  par_s:=ASCII("{"); par_e:=ASCII("}"); score_u:=ASCII("_"); hat:=ASCII("^");
  cntA:=cntB:=cntP:=cntC:=0; strD[0]:=""; str_cnt:=2000; crR:=-ratio_chain_ring;
  %===============================================================================================
  ''(0)(TX,(_term,0));
  proc_bond_atom(1);
  if (cntP>0)and(sw_subst_off=0): ps_get(1); fi
  char_use_check;
  if     sw_solid=1: bond_len:=font_wd*ratio_bond_width;
                     proc_size_setup; proc_skeleton; proc_scaling;
  elseif sw_solid=2: proc_size_setup; proc_skeleton; proc_scaling;
  else:
    bond_len:=3mm; proc_size_setup;
    for i=1 upto 6: proc_skeleton; proc_scaling;
      if (mol_ht/mol_wd)>(font_ht/font_wd): factor:=(font_ht*RH-2margin_top_bottom)/mol_ht;
      else:                                 factor:=(font_wd*RW-2margin_left_right)/mol_wd;  fi
      exitif factor=1;
      bond_len:=bond_len*factor; proc_size_setup;
    endfor
    if bond_len>max_bond_length:
       bond_len:=max_bond_length; proc_size_setup; proc_skeleton; proc_scaling;  fi
  fi
  %-----------------------------------------------------------------------------------------------
  for i=1 upto cntB: if lineB[i]<si_ : draw_bond(i,sB[i],eB[i],angB[i],lineB[i]); fi endfor
  for i=1 upto cntB: if lineB[i]>=si_: draw_bond(i,sB[i],eB[i],angB[i],lineB[i]); fi endfor
  %-----------------------------------------------------------------------------------------------
  for i=1 upto cntA:
    if (sw_numberA>=1)and(i>=numberA_start)and(i<=numberA_end):
       if     sw_numberA=2: nA:=i-numberA_start+1;
       elseif sw_numberA=3: if numberA_end<cntA: nA:=numberA_end-i+1; else: nA:=cntA-i+1; fi
       else:  nA:=i; fi
       if     i<10:  draw_atom(i,posA[i],0,decimal(nA),1);
       else:         draw_atom(i,posA[i]+(-.2atom_wd,0),0,decimal(nA),1);  fi
    elseif sw_numberB>=1:
    else:  draw_atom(i,posA[i],ang_br[i],strD[numS[i]],tbl_str_wd[numS[i]]);  fi
  endfor
  %-----------------------------------------------------------------------------------------------
  sftX:=margin_left_right-minX+(font_wd-mol_wd-2margin_left_right)*FW;
  sftY:=margin_top_bottom-minY+(font_ht-mol_ht-2margin_top_bottom)*FH;
  posM[0][incr cntM]:=(sftX,sftY);
  posM[1][cntM]:=(minX+sftX,minY+sftY);
  posM[2][cntM]:=(max_x+sftX,max_y+sftY);
  wdM[cntM]:=mol_wd;
  htM[cntM]:=mol_ht;
  if sw_mol_frame=1: draw_frame((minX,minY),mol_wd,mol_ht,thickness_font_frame) fi
  addto mol_stru[cntM] also currentpicture;
  clearit;
  endgroup;
  if ((sw_auxout=1)or(sw_report=1)or(sw_MOLout=1))and(f_MP=1): proc_calc_out; fi
  %-----------------------------------------------------------------------------------------------
%%%%  message "count of usr ="& decimal(sub_usr) &" "& decimal(sub_usr-sub_usr_start);
%%%%  message "count of int ="& decimal(sub_int) &" "& decimal(sub_int-sub_int_start);
  %-----------------------------------------------------------------------------------------------
enddef;
%-------------------------------------------------------------------------------------------------
def ps_put(expr n,p)=
  ps_adr[incr cntP]:=n; ps_com[cntP]:=p; op_cnt[cntP]:=0;
  if lineT<>0:  PO(_tmp_line,lineT) fi
  if rotT<>0:   PO(_rot_ang,rotT) fi
  if lenT<>crR: PO(_chg_len,lenT) fi
  if envT<>hz:  PO(_chg_env,envT) fi
  if lineT=nl:  PO(_chg_len,_size_a) PO(_adj_ang,0) fi
  if lineT<>0:  PO(_mk_bond,0) fi
  if f_lineT=0: lineT:=si; fi
  if f_lenT=0:  lenT:=crR; fi 
  if f_rotT=0:  rotT:=0;   fi
  if f_envT=0:  envT:=hz;  fi
enddef;
%-------------------------------------------------------------------------------------------------
def ps_get(expr n)=
  save sub_int;
  sub_int:=0;
  nA:=cntP;
  nB:=cntD[0];
  for i=n upto cntP:
    PA(_jp_atom_abs,ps_adr[i]) PA(_push,1)
    for j=1 upto op_cnt[i]: PA(op_com[i][j],op_par[i][j]) endfor
    for j=1 upto cntD[ps_com[i]]: PA(comD[ps_com[i]][j],parD[ps_com[i]][j]) endfor 
    PA(_pop,1) PA(_term,0)
  endfor
  proc_bond_atom(nB+1); if cntP>nA: ps_get(nA+1); fi
enddef;
%-------------------------------------------------------------------------------------------------
def draw_frame(expr PS,LX,LY,PN)=
  draw ((0,0)--(LX,0)--(LX,LY)--(0,LY)--cycle) shifted PS wpss PN;
enddef;
%-------------------------------------------------------------------------------------------------
def draw_corner(expr LX,LY,PN)=
  drawdot(0,0) wpss PN; drawdot(LX,0) wpss PN; drawdot(LX,LY) wpss PN; drawdot(0,LY) wpss PN;
enddef;
%-------------------------------------------------------------------------------------------------
def proc_size_setup=
  if (bond_len*ratio_atom_bond+offset_atom)<.8bond_len:
        atom_wd:=bond_len*ratio_atom_bond+offset_atom;
  else: atom_wd:=.8bond_len; ratio_chain_ring:= .5; fi
  wedge_wd:=    bond_len*ratio_wedge_bond+offset_wedge;
  zebra_gap:=   bond_len*ratio_zebragap_bond+offset_zebra_gap;
  bondgap:=     bond_len*ratio_bondgap_bond+offset_bond_gap;
  bond_pen_wd:= bond_len*ratio_thickness_bond+offset_thickness;
enddef;
%-------------------------------------------------------------------------------------------------
def proc_scaling=
  minX:=minY:=4095.999;
  max_x:=max_y:=-4095.999;
  for i=1 upto cntA:
    xpos:=xpart(posA[i]); ypos:=ypart(posA[i]);
    if numS[i]<>0: str_len:=nC:=nD:=0;
      for j=0 upto length(strD[numS[i]])-1:
        nA:=ASCII(pic_c(j,strD[numS[i]]));
        if (nA=score_u)or(nA=hat)or(nA=par_s)or(nA=par_e):
          if (nA=hat)and(nC<.5atom_wd): nC:=.5atom_wd; fi;
          if (nA=score_u)and(nD<.5atom_wd): nD:=.5atom_wd; fi;
        else: str_len:=str_len+atom_wd*tbl_char_wd[nA]; fi  
      endfor
      str_ang:=(ang_br[i] mod 360); nF:=str_len;
      if     (str_ang<=91)or(str_ang>=269): nF:=0; else: str_len:=0; fi
      if     (xpos-nF+.5atom_wd)<minX: minX:=xpos-nF+.5atom_wd;
      elseif (xpos+str_len-.5atom_wd)>max_x: max_x:=xpos+str_len-.5atom_wd; fi
      if     (ypos-nD-.5atom_wd)<minY: minY:=ypos-nD-.5atom_wd;
      elseif (ypos+nC+.5atom_wd)>max_y: max_y:=ypos+nC+.5atom_wd; fi
      else: if xpos<minX: minX:=xpos; elseif xpos>max_x: max_x:=xpos; fi
            if ypos<minY: minY:=ypos; elseif ypos>max_y: max_y:=ypos; fi fi
  endfor
  mol_wd:=max_x-minX; mol_ht:=max_y-minY;
enddef;
%-------------------------------------------------------------------------------------------------
def char_use_check=
  for i=1 upto 128: f_char[i]:=0; endfor
  if (sw_numberA<>0)or(sw_numberB<>0):
    for j=ASCII("0") upto ASCII("9"): f_char[j]:=1; endfor
  else:
    for i=1 upto cntA:
      if numS[i]<>0:
        for j=0 upto length(strD[numS[i]])-1: f_char[ASCII(pic_c(j,strD[numS[i]]))]:=1; endfor
      fi
    endfor
  fi
enddef;
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
def proc_bond_atom(expr n)=
  f_bra:=f_end:=f_term:=rotT:=adrS:=f_lineT:=f_rotT:=f_lenT:=f_envT:=envT:=envB:=strAT:=f_at:=0;
  stkL[0]:=bondL:=crR; lenT:=crR; sB[0]:=0; eB[0]:=1; lineT:=si;
  for i=0 upto 5: stkA[i]:=stkB[i]:=0; endfor
  %-----------------------------------------------------------------------------------------------
  for i=n upto cntD[0]:
  com:=comD[0][i];
  par:=parD[0][i];
  if     com=_push: 
    if par=1: stkL[adrS]:=bondL; stkA[incr adrS]:=adrA:=cntA; stkB[adrS]:=adrB:=cntB;
    elseif par=0: temp_len:=bondL; fi
  elseif com=_pop: if par=1: adrA:=stkA[decr adrS]; adrB:=stkB[adrS]; bondL:=stkL[adrS];
                   elseif par=0: bondL:=temp_len; fi
  elseif com=_mk_bond:  if (par=0)and(rotT<>0): rotT:=0; fi  add_atom;
  elseif com=_set_adr:  adrT:=par;
  elseif com=_set_atom: strAT:=par;
  elseif com=_postA:            if f_at=1: ps_put(getA(adrT),par); else: ps_put(cntA+1,par); fi
  elseif com=_postB: lineT:=dm; if f_at=1: ps_put(getA(adrT),par); else: ps_put(cntA+1,par); fi
  elseif com=_postC: lineT:=wf; if f_at=1: ps_put(getA(adrT),par); else: ps_put(cntA+1,par); fi
  elseif com=_postD: lineT:=zf; if f_at=1: ps_put(getA(adrT),par); else: ps_put(cntA+1,par); fi
  elseif com=_postE: lineT:=nl; if f_at=1: ps_put(getA(adrT),par); else: ps_put(cntA+1,par); fi
  elseif com=_postF: lineT:=0;  if f_at=1: ps_put(getA(adrT),par); else: ps_put(cntA+1,par); fi
  elseif com=_postH: lineT:=nl; lenT:=_size_a; ps_put(getA(adrT),par);
  elseif com=_jp_bond:     termA; tempB:=getB(par); sB[cntB+1]:=sB[tempB]; f_bra:=1;
  elseif com=_jp_atom:     termA; sB[cntB+1]:=getA(par); f_bra:=1;
  elseif com=_jp_atom_abs: sB[cntB+1]:=par; f_bra:=1; temp_cntB:=cntB;
  elseif com=_chg_atom:   numS[getA(adrT)]:=parD[par][1];
  elseif com=_N:          numS[getA(par)]:=parD[N][1];
  elseif com=_O:          numS[getA(par)]:=parD[O][1];
  elseif com=_S:          numS[getA(par)]:=parD[S][1];
  elseif com=_H:          ps_put(getA(par),H);
  elseif com=_chg_len: if par=_ring_len: bondL:=ringL;
                       elseif par=0: if lenT<>crR: bondL:=lenT; else: if bondL<0: bondL:=1; fi fi
                       else: bondL:=par; fi
  elseif com=_get_len: if par=0: if bondL=crR: bondL:=lenT; fi else: ringL:=lenB[getB(par)]; fi
  elseif com=_tmp_len: lenT:=par;
  elseif com=_set_line: lineB[getB(adrT)]:=par;
  elseif com=_dl:       lineB[getB(par)]:=dl;
  elseif com=_mb:       lineB[getB(-1)]:=par;
  elseif (com=_chg_line)or(com=_tmp_line): lineT:=par;
  elseif com=_tmp_rot:    rotT:=par;
  elseif com=_cyc:        f_end:=getA(par); add_atom;
  elseif com=_cyc_eB:  f_end:=eB[getB(par)]; add_atom;
  elseif com=_cyc_sB:  f_end:=sB[getB(par)]; add_atom;
  elseif com=_chg_env: envB:=par;
  elseif com=_tmp_env: envT:=par;
  elseif com=_set_clr:
     f_at:=par;
     if     par=1: if lineT<>si: f_lineT:=1; fi if rotT<>0:  f_rotT:=1; fi
                   if lenT<>crR: f_lenT:=1;  fi if envT<>hz: f_envT:=1; fi
     elseif par=0: f_lineT:=f_rotT:=f_lenT:=f_envT:=rotT:=envT:=0; lineT:=si; lenT:=crR;
     fi
  elseif com=_stack_reset: stkA[adrS+1]:=0;
  elseif com=_term:       termA;
  elseif com=_set_colorA: colorA[getA(adrT)]:=par;
  elseif com=_set_colorB: colorB[getB(adrT)]:=par;
  fi
  endfor
enddef;
%-------------------------------------------------------------------------------------------------
def add_atom=
  lineB[incr cntB]:=lineT;
  lineT:=si;
  if lenT=crR: lenB[cntB]:=bondL; else: lenB[cntB]:=lenT; lenT:=crR; fi
  if f_bra=0:  cntA:=cntA+1; sB[cntB]:=cntA; numS[cntA]:=strAT; strAT:=0;
              if f_MP=1: colorA[cntA]:=colorB[cntA]:=0; fi  else: f_bra:=0; fi
  if f_end=0: eB[cntB]:=cntA+1; f_term:=0; else: eB[cntB]:=f_end; f_end:=0; f_term:=1; fi
enddef;
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
def proc_skeleton=
  adrA:=adrB:=cntA:=cntB:=angT:=adrS:=f_end:=f_bra:=rotT:=f_term:=f_at:=0;
  envT:=envB:=f_lineT:=f_rotT:=f_lenT:=f_envT:=stkM[0]:=0; lineT:=si;
  angA[0]:=angB[0]:=ang_br[0]:=0; posA[0]:=posBs:=posBe:=(0,0);
  for i=0 upto 5: stkA[i]:=stkB[i]:=0; endfor
  %----------------------------------------------------------------------------------------------
  for i=1 upto cntD[0]:
  com:=comD[0][i]; par:=parD[0][i];
  if com=_push: if     par=1: stkM[adrS]:=envB; adrS:=adrS+1; stkA[adrS]:=adrA:=cntA;
                          stkB[adrS]:=adrB:=cntB;
                elseif par=0: temp_len:=bondL; fi
  elseif com=_pop:     if par=1: adrA:=stkA[decr adrS]; adrB:=stkB[adrS]; envB:=stkM[adrS];
                       elseif par=0: temp_len:=bondL; fi
  elseif com=_jp_bond:  termB; tempB:=getB(par); posBs:=posA[sB[tempB]];
                        angT:=angB[tempB]; f_bra:=1; rotT:=0;
  elseif com=_jp_atom:     termB; adrT:=getA(par); posBs:=posA[adrT];
                           angT:=ang_br[adrT]; f_bra:=1; rotT:=0;
  elseif com=_jp_atom_abs: adrT:=par; posBs:=posA[adrT];
                           angT:=ang_br[adrT]; f_bra:=1; rotT:=0; temp_cntB:=cntB;
  elseif com=_adj_ang:  if (angT<40)or(angT>320): angT:=0; elseif angT<140: angT:=90;
                        elseif angT<220: angT:=180; else: angT:=270; fi
  elseif com=_mk_bond:  if (par=0)and(rotT<>0):par:=rotT; rotT:=0; fi add_bond(par);
  elseif com=_rot_ang:  angT:=(angT+par) mod 360;
  elseif com=_tmp_rot:  rotT:=par;
  elseif (com>=_postA)and(com<=_postH): rotT:=0;
  elseif com=_chg_env: envB:=par;
  elseif com=_tmp_env: envT:=par;
  elseif com=_set_clr: f_at:=par; if par=0: lineT:=si; lenT:=crR; rotT:=envT:=0; fi
  elseif com=_cyc:     f_end:=1; proc_cyc(getA(par));
  elseif com=_cyc_sB:  f_end:=1; proc_cyc(sB[getB(par)]);
  elseif com=_cyc_eB:  f_end:=1; proc_cyc(eB[getB(par)]);
  elseif com=_term:    termB;
  elseif com=_stack_reset:   stkA[adrS+1]:=0;
  fi
  endfor
enddef;
%-------------------------------------------------------------------------------------------------
def add_bond(expr m)=
  if m=_arg_ang: nA:=proc_env(angT,envB,60,-60); else: nA:=m; fi
  if f_bra=0:
    adrT:=cntA:=cntA+1; posA[cntA]:=posBs; angA[cntA]:=angT;
    if nA>=0: ang_br[cntA]:=angT+nA/2-90; else: ang_br[cntA]:=angT+nA/2+90; fi
  else: f_bra:=0;
  fi
  angB[cntB+1]:=angT:=(angT+nA) mod 360;
  if f_end=0:
    if lenB[cntB+1]=_size_a: posBe:=sfB(posBs,atom_wd,angT);
    else:
      nA:=lenB[cntB+1]; glu:=0; if nA<0: nA:=-nA; glu_c(adrT); glu_c(cntA+1); fi
      posBe:=sfB(posBs,nA*bond_len+glu,angT);
    fi
    posA[cntA+1]:=posBe; f_term:=0;
  else:
    f_end:=0; f_term:=1;
  fi
  cntB:=cntB+1; posBs:=posBe;
enddef;
%==================================================================================================
vardef getA(expr n)=
 if n>=0: stkA[adrS+1]+n elseif n>=-999: cntA+n+1 else: stkA[adrS]+n+4095 fi enddef;
vardef getB(expr n)=
 if n>=1: stkB[adrS+1]+n elseif n=0: tempB elseif n>=-999: cntB+n+1 else: stkB[adrS]+n+4095 fi
enddef;
def termA= if f_term=0: if f_bra=0: numS[incr cntA]:=strAT; strAT:=0;
           if f_MP=1: colorA[cntA]:=0; fi else: f_bra:=0; fi f_term:=1; fi enddef;
def termB=
  if f_term=0: if f_bra=0: ang_br[incr cntA]:=angT; else: f_bra:=0; fi f_term:=1; fi enddef;
def proc_cyc(expr n)= add_bond(angle(posA[n]-posBs)-angT);  enddef;
def glu_c(expr n)=  if numS[n]<>0: nB:=angT mod 180; nC:=.5tbl_str_wd[numS[n]]*atom_wd;
                    if (nB<45)or(nB>135):glu:=glu+((sind(nB)*nC)++nC);
                    else                :glu:=glu+((cosd(nB)*.5atom_wd)++.5atom_wd) fi fi
enddef;
vardef proc_env(expr n,m,a,b)=  r:=(n mod 360);
  if m>=sub_emb_start: parD[m][cntB-temp_cntB] else:
    if     m=hz:if r=0:a elseif r<=90:b elseif r<=180:a elseif r<270:b  else:a fi
    elseif m=vt:if r=0:b elseif r<90:a  elseif r<=180:b elseif r<=271:a else:b fi
    elseif (m>=-180)and(m<=180): m fi fi
enddef;
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
def draw_atom(expr NUM,POS,ANG,STR,WD)=
  begingroup
  save pA,pT,dx,pC,nE,nC;
  string sB;
  pair pA,pT;
  picture pC;
  %----------------------------------------------------------------------------------------------
  if ((ANG mod 360)<=90+1)or((ANG mod 360)>=270-1): dx:=1; else: dx:=-1; fi
  pT:=POS-(0.5atom_wd*dx*WD,0.5atom_wd);
  nE:=nC:=0;
  for i=0 upto length(STR)-1:
    sB:=pic_c(i,STR); nB:=ASCII(sB);
    if dx<0: if nB=par_s: k:=i+1; nC:=1; forever: exitif pic_c(i+(incr nC),STR)="}";endfor fi
             if nC>0: sB:=pic_c(k+(decr nC),STR); nB:=ASCII(sB); fi
    fi
    if     nB=score_u: if nE=0: nE:=-.5; else: nE:=0; fi;
    elseif nB=hat:     if nE=0: nE:= .5; else: nE:=0; fi;
    elseif (nB<>par_s)and(nB<>par_e):
      nA:=atom_wd*tbl_char_wd[nB];
      if (atomfont<>"draw")and(f_MP=1):
        pC:=sB infont atomfont scaled (atom_wd/atomfontsize);
        if dx=-1: pA:=pT-(lrcorner pC-llcorner pC)+(0,nE*atom_wd);
        else:     pA:=pT+(0,nE*atom_wd);
        fi
        if (sw_numberA>=1)or(sw_numberB>=1):
          erase fill (llcorner pC--lrcorner pC--urcorner pC--ulcorner pC--cycle) shifted pA;
        fi
        addto currentpicture also pC shifted pA Cp(colorA[NUM]);
        if sw_atom_frame=1:
          draw ((llcorner pC--lrcorner pC--urcorner pC--ulcorner pC--cycle) shifted pA)
               withpen pencircle scaled 0.01pt;
        fi
        pT:=pT+(lrcorner pC-llcorner pC)*dx;
      else:
        if dx=-1: pA:=pT+(-nA,nE*atom_wd); else: pA:=pT+(0,nE*atom_wd); fi
        if (sw_numberA>=1)or(sw_numberB>=1):
          erase fill unitsquare xscaled nA yscaled atom_wd shifted pA;
        fi
        draw_char(sB,pA,atom_wd,bond_pen_wd*ratio_char_bond,NUM);
        if sw_atom_frame=1: draw_frame(pA,nA,atom_wd,0.1pt); fi
        pT:=pT+(nA*dx,0);
      fi
   fi
  endfor
  endgroup
enddef;
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
def draw_bond(expr NN,BP,EP,ANG,LN)=
  begingroup
  save ww,ap,am,hpt,Ls,Le,pA,pB,pC,pT;
  pair Ls,Le;
  path pA,pB,pC,pT;
  %----------------------------------------------------------------------------------------------
  nC:=length(posA[EP]-posA[BP]);
  if (nC>0)and(LN<>0):
    ww:=wedge_wd; hpt:=.5bond_pen_wd; ap:=ANG+90; am:=ANG-90;
    if sw_numberB>=1: clipping(0,0,posA[BP],posA[EP],nC);
    else: clipping(numS[BP],numS[EP],posA[BP],posA[EP],nC); fi
    pickup pencircle scaled bond_pen_wd;
    if known colorB[NN]: nB:=colorB[NN]; fi
    %---------------------------------------------------------------------------------------------
    if     (LN=si)or(sw_bond_single=1): draw pA Cp(nB);
    elseif LN=dl:draw pA Cp(nB); draw sfB(pC,bondgap,ap) Cp(nB);
    elseif LN=dr:draw pA Cp(nB); draw sfB(pC,bondgap,am) Cp(nB);
    elseif LN=dm:draw sfB(pB,bondgap/1.75,ap) Cp(nB); draw sfB(pB,bondgap/1.75,am) Cp(nB);
    elseif LN=db:if ((ANG-ang_br[BP]) mod 360)<=180: nA:=ap; else: nA:=am; fi
                 draw pA Cp(nB); draw sfB(pC,bondgap,nA) Cp(nB);
    elseif LN=tm:draw pA Cp(nB);draw sfB(pA,bondgap,ap) Cp(nB); draw sfB(pA,bondgap,am) Cp(nB);
    elseif LN=wf:fill Ls--sfB(Le,ww,am)--sfB(Le,ww,ap)--cycle;
    elseif LN=wb:fill sfB(Ls,ww,am)--Le--sfB(Ls,ww,ap)--cycle;
    elseif LN=bd:draw pA withpen penrazor rotated ap scaled bondgap Cp(nB);
    elseif LN=bz:bz_put(sfB(Ls,ww,ap),sfB(Le,ww,ap),sfB(Ls,ww,am),sfB(Le,ww,am),nB);
    elseif LN=zf:wz_put(Ls,sfB(Le,ww,ap),sfB(Le,ww,am),nB);
    elseif LN=zb:wz_put(Le,sfB(Ls,ww,am),sfB(Ls,ww,ap),nB);
    elseif LN=dt:for i=0 step .75zebra_gap/length(Le-Ls) until 1: drawdot i[Ls,Le]; endfor
    elseif LN=wv:nB:=3bond_pen_wd; nA:=nB/length(Le-Ls);
                  draw Le for i=1 upto 1/nA:
                    if odd(i): ..controls(((i-.5)*nA)[sfB(Le,nB,ap),sfB(Ls,nB,ap)])
                    else: ..controls(((i-.5)*nA)[sfB(Le,nB,am),sfB(Ls,nB,am)]) fi
                          ..(i*nA)[Le,Ls] endfor ..Ls;
    elseif LN=vf:draw pA Cp(nB);draw sfB(Le,bondgap,ANG-150)--Le--sfB(Le,bondgap,ANG+150) Cp(nB);
    elseif LN=vb:draw pA Cp(nB);draw sfB(Ls,bondgap,ANG-30)--Ls--sfB(Ls,bondgap,ANG+30) Cp(nB);
    elseif LN=si_:erase draw 0.15[Ls,Le]--0.85[Ls,Le] wpcs 0.8bondgap; draw pA Cp(nB);
    elseif LN=wf_:erase fill sfB(0.15[Ls,Le],.5ww,ap)--sfB(0.15[Ls,Le],.5ww,am)--
                             sfB(0.85[Ls,Le],1.3ww,am)--sfB(0.85[Ls,Le],1.3ww,ap)--cycle;
                  fill Ls--sfB(Le,ww,am)--sfB(Le,ww,ap)--cycle;
    elseif LN=wb_:erase fill sfB(0.15[Ls,Le],1.3ww,ap)--sfB(0.15[Ls,Le],1.3ww,am)--
                             sfB(0.85[Ls,Le],.5ww,am)--sfB(0.85[Ls,Le],.5ww,ap)--cycle;
                  fill sfB(Ls,ww,am)--Le--sfB(Ls,ww,ap)--cycle;
    elseif LN=bd_:erase draw 0.15[Ls,Le]--0.85[Ls,Le] wpcs 1.6bondgap;
                  draw pA withpen penrazor rotated ap scaled bondgap Cp(nB);
    fi
    if (sw_numberB>=1)and(NN>=numberB_start)and(NN<=numberB_end):
        if     sw_numberB=2: nB:=NN-numberB_start+1;
        elseif sw_numberB=3: if numberB_end<cntB: nB:=numberB_end-NN+1; else: nB:=cntB-NN+1; fi
        else:                nB:=NN; fi
        draw_atom(NN,.5[posA[BP],posA[EP]],0,decimal(nB),1); fi
  fi
  endgroup
enddef;
%------------------------------------------------------------------------------------------------
def wpcs expr n= withpen pencircle scaled n enddef;
def wpss expr n= withpen pensquare scaled n enddef;
def sqr(expr WD,HT)= ((0,0)--(WD,0)--(WD,HT)--(0,HT)--cycle) enddef;
def sfB(expr p,l,r)= p shifted ((l,0) rotated r) enddef;
def wz_put(expr PA,PB,PD,CL)=  nC:=length(Le-Ls);
  for i=0 upto nC/zebra_gap: 
    nA:=zebra_gap*i/nC; nD:=(zebra_gap*i+ratio_zebra_black*zebra_gap)/nC;
    if nD>((nC-zebra_gap)/nC): nD:=1; fi
    fill nA[PB,PA]--nA[PD,PA]--nD[PD,PA]--nD[PB,PA]--cycle Cp(CL); endfor  enddef;
def bz_put(expr PA,PB,PC,PD,CL)=  nC:=length(Le-Ls);
  for i=0 upto nC/zebra_gap: 
    nA:=zebra_gap*i/nC; nD:=(zebra_gap*i+ratio_zebra_black*zebra_gap)/nC;
    fill nA[PB,PA]--nA[PD,PC]--nD[PD,PC]--nD[PB,PA]--cycle Cp(CL); endfor  enddef;
def cut_off(expr p,w,h,s)=
  p intersectionpoint sqr(w+.1h,1.1h) shifted (s-(.5(w+.1h),.5(1.1h))); enddef;
def clipping(expr SA,SB,PA,PB,LEN)=
  pT:=PA--PB; nA:=0.6atom_wd/LEN;
  if (SA=0)and(SB=0): Ls:=PA; Le:=PB; pA:=pB:=pT; pC:=0.1[PA,PB]--0.1[PB,PA];
  elseif SA=0: Ls:=PA; Le:=cut_off(pT,atom_wd*tbl_str_wd[SB],atom_wd,PB); 
     pA:=Ls--Le; pB:=Ls--nA[PB,PA]; pC:=0.1[PA,PB]--Le;
  elseif SB=0: Ls:= cut_off(pT,atom_wd*tbl_str_wd[SA],atom_wd,PA); Le:=PB;
     pA:=Ls--Le; pB:=nA[PA,PB]--Le; pC:=Ls--(0.1)[PB,PA];
  else: Ls:=cut_off(pT,atom_wd*tbl_str_wd[SA],atom_wd,PA);
        Le:=cut_off(pT,atom_wd*tbl_str_wd[SB],atom_wd,PB);
        pB:=nA[PA,PB]--nA[PB,PA]; pC:=pA:=Ls--Le; fi
enddef;
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
sub_usr:=sub_emb_start;
%-------------------------------------------------------------------------------------------------
lr:='(60 for i==1 upto 10:: ,-60,60 endfor); rl:='(-60,lr);
def ring expr n= <((-180 DIV n)-90),(_chg_len,0),
  for i==2 upto n:: ,(360 DIV n) endfor,(_cyc_sB,1-n) enddef;
for i=3 upto 20: ?[i]:='(|:,ring i,:|); endfor
Ph:=Ph1:='(?6,(_dl,-2),(_dl,-4),(_dl,-6)); Ph2:='(?6,(_dl,-1),(_dl,-3),(_dl,-5));
!:=!1:='((_mk_bond,_arg_ang)); !!:='(!,(_mb,db)); !!!:='(!,(_mb,tm));  !0:='(<180,180);
for i=2  upto 20: ![i]:='(|:,(_get_len,0),! for j==2 upto i::,! endfor,:|); endfor
Me:='(); Et:=!; Pr:=!2; Bu:=!3;
for i=4,5,6:   for j=2 upto i-2: ?[i][j]:='((_fuse,i),(j,0)); endfor endfor
for i=5,6,7,8: for j=11 upto 15: ?[i][j]:='((_fuse,i),(j,0)); endfor endfor
%=================================================================================================
H :='("H");C:='("C");N:='("N");O:='("O");F:='("F");S:='("S");P:='("P");I:='("I");
Si:='("{Si}");Al:='("{Al}");Mg:='("{Mg}");Zn:='("{Zn}");As:='("{As}");Cu:='("{Cu}");
Ag:='("{Ag}");Au:='("{Au}");Sn:='("{Sn}");Cl:='("{Cl}");Br:='("{Br}");Li:='("{Li}");
Na:='("{Na}");Ca:='("{Ca}");Hg:='("{Hg}");Ni:='("{Ni}");Ti:='("{Ti}");U:='("U");
%-------------------------------------------------------------------------------------------------
R:='("R"); R1:='("{R^1^}"); R2:='("{R^2^}"); R3:='("{R^3^}"); R4:='("R^4^"); R5:='("{R^5^}");
JP_AT:='();
%-------------------------------------------------------------------------------------------------
plus:='("+"); minus:='("-"); HH:='("H{_2_}"); NH:='(N,*/*H); NnoH:='(); SO:='(S,//O);
SOO :='(S,//O^-35,//O^35); CHO:='("CHO"); OH:='("OH"); COOH:='("COOH"); CH2:='("C{H_2_}");
CH3:='("C{H_3_}"); CN:='("CN"); NH2:='("N{H_2_}"); NO2:='("N{O_2_}"); SH:='("SH");
SO3:='("S{O_3_}"); NMe:=N!:='(N,/Me); iPr:=Me!:='(/Me,60); tBu:='(/Me,/Me^60,60);
OMe:=O!:='(O,!); OEt:=O!2:='(O,!2); OPr:=O!3:='(O,!3); OiPr:=OMe!:='(O,!,iPr); 
SMe:=S!:='(S,!); SEt:=S!2:='(S,!2); SPr:=S!3:='(S,!3); SiPr:=SMe!:='(S,!,iPr);
COOMe:=COO!:='(//O,!,O,!); COMe:=CO!:='(//O,!); COEt:=CO!2:='(//O,!2);
OCOMe:=OCO!:='(O,!,//O,!); COOEt:=COO!2:='(//O,!,O,!2);
COOiPr:=COOMe!:='(//O,!,O,!,iPr); COOPr:=COO!3:='(//O,!,O,!3);
COOtBu:='(//O,!,O,!,tBu); NMeMe:=NMe!:='(N,/Me,!); NHCOMe:=NHCO!:='(NH,!,//O,!);
NHiPr:=NHMe!:='(NH,!,iPr); NHtBu:='(NH,!,tBu); NHH:='(N,/H,!,H);
NHMe:=NH!:='(NH,!); NHEt:=NH!2:='(NH,!2); !NH!:='(!,NH,!); !CO!:='(!,//O,!);
!OH:='(!,OH); !SH:='(!,SH); !NH2:='(!,NH2); !OMe:=!O!:='(!,OMe); !COOH:='(!,COOH);
!CH3:='(!,"C{H_3_}"); !CN:='(!,CN); !iPr:=!Me!:='(!,iPr); !tBu:='(!,tBu); !Ph:='(!,Ph);
!?3:='(!,?3); !?4:='(!,?4); !?5:='(!,?5); !?6:='(!,?6);
CF2:='(/F,60,F); CCl2:='(/Cl,60,Cl); CBr2:='(/Br,60,Br); CF3:='(/F,/F^60,60,F);
CCl3:='(/Cl,/Cl^60,60,Cl);CBr3:='(/Br,/Br^60,60,Br);O_H:='(O,!,H);CO_H:='(//O,!,H);
%==================================================================================================
CO_OH:='(//O,!,O,!,H); C_N:='(!~tm,N); N_HH:='(N,/H,60,H); N_OO:='(N,//O,60~dm,O);
S_H:='(S,!,H); N_H:='(N,/H); C_HHH:='(/H,/H^60,60,H);
%--------------------------------------------------------------------------------------------------
%%%%%%message "count of sub_usr =" & decimal(sub_usr);
%--------------------------------------------------------------------------------------------------
def expand_set=
  save CH,NH,NO,OH,CHO,COOH,CN,SH;
  CH3:=C_HHH; NH:=N_H; NH2:=N_HH; NO2:=N_OO; OH:=O_H; CHO:=CO_H; COOH:=CO_OH; CN:=C_N; SH:=S_H;
enddef;
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
def char_size_set(expr a)(expr b)(expr s)=
  for j=0 upto length(s)-1: nA:=ASCII(pic_c(j,s));
    tbl_char_wd[nA]:=a; tbl_char_ht[nA]:=b;
  endfor
enddef;
%---------------------------------------------------------------
char_size_set( 1)( 1)("CGHMNOQ");
char_size_set(.9)( 1)("ABDEFIJKLPRSTUVWXYZ-+/><m");
char_size_set(.7)( 1)(" ()[]0123456789nhj=_bdtfgpq");
char_size_set(.7)(.7)("*");
char_size_set(.5)( 1)("il");
char_size_set(.7)(.8)("acekosuvxzwry");
char_size_set(.4)( 1)(".,:;'`^");
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
def draw_char(expr c,POS,WD,PEN,NUM)=
save Z,aW,aH,fW,fH,hW,hW,hH,fP,hP,pathO,pathOh,ef,pos,ppcs,sbp,dw,dwh,dwv,cdw;
path pathO,pathOh;
pair Z[],pos;
%-------------------------------------------------------------------------------------------------
let ef=elseif;
def ppcs expr n= pickup pencircle scaled n enddef;
def sbp(expr m,n)expr p=subpath(m*length(p),n*length(p)) of p enddef;
def dw expr p  = draw (p) shifted pos Cp(colorA[NUM]) enddef;
def dwv expr p = draw (p) withpen penrazor scaled fP shifted pos Cp(colorA[NUM]) enddef;
def dwvs (expr n)expr p=
      draw (p) withpen penrazor scaled fP scaled n shifted pos Cp(colorA[NUM]) enddef;
def dwh expr p=draw (p) withpen penrazor rotated 90 scaled fP shifted pos Cp(colorA[NUM]) enddef;
def cdw expr p=cutdraw (p) shifted pos Cp(colorA[NUM]) enddef;
%-------------------------------------------------------------------------------------------------
fP:=PEN; hP:=0.5fP;
aW:=WD*tbl_char_wd[ASCII(c)]*(1-2ratio_atomgap_atom);
aH:=WD*tbl_char_ht[ASCII(c)]*(1-2ratio_atomgap_atom);
pos:=POS+(WD*ratio_atomgap_atom,WD*ratio_atomgap_atom);
fW:=aW-hP; hW:=.5aW; fH:=aH-hP; hH:=.5aH;
Z01:=( 0,hP); Z02:=(hP, 0); Z03:=(hP,hP); Z04:=(aW,hP); Z05:=(fW, 0); Z06:=(hW,aH); Z07:=(hW, 0);
Z08:=( 0,hH); Z09:=(hP,hH); Z10:=(fW,hH); Z11:=(hW,aW); Z12:=( 0,fH); Z13:=(hP,fH); Z14:=(hW,fH);
Z15:=(fW,aH); Z16:=(aW,fH); Z17:=(aW,hH); Z18:=(hP,aH); Z19:=(hW,hP); Z20:=(hW,hH); Z21:=(fW,hP);
pathO:=Z10..(.8aW,fH)..tension 1.5..(.2aW,fH)..Z09..(.2aW,hP)..tension 1.5..(.8aW,hP)..cycle;
pathOh:=(hP,.25aH)..Z19..(fW,.25aH)..Z20..cycle;
%-------------------------------------------------------------------------------------------------
ppcs fP;
if c="A": dwvs(1.14) Z02--Z06--Z05; dw .33[Z02,Z06]--.33[Z05,Z06];
ef c="B": dw Z13--Z14{right}..(.9fH,.75aH)..{left}Z20--Z09--Z20{right}..(.9fH,.25aH)..
          {left}Z19--Z03; dwv Z02--Z18;
ef c="C": cdw sbp(.05,.95)pathO;
ef c="D": dw Z13--Z14..Z10..Z19--Z03; dwv Z02--Z18;
ef c="E": pickup pensquare scaled fP; dw Z21--Z03--Z13--(fW,fH); dw Z09--Z10;
ef c="F": dwh Z12--Z16; dwh (0,.45aH)--(fW,.45aH); dw Z02--Z13;
ef c="G": cdw sbp(.06,.97)pathO; dwh bot Z20-- bot Z17;
ef c="H": dwv Z02--Z18; dw Z09--Z10; dwv Z05--Z15;
ef c="I": dwv Z19--Z14; dwh (hW-fP,hP)--(hW+fP,hP); dwh (hW-fP,fH)--(hW+fP,fH);
ef c="J": cdw Z09..(hP,.4aH){down}..{right}Z19{right}..{up}(fW,.4aH)..Z15;
ef c="K": cdw Z02--Z18; cdw .5[.45[Z02,Z18],Z16]--Z05; cdw .45[Z02,Z18]--Z16;
ef c="L": dwh Z04--Z01; dwv Z02--Z18;
ef c="M": dwv Z02--Z18; dwvs(1.14) Z18--Z19--Z15; dwv Z15--Z05;
ef c="N": dwv Z02--Z18; dwv Z05--Z15; dwvs(1.4) (1.4hP,aH)--(aW-1.4hP,0);
ef c="O": dw pathO;
ef c="P": dwv Z02--Z18; dw Z13--(.3aW,fH){right}..(fW,.7aH)..{left}(.3aW,.44aH)..(hP,.44aH);
ef c="Q": dw pathO; dw (.6aW,.4aH)--Z05;
ef c="R": dwv Z02--Z18; dw Z13--(.3aW,fH){right}..(fW,.7aH)..{left}(.3aW,.44aH)..(hP,.44aH);
          cdw Z05{up}..{left}(hW,.44aH);
ef c="S": cdw sbp(.05,.45)pathO; cdw sbp(.55,.95)pathO; dw (fW,.3aH){up}..{up}(hP,.7aH);
ef c="T": dwh Z12--Z16; dwv .5[Z12,Z16]--Z07;
ef c="U": cdw Z18..Z09{down}..{right}Z19{right}..{up}Z10..Z15;
ef c="V": dwvs(1.2) Z18--Z07--Z15;
ef c="W": dwvs(1.08) Z18--(.25aW,0)--Z06--(.75aW,0)--Z15;
ef c="X": dwvs(1.4) Z18..Z05; dwvs(1.4) Z02..Z15;
ef c="Y": dwvs(1.2) Z18--Z20--Z15; dwv Z20--Z07;
ef c="Z": dwh Z12--Z16; dwvs(1.4) (1.4hP,fP)--(aW-1.4hP,aH-fP); dwh Z01--Z04;
ef c="a": dw Z19..Z10..Z14..Z09..cycle; dwv Z05--Z15;
ef c="b": dw Z19..Z10..Z11..Z09..cycle; dwv Z02--(hP,1.2aH)
ef c="c": cdw sbp(.06,.94)Z10..Z14..Z09..Z19..cycle;
ef c="d": dw Z19..Z10..Z11..Z09..cycle; dwv Z05--(fW,1.2aH);
ef c="e": cdw sbp(0,.92)Z10..Z14..Z09..Z19..cycle; dw Z10--Z09;
ef c="f": cdw (hW,0)--(hW,.75aH){up}..(.75aW,fH)..{down}(fW,.8aH); dwh Z08--Z17;
ef c="g": dw Z19..Z10..Z11..Z09..cycle; cdw (Z15--Z21..(hW,0)..(.1aW,fP)) shifted (0,-.3aH);
ef c="h": dw Z02..(hP,.3aH){up}..(hW,.7fH)..{down}(fW,.3aH)..Z05; dwv (hP,.3aH)--Z18;
ef c="i": dwv Z07--(hW,.63aH); ppcs 1.4fP; dw Z14;
ef c="j": dwv Z19--(hW,.63aH); dw Z19..(.25aW,-hP)..Z01; ppcs 1.4fP; dw Z14;
ef c="k": dwv Z02--Z18; cdw .5[.45[Z02,Z18],Z16]--Z05; cdw .45[Z02,Z18]--Z16;
ef c="l": dwv Z07--Z06; dwh Z14--Z13; dwh Z19--Z21;
ef c="m": cdw Z02..(hP,.3aH){up}..(.28aW,.7fH)..{down}(hW,.3aH)..Z07;
          cdw (hW,.3aH){up}..(.7aW,.7aH-hP)..{down}(fW,.3aH)..Z05; dwv (hP,.3aH)--(hP,.7aH);
ef c="n": cdw Z02..(hP,.3aH){up}..(hW,.7fH)..{down}(fW,.3aH)..Z05; dwv (hP,.3aH)--(hP,.7aH);
ef c="o": dw Z19..Z10..Z14..Z09..cycle;
ef c="p": dw Z19..Z10..Z11..Z09..cycle; dwv (hP,.7aH)--(hP,-.3aH);
ef c="q": dw Z19..Z10..Z11..Z09..cycle; dwv (fW,.7aH)--(fW,-.3aH);
ef c="r": cdw (sbp(.35,.72)Z19..Z10..Z14..Z09..cycle) shifted(0,-fP); dwv Z02--Z18;
ef c="s": cdw sbp(.05,.45)pathO; cdw sbp(.55,.95)pathO; dw (fW,.3aH){up}..{up}(hP,.7aH);
ef c="t": dwv Z07--Z06; dwh (0,.66aH)--(aW,.66aH);
ef c="u": cdw Z18..(hP,.55aH){down}..Z19..(fW,.55aH){up}..Z15; dwv Z15--Z05;
ef c="v": dwv Z18--Z07--Z15;
ef c="w": dwv Z18--(.25aW,0)--Z06--(.75aW,0)--Z15;
ef c="x": dwvs(1.4) Z18--Z05; dwvs(1.4) Z15--Z02;
ef c="y": dwvs(1.4) (Z18--Z20) shifted (0,-.3aH); dwvs(1.4) (Z15--Z02) shifted (0,-.3aH);
ef c="z": dwh Z12--Z16; dwvs(1.4) (1.4hP,fP)--(aW-1.4hP,aH-fP); dwh Z01--Z04;
ef c="0": dw Z09...Z14...Z10...Z19...cycle;
ef c="1": dwv Z07--Z06--(hW-hP,fH)--(hW-hP,aH-2.5hP);
ef c="2": cdw sbp(0,.71)(hP,1.3hP)--(fW,.55aH)..Z14..(hP,.5aH)..(hW,.27aH); dwh Z04--Z01;
ef c="3": cdw sbp(0,.77)pathOh; cdw sbp(.23,.95)pathOh shifted (0,.5aH-hP); dwh (.3aW,hH)--Z20;
ef c="4": dwh (0,.3aH)--(aW,.3aH); dwv (.7aW,0)--(.7aW,aH)--(1.2hP,.3aH+hP);
ef c="5": dwh Z12--Z16; dwv Z13--(hP,.49aH);
          cdw (.5hP,.15aH)..(.65aW,1.3hP)..(fW,.3aH)..(hW,.6aH)..(.6hP,.53aH);
ef c="6": dw Z19..(fW,.5fW)..(hW,fW)..(hP,.5fW)..cycle; cdw (hP,.4aH)--Z06;
ef c="7": dwh (0,.fH)--Z16; dwvs(1.2) (aW-1.2hP,aH-fP)--(.4aW,0);
ef c="8": dw pathOh; dw (hP,.75aH)...Z14...(fW,.75aH)...Z20...cycle;
ef c="9": dw (Z19..(fW,.5fW)..(hW,fW)..(hP,.5fW)..cycle) shifted (0,.32aH); cdw (fW,.6aH)--Z07;
ef c=" ":
ef c=".": ppcs 1.4fP; dw Z19;
ef c=",": dw (hW+.5fP,hP)..(hW+.3fP,-fP)..(hW-.5fP,hP-2fP); ppcs 1.4fP; dw Z19;
ef c="'": dw (hW+.5fP,fH)..(hW+.3fP,fH-fP)..(hW-.5fP,fH-2fP); ppcs 1.4fP; dw Z14;
ef c="`": dw (hW-.5fP,fH-2fP)..(hW-.3fP,fH-fP)..(hW+.5fP,fH); ppcs 1.4fP; dw (hW,fH-2fP);
ef c=":": ppcs 1.4fP; dw (hW,.2aH); dw (hW,.8aH);
ef c=";": dw (hW+hP,.2aH)..(hW-hP,.2aH-2fP); ppcs 1.4fP; dw (hW,.2aH); dw (hW,.8aH);
ef c="(": dw Z19...Z09...Z14;
ef c=")": dw Z19...Z10...Z14;
ef c="[": dwv Z07--Z06; dwh Z14--(fW,fH); dwh Z19--Z21;
ef c="]": dwv Z07--Z06; dwh Z14--Z13; dwh Z03--Z19;
ef c="<": cdw Z01--Z17--Z12;
ef c=">": cdw Z16--Z08--Z04;
ef c="-": dwh Z09--Z10;
ef c="_": dwh Z03--Z21;
ef c="=": dwh (hP,.3aH)--(fW,.3aH); dwh (hP,.6aH)--(fW,.6aH);
ef c="/": dw (fW,fH)..Z01;
ef c="+": dwv Z19--Z14; dwh Z09--Z10;
ef c="*": dw Z19--Z14; dw Z09--Z10; dw (fW,fH)--Z01; dw Z13--Z21;
else:
fi
enddef;
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
def blank_str:= "            " enddef;
vardef fixed_r(expr n)(expr s)= (substring(0,n-length(s)) of blank_str)&s enddef;
vardef fixed_l(expr n)(expr s)= s&(substring(0,n-length(s)) of blank_str) enddef;
vardef fdr(expr n)(expr s)=fixed_r(n)(decimal(s)) enddef;
vardef fdl(expr n)(expr s)=fixed_l(n)(decimal(s)) enddef;
def warning(expr s)= message "% "&decimal(char_num)&fdr(3)(incr warning_cnt)&")"&s; enddef;
def bond_check(expr a)(text s)=
  nF:=0; for list=s: if list=bond_cnt: nF:=1; fi endfor
  if nF=0:
    warning("A"&decimal(a)&" ( "&fixed_l(8)(strD[numS[a]])&") has"&fdr(2)(bond_cnt)&" bonds");
  fi
enddef;
vardef stripP(expr a)=if length(a)=4: substring (1,3) of a else: a fi enddef;
%==================================================================================================
def STa(expr a,b,c)=
  tbl_atom_str[incr tbl_cnt]:=a; tbl_atom[tbl_cnt]:=0;
  tbl_atom_wt[tbl_cnt]:=b; tbl_atom_mi[tbl_cnt]:=c;
enddef;
%----------------------------------------------------------------------------------
def STb(expr a)(text s)=
  tbl_atom_str[incr tbl_cnt]:=a; tbl_atom[tbl_cnt]:=0;
  for list=s: tbl_atom[tbl_cnt]:=tbl_atom[tbl_cnt]+1;
    for j=1 upto tbl_cnt:
      if list=tbl_atom_str[j]: tbl_subst[tbl_cnt][tbl_atom[tbl_cnt]]:=j; fi
    endfor
  endfor
enddef;
%==================================================================================================
tbl_cnt:=0;
STa("C"   ,12.0107,   12.0000000);      STa("H"   , 1.00794,   1.00782503223);
STa("{Al}",26.9815,   26.98153853);     STa("{As}",74.9216,   74.92159457);
STa("B"   ,10.811,    11.00930536);     STa("{Br}",79.904,    78.9183376);
STa("{Ca}",40.078,    39.962590863);    STa("{Cl}",35.453,    34.968852);
STa("{Co}",58.933194, 58.93319429);     STa("{Cr}",51.9961,   51.94050623);
STa("{Cu}",63.546,    62.92959772);     STa("D"   ,2.012,      2.01410177812);
STa("F"   ,18.9984,   18.99840316273);  STa("{Fe}",55.845,    55.93493633);
STa("{Hg}",200.59,   201.97064340);     STa("I"   ,126.90447,126.9044719);
STa("K"   ,39.0983,   38.9637064864);   STa("{Li}",6.941,      7.0160034366);
STa("{Mg}",24.305,    23.985041697);    STa("{Mn}",54.938044, 54.93804391);
STa("N"   ,14.0067,   14.00307400443);  STa("{Na}",22.98977,  22.9897692820);
STa("{Ni}",58.693,    57.93534241);     STa("O"   ,15.9994,   15.99491461957);
STa("P"   ,30.973762, 30.97376199842);  STa("S"   ,32.065,    31.9720711744);
STa("{Se}",78.971,    79.9165218);      STa("{Si}",28.0855,   27.97692653465);
STa("{Sn}",118.71,   119.90220163);     STa("{Ti}",47.867,    47.94794198);
STa("{Zn}",65.409,    63.92914201);
%--------------------------------------------------------------------------------------------------
STb("{H_2_}")("H","H"); STb("OH")("O","H"); STb("O{Na}")("O","{Na}"); STb("CN")("C","N");
STb("SH")("S","H"); STb("CHO")("C","H","O");  STb("N{O_2_}")("N","O","O");
STb("N{H_2_}")("N","H","H"); STb("S{O_3_}")("S","O","O","O"); STb("COOH")("C","O","O","H");
STb("C{H_3_}")("C","H","H","H"); STb("C{F_3_}")("C","F","F","F");
%==================================================================================================
def proc_calc_out=
  begingroup
  save warning_cnt,MWp,knownA,bondC,tmp_wtp,bond_cnt,cnt_hide_H;
  numeric sumA[],bondC[],hideH[];
  string sumA,s_tag,s_var;
  inf_NO:=inf_EN:=inf_JN:=inf_FM:=inf_CAS:=inf_USE:=inf_EXA:=inf_EXB:=inf_MW:="";
  cal_MW:=cal_MW_str:=cal_FM:=""; cnt_hide_H:=warning_cnt:=MW_num:=MI_num:=MWp:=0;
  %------------------------------------------------------------------------------------------
  for j=1 upto inf_num:
    nA:=0; for i=0 upto length(info[j]): if pic_c(i,info[j])=":": nA:=i; fi exitif nA>0; endfor
    if nA>0:
      s_tag:=substring (0,nA) of info[j];
      s_var:=substring (nA+1,length(info[j])) of info[j];
      if known scantokens("inf_"&s_tag): scantokens("inf_"&s_tag):=s_var; fi
    fi
  endfor
  for i=1 upto tbl_cnt: sumA[i]:=0; endfor
  for i=1 upto cntA:
    knownA:=bond_cnt:=0;
    for j=1 upto cntB:
      if     (lineB[j]>=dl)and(lineB[j]<=dm): bondC[j]:=2;
      elseif lineB[j]=tm:                     bondC[j]:=3;
      elseif (lineB[j]=vf)or(lineB[j]=vb):    bondC[j]:=0;
      else:                                   bondC[j]:=1;
      fi
      if (sB[j]=i)or(eB[j]=i): bond_cnt:=bond_cnt+bondC[j]; fi
    endfor
    Bcnt[i]:=bond_cnt;
    if strD[numS[i]]="": strD[numS[i]]:="C"; fi
    if (strD[numS[i]]="C")and(bond_cnt<4):
      hideH[i]:=4-bond_cnt; cnt_hide_H:=cnt_hide_H+hideH[i]; else: hideH[i]:=0;
    fi
    if     strD[numS[i]]="C":       bond_check(i)(1,2,3,4);
    elseif strD[numS[i]]="N":       bond_check(i)(3,5);
    elseif strD[numS[i]]="H":       bond_check(i)(1);
    elseif strD[numS[i]]="O":       bond_check(i)(2);
    elseif strD[numS[i]]="S":       bond_check(i)(2,4,6);
    elseif strD[numS[i]]="P":       bond_check(i)(5);
    elseif strD[numS[i]]="OH":      bond_check(i)(1);
    elseif strD[numS[i]]="COOH":    bond_check(i)(1);
    elseif strD[numS[i]]="CN":      bond_check(i)(1);
    elseif strD[numS[i]]="N{H_2_}": bond_check(i)(1);
    elseif strD[numS[i]]="F":       bond_check(i)(1);
    elseif strD[numS[i]]="{Cl}":    bond_check(i)(1);
    elseif strD[numS[i]]="{Br}":    bond_check(i)(1);
    fi
    for j=1 upto tbl_cnt:
      if strD[numS[i]]=tbl_atom_str[j]:
        if tbl_atom[j]=0: sumA[j]:=sumA[j]+1;
        else: for k=1 upto tbl_atom[j]: sumA[tbl_subst[j][k]]:=sumA[tbl_subst[j][k]]+1; endfor fi
        knownA:=1; fi  endfor
    if knownA=0: warning(" Unknown Str("&strD[numS[i]]&") is used "&decimal(i)); fi
  endfor
  sumA[2]:=sumA[2]+cnt_hide_H;
  for i=1 upto tbl_cnt:
    if sumA[i]>=1:
      nA:=tbl_atom_wt[i]/100*sumA[i]; MWp:=MWp+nA;
      if (MWp<40)and(nA<40): MW_num:= MW_num+tbl_atom_wt[i]*sumA[i];
                             MI_num:= MI_num+tbl_atom_mi[i]*sumA[i]; fi
      cal_FM:=cal_FM&stripP(tbl_atom_str[i]) if sumA[i]>=2: &decimal(sumA[i]) fi;
    fi
  endfor
  cal_MI:=substring (0,10) of decimal(MI_num);
  cal_MW:=substring (0,8)  of decimal(MW_num);
  if sw_auxout=1:    proc_auxfile_out;   fi
  if sw_report=1:    proc_report_out; fi
  if sw_MOLout=1:    proc_MOLfile_out;    fi
  endgroup
enddef;
%==================================================================================================
def auxtag_out=
  for i=1 upto aux_max: exitif tag[i]=""; if i=1: printf tag[1] else: &aux_delimiter&tag[i] fi
  endfor
enddef;
%==================================================================================================
def proc_auxfile_out=
  message "["&decimal(char_num)&"]:"&inf_EN;
  for i=1 upto aux_max:  exitif tag[i]="";
    if i=1: printf "" else: &aux_delimiter fi if sw_auxfix=0: &tag[i]&":" fi &
    if     string  scantokens(var[i]): scantokens(var[i])
    elseif numeric scantokens(var[i]): decimal(scantokens(var[i])) fi
  endfor
  if sw_auxfix=0: for i=1 upto inf_num: &aux_delimiter&info[i] endfor; fi
enddef;
%==================================================================================================
vardef round_auto(expr n)=
  if     (n<4)  and(n>-4):   round(n*1000)/1000  elseif (n<40) and(n>-40): round(n*100)/100
  elseif (n<400)and(n>-400): round(n*10)/10      else: round(n) fi
enddef;
%--------------------------------------------------------------------------------------------------
def proc_report_out=
  message "------------------------------------------------------------------";
  message " Molecular name = "& inf_EN;
  message " Warnings = "&fdr(3)(warning_cnt)&" / Expanded command = "&decimal(cntD[0]);
  message " Width * Height = " & fdr(10)(mol_wd)&" * "&fdr(10)(mol_ht);
  message " Shift width * height  = "& fdr(10)(minX)&" * "&fdr(10)(minY);
  message " Bond length = "&fdr(3)(bond_len)&"   Atom size   = "&fdr(3)(atom_wd);
  message " Atom count="&fdr(3)(cntA)&" Bond count="&fdr(3)(cntB)&
          " Ring count="&fdr(3)(cntB-cntA+1)&" Hide H count="&fdr(3)(cnt_hide_H);
  message "------------------------------------------------------------------";
  message "< NO. >(  x axis   ,   y axis   )< atom  >< bond >< hide_H >";
  for i=1 upto cntA:
    message " A"&fdl(4)(i)&" ("&fdr(10)(round_auto(xpart(posA[i])/bond_len))&" , "&
            fdr(10)(round_auto(ypart(posA[i])/bond_len))&" )  "&fixed_l(8)(strD[numS[i]])&
            "  "&fdr(3)(Bcnt[i]) if hideH[i]>0: &fdr(8)(hideH[i]) fi;
  endfor
  message "------------------------------------------------------------------";
  message "< NO. ><  bond   (sdt)><angle + (  +-  )><length (   pt   )>";
  for i=1 upto cntB:
    nC:=lenB[i]; if nC=_size_a: nC:=ratio_atom_bond; elseif nC<0: nC:=-nC; fi
    if lineB[i]<>0:
      nB:=angB[i]; if nB>180: nB:=nB-360; fi
      message " B"&fdl(4)(i)&fdr(3)(sB[i])&" -> "&fdr(3)(eB[i])&
              " ("&fdr(3)(bondC[i]-si+1)&")"&fdr(9)(round_auto(angB[i]))&
              " ("&fdr(6)(round_auto(nB))&")"&fdr(8)(nC)&" ("&fdr(8)(round_auto(nC*bond_len))&")";
    fi
  endfor
  message "------------------------------------------------------------------";
  message "<atom>( atom wt )[ mi wt   ]  < cnt > < sum wt   >[ sum mi wt  ]";
  if MWp<=40: cal_MW_str:=cal_MW; cal_MI_str:=cal_MI; 
  else:       cal_MW_str:=fdr(10)(MWp)&" * 100"; cal_MI_str:=fdr(10)(MIp)&" * 100";
  fi
  for i=1 upto tbl_cnt:
    if sumA[i]>=1:
       nA:=tbl_atom_wt[i]/100*sumA[i]; nB:=tbl_atom_mi[i]/100*sumA[i];
       message " "&
         fixed_l(5)(stripP(tbl_atom_str[i]))&
         "("&fdr(9)(tbl_atom_wt[i])&")"&"["&fdr(9)(tbl_atom_mi[i])&"]"&
         " * "&fdr(4)(sumA[i])&" = "
       if nA<40: &fdr(12)(tbl_atom_wt[i]*sumA[i])&"["&fdr(12)(tbl_atom_mi[i]*sumA[i])&"]";
       else:     &fdr(12)(nA)&" * 100"&"["&fdr(12)(nA)&" * 100"&"]";
       fi
     fi
  endfor
  message " Molecular Weight  [Mono Isotopic]  = "&
    fixed_r(12)(cal_MW_str)&"["&fixed_r(12)(cal_MI_str)&"]";
  message "------------------------------------------------------------------";
  message " Weight  Calc: " &cal_MW_str &" / Input: "
    if inf_MW<>"": &inf_MW &" / weight gap= " &decimal(MW_num-scantokens(inf_MW)) fi;
  message " Fomula  Calc: "&cal_FM&" / Input: "
    if inf_FM<>"": &inf_FM&" / "&  if inf_FM=cal_FM: "MACTCH" else: "NOT MACTCH" fi fi;
  message "==================================================================";
enddef;
%==================================================================================================
def proc_MOLfile_out=
  mp_log_name:=jobname&"-"&fit_zero(char_num)&decimal(char_num)&"-"&inf_EN&".mol";
  printf ""; printf "  -MCFtoMOL- "&fixed_l(20)(info[1]); printf "";
  printf fdr(3)(cntA)&fdr(3)(cntB)&"  0  0  0  0  0  0  0  0999 V2000";
  for i=1 upto cntA: printf fdr(10)(xpart(posA[i])/bond_len)& fdr(10)(ypart(posA[i])/bond_len)&
           fdr(10)(0)&" "&fixed_l(2)(stripP(strD[numS[i]]))&"  0  0  0  0"; endfor
  for i=1 upto cntB: if lineB[i]<>0:
    if     (lineB[i]=dl)or(lineB[i]=dr)or(lineB[i]=dm): nA:=2;
    elseif lineB[i]=tm: nA:=3;
    elseif (lineB[i]=wf)or(lineB[i]=zb)or(lineB[i]=bd): nB:=1;
    elseif (lineB[i]=zf)or(lineB[i]=wb)or(lineB[i]=dt): nB:=6;
    elseif lineB[i]=wv: nB:=4;  else: nA:=1; nB:=0; fi
    printf fdr(3)(sB[i])&fdr(3)(eB[i])&fdr(3)(nA)&fdr(3)(nB)&"     0  0"; fi endfor
  printf "M  END";
enddef;
%-------------------------------------------------------------------------------------------------
vardef fit_zero(expr n)=if n<=9: "00" elseif n<=99: "0" fi enddef;
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%