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

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% mcf2graph ver 3.85     Copyright (c) 2013-2016   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 first font only (for test)  : mpost -s ahlength=1 FILENAME
% Set output checklist            : mpost -s ahlength=2 FILENAME
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
tracingstats:=1;
message " This is mcf2graph ver 3.8  2016.3";
%-------------------------------------------------------------------------------------------------
pair    posB[],posA[],pairT,Ls,Le,pairA;
numeric angB[],angA[],br_ang[],sB[],eB[],f_FON[],atom_w[],atom_h[],atom_d[],strA[],stkB[],stkA[],
        stkL[],stkM[],strW[],lineB[],lenB[],ps_com[],ps_adr[],op_com[][],op_par[][],op_cnt[],
        comMC[][],parMC[][],stock_p[],cntMC[],colorA[],colorB[],tblN[],tblB[][],wtA[],sumA[],
        CH[],NH[],NO[],SO[],CCl[],CF[],CBr[],?[],![],Ph[];
path    pA,pB,pC,pT;
string  info[],tblA[],com_str[],var[],tag[],
        calc_formula,mp_log_name,mol_name,mol_formula,calc_weight_str,info_str;
picture atom_font[],chem_structure,temp_picture;
%-------------------------------------------------------------------------------------------------
sw_numberA:=sw_numberB:=sw_mol_frame:=sw_auxout:=sw_solid:=sw_expand:=sw_start_vector:=0;
char_num:=str_cnt:=proc_end:=sw_font_frame:=sw_atom_frame:=sw_checklist:=sw_MOLout:=0;
sw_subst_off:=sw_bond_single:=0;
numberA_start:=numberB_start:=1; numberA_end:=numberB_end:=4095;
info_str:="\INFO"; aux_max:=20;
var1:="jobname";  tag1:="F"; 
var2:="char_num"; tag2:="C";
for i=3 upto aux_max: var[i]:=tag[i]:=""; endfor
%-------------------------------------------------------------------------------------------------
if known green:  f_MP:=1;
  mp_log_name:=jobname&"-info.aux";
  if     ahlength=1: proc_end:=1;  fi                          % first molecular only
  if     ahlength=2: sw_checklist:=1; def shipit = enddef; fi  % checklist on
  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(text s)= beginfig(char_num) enddef; def endchar = endfig enddef;
  vardef mp_filename = jobname&"-"&fit_zero(char_num)&decimal(char_num)&"."&outputformat enddef;
  def printf expr s= write s to mp_log_name enddef;
  ahangle:=45; ahlength:=4; def # = enddef; color color_list[];
  def Cp(expr s) = if known s: if s<>0: withcolor color_list[s] fi fi enddef;
  def define_pixels(text s) = enddef;
else: f_MP:=0;
  def Cp(expr s) = enddef; def color = transform enddef;
  mode_setup; def printf expr s= message s enddef; def mp_filename= "" enddef; fi
clearit;  chem_structure:=currentpicture;
%-------------------------------------------------------------------------------------------------
let DIV= /; let MUL= *; let LT= <; let GT= >; let AND= &; let :: = : ; let == = =;
primarydef a SUB b = a-b enddef;
?3:=?20:=Ph:=Ph1:=Ph2:=hz:=0; vt:=1;
first_def_number:=500; user_def_number:=2500; ab_def_number:=3000;
margin_left_right:=margin_top_bottom:=0.4mm;  ratio_chain_ring:= 0.66;   ratio_atom_bond:=0.36;
ratio_thickness_bond:=0.015;  offset_atom#:=0.8pt#;      max_bond_width:=0.25;
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:=.050;
offset_thickness#:=0.2pt#;    offset_bond_gap#:=0.3pt#;  offset_zebra_gap#:=0.1pt#;
offset_wedge#:=0.4pt#;
par_s=ASCII("{"); par_e=ASCII("}"); score_u=ASCII("_"); hat=ASCII("^");
max_info_num:=12; for i:=1 upto max_info_num: info[i]:=":"; endfor
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,_N,_O,_S,_H,_tmp_line,_chg_len,_get_len,_ring_len,_tmp_len,_rot_ang,_set_ang,_adj_ang,_chg_env,
 _tmp_env,_set_colorA,_set_colorB,_postA,_postB,_postC,_postD,_postE,_postF,_set_psA,_stack_reset,
 _set_clr,_set_adr,_mk_bond,_set_atom,_arg_ang,_chg_atom,_tmp_rot,_fuse,_push,_pop,_size_a);
def_com(1)(si,dl,dr,dm,tm,wf,wb,bd,zf,zb,ov,dt,no,ar,vf,vb,wv,nl);
%-------------------------------------------------------------------------------------------------
def parameter_list=
  sw_checklist,sw_numberA,sw_numberB,sw_mol_frame,sw_auxout,sw_solid,sw_expand,sw_MOLout,
  sw_start_vector,sw_atom_frame,sw_font_frame,sw_subst_off,sw_bond_single,
  margin_left_right,margin_top_bottom,ratio_atom_bond,ratio_thickness_bond,ratio_char_bond,
  ratio_chain_ring,offset_atom,offset_atom#,max_bond_width,ratio_bondgap_bond,ratio_zebra_black,
  ratio_zebragap_bond,ratio_wedge_bond,ratio_atomgap_atom,offset_wedge,offset_wedge#,
  offset_zebra_gap,offset_zebra_gap#,offset_bond_gap,offset_bond_gap#,
  offset_thickness,offset_thickness#,numberA_start,numberA_end,numberB_start,numberB_end
enddef;
%-------------------------------------------------------------------------------------------------
nA:=0; for list=parameter_list: stock_p[incr nA]:=list; endfor
def store_par(text t)=
  nA:=0; for list=t: if stock_p[incr nA]<>list: stock_p[nA]:=list; fi endfor enddef;
def restore_par(text t)=  nA:=0;
  forsuffixes list=t: if list<>stock_p[incr nA]: list:=stock_p[nA]; fi endfor
enddef;
%-------------------------------------------------------------------------------------------------
def beginfont(text s)=
  mol_name:=mol_formula:=""; len_x:=len_y:=cntA:=info_num:=mol_weight:=f_beginchar:=0;
  store_par(parameter_list); stock_wd#:=font_wd#; stock_ht#:=font_ht#;
  ratio_bond_width:=1/30;
  for list=s: info_num:=info_num+1; info[info_num]:=list;
    if substring (0,2) of list="EN": mol_name:=substring (3,length(list)) of list; fi
    if substring (0,2) of list="FM": mol_formula:=substring (3,length(list)) of list; fi
    if substring (0,2) of list="MW": mol_weight:=scantokens(substring (3,length(list)) of list); fi
  endfor
enddef;
%-------------------------------------------------------------------------------------------------
def endfont=
  if sw_font_frame=1: AUX(0,0)(draw_frame(font_wd,font_ht,(0,0),0.2pt);) fi
  if (sw_auxout=1)or(sw_checklist=1)or(sw_MOLout=1): mol_check; fi
  if sw_auxout=1:    auxfile_out; fi
  if sw_checklist=1: checklist_out; fi
  if sw_MOLout=1:   MOLfileout; fi
  if f_beginchar=1:
     char_num:=char_num+1; currentpicture:=chem_structure; chem_structure:=nullpicture;
     endchar; fi
  restore_par(parameter_list); font_wd#:=stock_wd#; font_ht#:=stock_ht#;
  if proc_end=1: scantokens("bye"); fi
enddef;
%-------------------------------------------------------------------------------------------------
def size_setup=
  BL#        := font_wd#*ratio_bond_width;
  wedge_wd#  := ratio_wedge_bond*BL#+offset_wedge#;
  zebra_gap# := ratio_zebragap_bond*BL#+offset_zebra_gap#;
  AL#        := ratio_atom_bond*BL#+offset_atom#;
  gap#       := ratio_bondgap_bond*BL#+offset_bond_gap#;
  bond_pen_wd#   := ratio_thickness_bond*BL#+offset_thickness#;
  char_pen_wd#   := ratio_char_bond*bond_pen_wd#;
  define_pixels(BL,zebra_gap,wedge_wd,AL,gap,bond_pen_wd,char_pen_wd,font_wd,font_ht);
  font_size_setup;
enddef;
%-------------------------------------------------------------------------------------------------
def scaling=  min_x:=min_y:= 4095.999; max_x:=max_y:=-4095.999;
for i=1 upto cntA: xpos:=xpart(posA[i]); ypos:=ypart(posA[i]);
  if strA[i]<>0: str_len:=nC:=num_d:=0;
    for j=0 upto length(com_str[strA[i]])-1: nA:=ASCII(pic_c(j,com_str[strA[i]]));
      if (nA=score_u)or(nA=hat)or(nA=par_s)or(nA=par_e):
        if (nA=hat)and(nC<.5AL): nC:=.5AL; fi;
        if (nA=score_u)and(num_d<.5AL): num_d:=.5AL; fi;
      else: str_len:=str_len+atom_w[nA]; fi  
    endfor
    str_ang:=(br_ang[i] mod 360); num_f:=str_len;
    if     (str_ang<=91)or(str_ang>=269): num_f:=0; else: str_len:=0; fi
    if     (xpos-num_f+.5AL)<min_x: min_x:=xpos-num_f+.5AL;
    elseif (xpos+str_len-.5AL)>max_x: max_x:=xpos+str_len-.5AL; fi
    if     (ypos-num_d-.5AL)<min_y: min_y:=ypos-num_d-.5AL;
    elseif (ypos+nC+.5AL)>max_y: max_y:=ypos+nC+.5AL; fi
    else: if xpos<min_x: min_x:=xpos; elseif xpos>max_x: max_x:=xpos; fi
          if ypos<min_y: min_y:=ypos; elseif ypos>max_y: max_y:=ypos; fi fi
 endfor
 len_x:=max_x-min_x; len_y:=max_y-min_y;
enddef;
%-------------------------------------------------------------------------------------------------
def resize(expr WD,HT)=
  if (len_y/len_x)>(font_ht/font_wd): factor:=(font_ht*HT-2margin_top_bottom)/len_y;
  else:                               factor:=(font_wd*WD-2margin_left_right)/len_x; fi
  ratio_bond_width:=ratio_bond_width*factor; len_x:=len_x*factor; len_y:=len_y*factor;
enddef;
%-------------------------------------------------------------------------------------------------
for i=1 upto 128: f_FON[i]:=0; endfor  asc0:=ASCII("0"); asc9:=ASCII("9");
def font_use_check=
  for i=1 upto 128: if f_FON[i]<>0: f_FON[i]:=0; fi endfor
    if (sw_numberA>=1)or(sw_numberB>=1): for j=asc0 upto asc9: f_FON[j]:=1; endfor
    else: for i=1 upto cntA: if strA[i]<>0: for j=0 upto length(com_str[strA[i]])-1:
           f_FON[ASCII(pic_c(j,com_str[strA[i]]))]:=1; endfor fi endfor fi
enddef;
%-------------------------------------------------------------------------------------------------
def set_def_MC=
  save /,*,//,/*,*/,**,~,~~,^,^^,`,'`,{,},<,>,>>,:>,&,&#,:,=,\,\\,*\,\*,@,$,#,|,||,
       d,w,z,inside_def_MC;
  inside_def_MC:=1; d:=dl; w:=wf; z:=zf;
  vardef $(text a)tertiary b == $$(a)(b) enddef; tertiarydef a=b == $$(a)(b) enddef; 
  vardef @(text a)tertiary b == @@(a)(b) enddef; tertiarydef a:b == @@(a)(b) enddef;
  vardef #primary a == if numeric a:: a-4095 elseif pair a:: a+(0,-4095) fi 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 * == (0,1) enddef;  def \ == *,0 enddef;  def \\ == *,0~dm enddef;
  def *\ == *,0~wf enddef;  def \* == *,0~zf enddef;
  def {  == (_push,1) enddef; def }  == (_pop,1)  enddef;
  def {{ == (_push,0) enddef; def }} == (_pop,0)  enddef;
  def | == {,} enddef; def || == (_stack_reset,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;
%-------------------------------------------------------------------------------------------------
def PM(expr a,b,c)= comMC[a][incr cntMC[a]]:=b; parMC[a][cntMC[a]]:=c; enddef;
vardef '(text s)= ''(incr mc_num)(s); mc_num enddef;
def ''(expr k)(text s)= begingroup
  if unknown inside_def_MC:: set_def_MC fi  cntMC[k]:=0;
  for list==s::
    if known list::
      if pair list:: PM(k,xpart(list),ypart(list))
      elseif numeric list::
        if list>=first_def_number::
          for i==1 upto cntMC[list]:: PM(k,comMC[list][i],parMC[list][i]) endfor 
        else:: PM(k,_mk_bond,list) fi
      elseif string list:: com_str[incr str_cnt]:=list;  PM(k,_set_atom,str_cnt)
        if pic_c(0,list)=="{":: strW[str_cnt]:=1.7; else:: strW[str_cnt]:=1; fi fi fi
  endfor
  endgroup
enddef;
%-------------------------------------------------------------------------------------------------
def !?(expr a)(expr b) =
  PB(_jp_bond,a) PB(_get_len,a) PB(_push,0)
  PB(_chg_len,_ring_len) for i==1 upto b-2:: PB(_mk_bond,360 DIV b) endfor  PB(_pop,0)
  if a>=1:: PB(_cyc_eB,0) elseif a>=-999:: PB(_cyc_eB,a-b+2) else:: PB(_cyc_eB,a) fi
enddef;
%-------------------------------------------------------------------------------------------------
def !!?(expr a)(expr b)(expr c) =
  PB(_jp_bond,xpart(a)) PB(_push,0)
  if     b==6:: PB(_chg_len,0) for i==1 upto c-1:: PB(_mk_bond,60) endfor
  elseif b==5:: if     c==2:: PB(_chg_len,1.25) PB(_mk_bond,80)
                elseif c==3:: PB(_chg_len,1.1)  PB(_mk_bond,78) PB(_mk_bond,72) fi
  elseif b==4:: PB(_chg_len,1.225) PB(_mk_bond,105) fi
  PB(_pop,0) if ypart(a)<=0:: PB(_cyc_eB,ypart(a)-c+1) else:: PB(_cyc_eB,ypart(a)) fi
enddef;
%-------------------------------------------------------------------------------------------------
def PB(expr a,b)= cntBS:=cntBS+1; comMC[ab_num][cntBS]:=a; parMC[ab_num][cntBS]:=b; enddef;
def $$(text t)(expr e) =
   begingroup  save cntBS; cntBS:=0; ab_num:=ab_num+1;
  if known e:: if numeric e::
    if (e>=si)and(e<=nl):: if     e==dl:: for list==t:: PB(_dl,list) endfor
                           else:: for list==t:: PB(_set_adr,list) PB(_set_line,e) endfor fi
    elseif (e>=?3)and(e<=?20):: for list==t:: !?(list)(e-?3+3) endfor
    elseif e==Ph1:: !?(t)(6) PB(_dl,-2) PB(_dl,-4)
    elseif e==Ph2:: !?(t)(6) PB(_dl,-1) PB(_dl,-3) PB(_dl,-5)
    elseif comMC[e][1]==_fuse:: for list==t:: !!?(list)(parMC[e][1])(comMC[e][2]) endfor  fi
  elseif color e:: color_list[incr cntC]:=e;
    for list==t:: PB(_set_adr,list) PB(_set_colorB,cntC) endfor fi fi
  cntMC[ab_num]:=cntBS;
  ab_num    %--- Retern value -------
  endgroup
enddef;
%-------------------------------------------------------------------------------------------------
def PA(expr a,b)= cntAS:=cntAS+1; comMC[ab_num][cntAS]:=a; parMC[ab_num][cntAS]:=b; enddef;
def PAs(text t)= for list==t:: PA(xpart(list),ypart(list)) endfor enddef;
def @@(text t)(expr s)=
  begingroup  save cntAS,xs,ys; cntAS:=0; ab_num:=ab_num+1;
    if known s:: if numeric s::
      if (s>=H)and(s<=U)::
         for list==t::
            if     s==N:: PA(_N,list) elseif s==O:: PA(_O,list) elseif s==S:: PA(_S,list)
            else::        PA(_set_adr,list) PA(_chg_atom,s) fi
         endfor
      elseif s==NH::
        for list==t::
          if  numeric list:: PAs((_N,list),~~no,'`_size_a,(_H,list))
          elseif pair list:: PAs(list) fi
        endfor
      elseif s==SOO::
        for list==t::
          PAs((_S,list),(_set_adr,list),^^35,~~dm,(_set_psA,O),^^-35,~~dm,(_set_psA,O))
        endfor
      elseif s==SO::
        for list==t::
          if  numeric list:: PAs((_S,list),(_set_adr,list),~~dm,(_set_psA,O))
          elseif pair list:: PAs(list) fi
        endfor
      fi
    elseif pair s::  xs:=xpart(s); ys:=ypart(s); PA(_set_clr,1)
      for list==t::
        if numeric list::
          if     xs==_postA::            elseif xs==_postB:: PAs(~~dm)
          elseif xs==_postC:: PAs(~~wf)  elseif xs==_postD:: PAs(~~zf)
          elseif xs==_postE:: PAs(~~nl)  elseif xs==_postF:: PAs(~~no) fi
          PA(_set_adr,list)  PA(_set_psA,ys)
        elseif pair list:: PAs(list) fi
      endfor
      PA(_set_clr,0)
      elseif color s:: color_list[incr cntC]:=s;
        for list==t:: PA(_set_adr,list) PA(_set_colorA,cntC) endfor fi fi
    cntMC[ab_num]:=cntAS;
    ab_num  %--- Retern value -------
  endgroup
enddef;
%-------------------------------------------------------------------------------------------------
def PP(expr a,b)= op_com[cntP][incr op_cnt[cntP]]:=a; op_par[cntP][op_cnt[cntP]]:=b; enddef;
def ps_put(expr n,p)=
  ps_adr[incr cntP]:=n; ps_com[cntP]:=p; op_cnt[cntP]:=0;
  if lineT<>0:  PP(_tmp_line,lineT) fi   if rotT<>0:   PP(_rot_ang,rotT) fi
  if lenT<>crR: PP(_chg_len,lenT) fi     if envT<>hz:  PP(_chg_env,envT) fi
  if lineT=nl:  PP(_tmp_len,0) elseif lineT=no: PP(_adj_ang,0) fi PP(_mk_bond,0)
  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 PG(expr a,b)= comMC[0][incr cntMC[0]]:=a; parMC[0][cntMC[0]]:=b; enddef;
def ps_get(expr n)=
  cntC:=cntMC[0]; cntPS:=cntP;
  for i=n upto cntP:
    PG(_jp_atom_abs,ps_adr[i]) PG(_push,1)
    for j=1 upto op_cnt[i]: PG(op_com[i][j],op_par[i][j]) endfor
    for j=1 upto cntMC[ps_com[i]]: PG(comMC[ps_com[i]][j],parMC[ps_com[i]][j]) endfor 
    PG(_pop,1) PG(_term,0)
  endfor
  proc_bond_atom(cntC+1); if cntP>cntPS: ps_get(cntPS+1); fi
enddef;
%-------------------------------------------------------------------------------------------------
def AUX(expr a,b)(text s)=s addto chem_structure also currentpicture shifted(a,b); clearit; enddef;
def MCf(text s)= MCd(1,1)(.5,.5)(s); enddef;  % MC fill draw
%-------------------------------------------------------------------------------------------------
def MCd(expr RW,RH)(expr FW,FH)(text s)=
  if f_beginchar=0: beginchar(char_num,font_wd#,font_ht#,0); clearit; f_beginchar:=1; fi
  mc_num:=user_def_number; ab_num:=ab_def_number; crR:=-ratio_chain_ring;
  adrA:=adrB:=cntA:=cntB:=adrS:=cntPS:=angA[0]:=angB[0]:=br_ang[0]:=sB[0]:=cntC:=cntP:=0;
  stkA[0]:=stkB[0]:=stkL[0]:=stkM[0]:=strAT:=f_lineT:=f_lenT:=f_envT:=f_rotT:=0;
  eB[0]:=1; com_str[0]:=""; lineT:=si; str_cnt:=2000; posA[0]:=posB[0]:=posB[1]:=(0,0);
  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
  ''(0)(s,(_term,0));  proc_bond_atom(1); cntA_skeleton:=cntA; cntB_skeleton:=cntB;
  if cntP>0: ps_get(1); fi
  font_use_check;
  if sw_solid=1: size_setup; proc_skeleton; scaling;
  else: size_setup; proc_skeleton; scaling; resize(RW,RH); size_setup;
        if ratio_bond_width>max_bond_width:
          ratio_bond_width:=max_bond_width; size_setup; proc_skeleton; scaling;
        else: for i=1 upto 4: proc_skeleton; scaling; resize(RW,RH); size_setup; endfor fi fi
  font_setup;
  if sw_subst_off=1: cntA:=cntA_skeleton; cntB:=cntB_skeleton; fi
  for i=1 upto cntB: draw_bond(i,sB[i],eB[i],angB[i],lineB[i]); 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
       draw_atom(i,posA[i],0,decimal(nA),1);
    elseif sw_numberB>=1:
    else:  draw_atom(i,posA[i],br_ang[i],com_str[strA[i]],strW[strA[i]]);
    fi
  endfor
  sft_X:=-min_x+(font_wd-len_x)*FW; sft_Y:=-min_y+(font_ht-len_y)*FH;
  if sw_mol_frame=1:    AUX(sft_X,sft_Y)(draw_frame(len_x,len_y,(min_x,min_y),0.2pt);) fi
  if sw_start_vector=1: AUX(sft_X,sft_Y)(start_vector) fi
  addto chem_structure also currentpicture shifted (sft_X,sft_Y);
  clearit;
enddef;
%------------------------------------------------------------------------------------------------
def draw_frame(expr LX,LY,PS,PN)= draw unitsquare xscaled LX yscaled LY shifted PS wpcs PN;
enddef;
def start_vector= draw (posA[1] shifted (-1mm,0))--(posA[1] shifted (-4mm,0))
                   withpen penrazor rotated 90 scaled .8mm;
  fill (posA[1] shifted (-2mm,-1mm))--posA[1]--(posA[1] shifted (-2mm,1mm))--cycle;
enddef;
%------------------------------------------------------------------------------------------------
def proc_bond_atom(expr n)= 
  f_bra:=f_end:=f_term:=rotT:=adrS:=f_lineT:=f_rotT:=f_lenT:=f_envT:=envT:=env:=0;
  stkL[0]:=bondL:=crR; lenT:=crR; for i=1 upto 5: stkA[i]:=stkB[i]:=0; endfor
  for i=n upto cntMC[0]:  com:= comMC[0][i]; par:=parMC[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=_set_psA:    ps_put(getA(adrT),par);
  elseif (com>=_postA)and(com<=_postF):
    if     com=_postA: elseif com=_postB: lineT:=dm; elseif com=_postC: lineT:=wf;
    elseif com=_postD: lineT:=zf; elseif com=_postE: lineT:=nl;
    elseif com=_postF: lineT:=no; lenT:=_size_a; fi  ps_put(cntA+1,par);
  elseif com=_jp_bond:     tempB:=getB(par); sB[cntB+1]:=sB[tempB]; f_bra:=1;
  elseif com=0or_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:   strA[getA(adrT)]:=parMC[par][1];
  elseif com=_N:          strA[getA(par)]:=parMC[N][1];
  elseif com=_O:          strA[getA(par)]:=parMC[O][1];
  elseif com=_S:          strA[getA(par)]:=parMC[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=_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: env:=par;
  elseif com=_tmp_env: envT:=par;
  elseif com=_set_clr:
     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 fi
     if 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; strA[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=
  envT:=env:=f_lineT:=f_rotT:=f_lenT:=f_envT:=0;  for i=1 upto 5: stkA[i]:=stkB[i]:=0; endfor
  adrA:=adrB:=cntA:=cntB:=angT:=adrS:=f_end:=f_bra:=rotT:=f_term:=0; 
  for i=1 upto cntMC[0]: com:=comMC[0][i]; par:=parMC[0][i];
  if com=_push: if par=1: stkM[adrS]:=env; 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]; env:=stkM[adrS];
                       elseif par=0: temp_len:=bondL; fi
  elseif com=_jp_bond:     tempB:=getB(par); posB[cntB+1]:=posA[sB[tempB]];
                           angT:=angB[tempB]-180; f_bra:=1; rotT:=0;
  elseif com=0or_jp_atom:  termB; adrT:=getA(par); posB[cntB+1]:=posA[adrT];
                           angT:=br_ang[adrT]; f_bra:=1; rotT:=0;
  elseif com=_jp_atom_abs: adrT:=par; posB[cntB+1]:=posA[adrT];
                           angT:=br_ang[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<=_postF): rotT:=0;
  elseif com=_chg_env: env:=par;
  elseif com=_tmp_env: envT:=par;
  elseif com=_set_clr: f_clr:=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;
%-------------------------------------------------------------------------------------------------
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: strA[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: br_ang[incr cntA]:=angT; else: f_bra:=0; fi f_term:=1; fi enddef;
def proc_cyc(expr n)= add_bond(angle(posA[n]-posB[cntB+1])-angT);  enddef;
def glu_c(expr n)=  if strA[n]<>0: nB:=angT mod 180; nC:=.5strW[strA[n]]*AL;
                    if (nB<45)or(nB>135):glu:=glu+((sind(nB)*nC)++nC);
                    else                :glu:=glu+((cosd(nB)*.5AL)++.5AL) fi fi
enddef;
%-------------------------------------------------------------------------------------------------
def add_bond(expr m)=
  cntB:=cntB+1; if m=_arg_ang: tn:=proc_env(angT,env,60,-60); else: tn:=m; fi
  if f_bra=0: adrT:=cntA:=cntA+1; posA[cntA]:=posB[cntB]; angA[cntA]:=angT;
               if tn>=0: br_ang[cntA]:=angT+tn/2-90; else: br_ang[cntA]:=angT+tn/2+90; fi
  else: f_bra:=0; fi
  angB[cntB]:=angT:=(angT+tn) mod 360;
  if f_end=0: if lenB[cntB]=_size_a: posB[cntB+1]:=sfB(posB[cntB],AL,angT);
             else: nA:=lenB[cntB];glu:=0; if nA<0: nA:=-nA; glu_c(adrT);glu_c(cntA+1); fi
             posB[cntB+1]:=sfB(posB[cntB],nA*BL+glu,angT); fi
             posA[cntA+1]:=posB[cntB+1]; f_term:=0;
  else: f_end:=0; f_term:=1; fi
enddef;
%-------------------------------------------------------------------------------------------------
vardef proc_env(expr n,m,a,b)=
   r:=(n mod 360);
  if m>=first_def_number: parMC[m][cntB-temp_cntB-1] 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 pic_c(expr i,s)= substring(i,i+1) of s enddef;
def draw_atom(expr n,p,r,s,w)=
  if ((r mod 360)<=90+1)or((r mod 360)>=270-1): dx:=1; else: dx:=-1; fi
  pairT:=p-(.5AL*w*dx,.5AL); u:=j:=0;
  for i=0 upto length(s)-1: nB:=ASCII(pic_c(i,s));
    if dx<0: if nB=par_s:k:=i+1;j:=1;forever:exitif pic_c(i+(incr j),s)="}";endfor fi
             if j>0: nB:=ASCII(pic_c(k+(decr j),s)); fi fi
    if     nB=score_u: if u=0: u:=-.5; else:u:=0; fi;
    elseif nB=hat:     if u=0: u:= .5; else:u:=0; fi;
    elseif (nB<>par_s)and(nB<>par_e): nA:=atom_w[nB]; pairA:=pairT+(.5*((dx-1)*nA),u*AL);
      if sw_atom_frame=1: draw_frame(nA,AL,pairA,0.01pt); fi
      if (sw_numberA>=1)or(sw_numberB>=1):
        erase fill unitsquare xscaled nA yscaled AL shifted pairA wpcs 0.01pt; fi
      addto currentpicture also atom_font[nB] shifted (pairA-(0,atom_d[nB])) Cp(colorA[n]);
      pairT:=pairT+(nA*dx,0); fi endfor
enddef;
%-------------------------------------------------------------------------------------------------
def wpcs expr n= withpen pencircle 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 z_put(expr PA,PB,PD,CL)= save nA,nC,nD; 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 cut_off(expr p,w,h,s)=
  p intersectionpoint sqr(1.1w,1.1h) shifted (s-(.5(1.1w),.5(1.1h))); enddef;
def clipping(expr SA,SB,PA,PB,LEN)=
  pT:=PA--PB; tn:=0.6AL/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,AL*strW[SB],AL,PB); 
     pA:=Ls--Le; pB:=Ls--tn[PB,PA]; pC:=0.1[PA,PB]--Le;
  elseif SB=0: Ls:= cut_off(pT,AL*strW[SA],AL,PA); Le:=PB;
     pA:=Ls--Le; pB:=tn[PA,PB]--Le; pC:=Ls--(0.1)[PB,PA];
  else: Ls:=cut_off(pT,AL*strW[SA],AL,PA); Le:=cut_off(pT,AL*strW[SB],AL,PB);
        pB:=tn[PA,PB]--tn[PB,PA]; pC:=pA:=Ls--Le; fi
enddef;
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
def draw_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;
enddef;
%-------------------------------------------------------------------------------------------------
def draw_bond(expr n,BP,EP,ANG,LN)=
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(strA[BP],strA[EP],posA[BP],posA[EP],nC); fi
  pickup pencircle scaled bond_pen_wd;
  if known colorB[n]: nB:=colorB[n]; fi
  if     (LN=si)or(sw_bond_single=1): draw pA Cp(nB);
  elseif LN=dl:draw pA Cp(nB); draw sfB(pC,gap,ap) Cp(nB);
  elseif LN=dr:draw pA Cp(nB); draw sfB(pC,gap,am) Cp(nB);
  elseif LN=dm:draw sfB(pB,gap/1.75,ap) Cp(nB); draw sfB(pB,gap/1.75,am) Cp(nB);
  elseif LN=tm:draw pA Cp(nB);draw sfB(pA,gap,ap) Cp(nB); draw sfB(pA,gap,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 gap Cp(nB);
  elseif LN=zf:z_put(Ls,sfB(Le,ww,ap),sfB(Le,ww,am),nB);
  elseif LN=zb:z_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:draw_wv;
  elseif LN=ov:erase draw 0.15[Ls,Le]--0.85[Ls,Le] wpcs gap; draw pA Cp(nB);
  elseif LN=vf:draw pA Cp(nB);draw sfB(Le,gap,ANG-150)--Le--sfB(Le,gap,ANG+150) Cp(nB);
  elseif LN=vb:draw pA Cp(nB);draw sfB(Ls,gap,ANG-30)--Ls--sfB(Ls,gap,ANG+30) Cp(nB); fi
  if (sw_numberB>=1)and(n>=numberB_start)and(n<=numberB_end):
      if     sw_numberB=2: nB:=n-numberB_start+1;
      elseif sw_numberB=3: if numberB_end<cntB: nB:=numberB_end-n+1; else: nB:=cntB-n+1; fi
      else:                nB:=n; fi
      draw_atom(n,.5[posA[BP],posA[EP]],0,decimal(nB),1); fi
fi
enddef;
%-------------------------------------------------------------------------------------------------
vardef fit_zero(expr n)=if n<=9: "00" elseif n<=99: "0" fi enddef;
def auxfile_out=
  printf info_str&"{"
    for i=1 upto aux_max:  exitif var[i]="";
      &"{"&tag[i]&":"&
      if     string  scantokens(var[i]): scantokens(var[i])
      elseif numeric scantokens(var[i]): decimal(scantokens(var[i])) fi &"}"
    endfor
    for i=1 upto info_num: &"{"&info[i]&"}" endfor &"}%";
enddef;
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
mc_num:=first_def_number;
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));
!:='((_mk_bond,_arg_ang)); !0:='(<180,180);
for i=1  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
%-------------------------------------------------------------------------------------------------
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");
%-------------------------------------------------------------------------------------------------
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,/Me); tBu:='(60,-2\,-3*,60); iPr:='(60,-2\); OMe:='(O,!);
SMe:='(S,!); OEt:='(O,!,Et); SEt:='(S,!,Et); OiPr:='(O,!,iPr); SiPr:='(S,!,iPr);
OPr:='(O,!,Pr); SPr:='(S,!,Pr); COO:='(//O,!,O); COOMe:='(COO,!); COMe:='(//O,!);
OCOMe:='(O,!,//O,!); COOEt:='(COO,!,Et); COOiPr:='(COO,!,iPr); COOPr:='(COO,!,Pr);
COOtBu:='(COO,!,tBu); NMeMe:='(N,/Me,!); NHCOMe:='(NH,!,//O,!); NHiPr:='(NH,!,iPr);
NHtBu:='(NH,!,tBu);NHH:='(N,/H,!,H); NHMe:='(NH,!); NHEt:='(NH,!,Et);
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);
%------------------------------------------------------------------------------------------------
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 font_size_set(expr m)(expr n)(expr o)(expr s)=
  for j=0 upto length(s)-1: num_a:=ASCII(pic_c(j,s));
    if f_FON[num_a]=1: atom_w[num_a]:=m*AL; atom_h[num_a]:=n*AL; atom_d[num_a]:=o*AL; fi
  endfor
enddef;
def font_size_setup=  font_size_set(  1)(  1)(0)("CGHMNOQ");
                      font_size_set( .9)(  1)(0)("ABDEFIJKLPRSTUVWXYZ-+/><m");
                      font_size_set( .7)(  1)(0)(" ()0123456789nhj=*bdiltf");
                      font_size_set( .7)(  1)(.15)("pqg");
                      font_size_set( .7)( .8)(0)("acekosuvxzwry");
                      font_size_set( .4)(  1)(0)(".,:;'`");
enddef;
%------------------------------------------------------------------------------------------------
def SP(expr a,b)expr p=subpath(a*length(p),b*length(p)) of p enddef;
def vL= withpen penrazor scaled fP enddef; def hL= withpen penrazor rotated 90 scaled fP enddef;
def sH expr a= shifted (0,a) enddef;
def PO= z10..(.8aW,fH)..tension 1.5..(.2aW,fH)..z09..(.2aW,hP)..tension 1.5..(.8aW,hP)..cycle
enddef;
def POh= (hP,.25aH)..z19..(fW,.25aH)..(hW,hH)..cycle enddef;
def FD(expr c)(text s)=
if f_FON[ASCII(c)]=1:
  aW:=atom_w[ASCII(c)]*(1-ratio_atomgap_atom*2); aH:=atom_h[ASCII(c)]*(1-ratio_atomgap_atom*2);
  fW:=aW-hP; hW:=.5aW; fH:=aH-hP; hH:=.5aH;
  z01=( 0,hP); z02=(hP, 0); z03=(hP,hP); z05=(aW,hP); z07=(fW, 0); z08=( 0,hH); z09=(hP,hH);
  z10=(fW,hH); z12=( 0,fH); z13=(hP,fH); z14=(hW,fH); z16=(aW,fH); z18=(hP,aH); z19=(hW,hP);
  s;
  atom_font[ASCII(c)]:=currentpicture shifted (ratio_atomgap_atom*AL,ratio_atomgap_atom*AL);
  clearxy; save x,y; clearit; fi
enddef;
%-------------------------------------------------------------------------------------------------
def font_setup=
pickup pencircle scaled char_pen_wd; fP:=char_pen_wd; hP:=.5char_pen_wd;
FD(" ")();
FD(".")(drawdot z19 wpcs fP);
FD(",")(drawdot z19 wpcs fP; draw (hW+.5fP,hP)..(hW+.3fP,-fP)..(hW-.5fP,hP-2fP));
FD("'")(drawdot z14 wpcs fP; draw (hW+.5fP,fH)..(hW+.3fP,fH-fP)..(hW-.5fP,fH-2fP));
FD("`")(drawdot (hW,fH-2fP) wpcs fP;draw (hW-.5fP,fH-2fP)..(hW-.3fP,fH-fP)..(hW+.5fP,fH));
FD(":")(drawdot (hW,.2aH) wpcs fP; drawdot (hW,.8aH) wpcs fP); 
FD(";")(drawdot (hW,.2aH) wpcs fP; drawdot (hW,.8aH) wpcs fP;draw (hW+hP,.2aH)..(hW-hP,.2aH-2fP));
FD("(")(draw z19...z09...z14);
FD(")")(draw z19...z10...z14);
FD(">")(cutdraw z01--(aW,hH)--z12);
FD("<")(cutdraw z16--z08--z05);
FD("0")(draw z09...z14...z10...z19...cycle);
FD("1")(draw (hW, 0)--(hW,aH)--(hW-hP,fH)--(hW-hP,aH-2.5hP) vL);
FD("2")(cutdraw SP(0,.71)(hP,1.3hP)--(fW,.55aH)..z14..(hP,.5aH)..(hW,.27aH); draw z05--z01 hL);
FD("3")(cutdraw SP(0,.77)POh; cutdraw SP(.23,.95)POh sH .5aH-hP; draw (.3aW,hH)--(hW,hH) hL);
FD("4")(draw (0,.3aH)--(aW,.3aH) hL; draw (.7aW,0)--(.7aW,aH)--(1.2hP,.3aH+hP) vL);
FD("5")(draw z12--z16 hL; draw z13--(hP,.49aH) vL;
        cutdraw (.5hP,.15aH)..(.65aW,1.3hP)..(fW,.3aH)..(hW,.6aH)..(.6hP,.53aH));
FD("6")(draw z19..(fW,.5fW)..(hW,fW)..(hP,.5fW)..cycle; cutdraw (hP,.4aH)--(hW,aH));
FD("7")(draw (0,.fH)--(aW,fH) hL; draw (aW-1.2hP,aH-fP)--(.4aW,0) vL scaled 1.2);
FD("8")(draw POh; draw (hP,.75aH)...z14...(fW,.75aH)...(hW,hH)...cycle;);
FD("9")(draw z19..(fW,.5fW)..(hW,fW)..(hP,.5fW)..cycle sH .32aH; cutdraw (fW,.6aH)--(hW, 0));
FD("A")(draw z02--(hW,aH)--z07 vL scaled 1.14; draw .33[z02,(hW,aH)]--.33[z07,(hW,aH)]);
FD("B")(draw z13--z14{right}..(.9fH,.75aH)..{left}(.5aW,hH)--z09--(.5aW,hH){right}..
            (.9fH,.25aH)..{left}z19--z03; draw z02--z18 vL);
FD("C")(cutdraw SP(.05,.95)PO); 
FD("D")(draw z13--z14..z10..z19--z03; draw z02--z18 vL);
FD("E")(draw z05--z01 hL;draw z12--z16 hL;draw z08--(aW,hH) hL;draw z02--z18 vL);
FD("F")(draw z12--z16 hL; draw (0,.45aH)--(fW,.45aH) hL; draw z02--z13 vL);
FD("G")(cutdraw SP(.06,.97)PO; draw bot (hW,hH)-- bot (aW,hH) hL);
FD("H")(draw z02--z18 vL; draw z09--z10; draw z07--(fW,aH) vL);
FD("I")(draw z19--z14 vL; draw (hW-fP,hP)--(hW+fP,hP) hL; draw (hW-fP,fH)--(hW+fP,fH) hL);
FD("J")(cutdraw z09..(hP,.4aH){down}..{right}z19{right}..{up}(fW,.4aH)..(fW,aH));
FD("K")(cutdraw z02--z18; cutdraw .5[.45[z02,z18],z16]--z07; cutdraw .45[z02,z18]--z16);
FD("L")(draw z05--z01 hL; draw z02--z18 vL);
FD("M")(draw z02--z18 vL; draw z18--z19--(fW,aH) vL scaled 1.14; draw (fW,aH)--z07 vL);
FD("N")(draw z02--z18 vL; draw z07--(fW,aH) vL;draw (1.4hP,aH)--(aW-1.4hP,0) vL scaled 1.4);
FD("O")(draw PO);
FD("P")(draw z02--z18 vL; draw z13--(.3aW,fH){right}..(fW,.7aH)..{left}(.3aW,.44aH)..(hP,.44aH))
FD("Q")(draw PO; draw (.6aW,.4aH)--z07);
FD("R")(draw z02--z18 vL; draw z13--(.3aW,fH){right}..(fW,.7aH)..{left}(.3aW,.44aH)..(hP,.44aH);
        cutdraw z07{up}..{left}(hW,.44aH));
FD("S")(cutdraw SP(.05,.45)PO; cutdraw SP(.55,.95)PO; draw (fW,.3aH){up}..{up}(hP,.7aH));
FD("T")(draw z12--z16 hL;draw .5[z12,z16]--(hW, 0) vL);
FD("U")(cutdraw z18..z09{down}..{right}z19{right}..{up}z10..(fW,aH));
FD("V")(draw z18--(hW, 0) vL scaled 1.2; draw (hW, 0)--(fW,aH) vL scaled 1.2);
FD("W")(draw z18--(.25aW,0)--(hW,aH)--(.75aW,0)--(fW,aH) vL scaled 1.08);
FD("X")(draw z18..z07 vL scaled 1.4; draw z02..(fW,aH) vL scaled 1.4);
FD("Y")(draw z18--(hW,hH)--(fW,aH) vL scaled 1.2; draw (hW,hH)--(hW, 0) vL);
FD("Z")(draw z12--z16 hL;draw (1.4hP,fP)--(aW-1.4hP,aH-fP) vL scaled 1.4;draw z01--z05 hL);
FD("-")(draw z09--z10 hL);
FD("=")(draw (hP,.3aH)--(fW,.3aH) hL;draw (hP,.6aH)--(fW,.6aH) hL);
FD("/")(draw (fW,fH)..z01);
FD("+")(draw z19--z14 vL; draw z09--z10 hL);
FD("a")(draw z19..z10..z14..z09..cycle; draw z07--(fW,aH) vL);
FD("b")(draw z19..z10..(hW,aW)..z09..cycle; draw z02--(hP,1.2aH) vL);
FD("c")(cutdraw SP(.06,.94)z10..z14..z09..z19..cycle);
FD("d")(draw z19..z10..(hW,aW)..z09..cycle; draw z07--(fW,1.2aH) vL);
FD("e")(cutdraw SP(0,.92)z10..z14..z09..z19..cycle; draw z10--z09);
FD("f")(cutdraw (.5aW,0)--(.5aW,.75aH){up}..(.75aW,fH)..{down}(fW,.8aH); draw z08--(aW,hH) hL);
FD("g")(draw z19..z10..(hW,aW)..z09..cycle sH .3aH; cutdraw (fW,aH)--(fW,hP)..(hW,0)..(.1aW,fP));
FD("h")(draw z02..(hP,.3aH){up}..(hW,.7fH)..{down}(fW,.3aH)..z07; draw (hP,.3aH)--z18 vL);
FD("i")(draw (hW, 0)--(hW,.63aH) vL; draw z14 wpcs 1.4fP);
FD("j")(draw z19--(hW,.63aH) vL; draw z19..(.25aW,-hP)..z01; draw z14 wpcs 1.4fP);
FD("k")(draw z02--z18 vL; cutdraw .5[.45[z02,z18],z16]--z07; cutdraw .45[z02,z18]--z16);
FD("l")(draw (hW, 0)--(hW,aH) vL; draw z14--z13 hL; draw z19--(fW,hP) hL);
FD("m")(cutdraw z02..(hP,.3aH){up}..(.28aW,.7fH)..{down}(hW,.3aH)..(hW, 0);
        cutdraw (hW,.3aH){up}..(.7aW,.7aH-hP)..{down}(fW,.3aH)..z07; draw (hP,.3aH)--(hP,.7aH) vL);
FD("n")(cutdraw z02..(hP,.3aH){up}..(hW,.7fH)..{down}(fW,.3aH)..z07; draw (hP,.3aH)--(hP,.7aH) vL);
FD("o")(draw z19..z10..z14..z09..cycle);
FD("p")(draw z19..z10..(hW,aW)..z09..cycle sH .3aH; draw (hP,0)--z18 vL);
FD("q")(draw z19..z10..(hW,aW)..z09..cycle sH .3aH; draw (fW,0)--(fW,aH) vL);
FD("r")(cutdraw SP(.35,.72)z19..z10..z14..z09..cycle sH -fP; draw z02--z18 vL);
FD("s")(cutdraw SP(.05,.45)PO; cutdraw SP(.55,.95)PO; draw (fW,.3aH){up}..{up}(hP,.7aH));
FD("t")(draw (hW, 0)--(hW,aH) vL; draw (0,.66aH)--(aW,.66aH) hL);
FD("u")(cutdraw z18..(hP,.55aH){down}..z19..(fW,.55aH){up}..(fW,aH); draw (fW,aH)--z07 vL);
FD("v")(draw z18--(hW, 0)--(fW,aH) vL);
FD("w")(draw z18--(.25aW,0)--(hW,aH)--(.75aW,0)--(fW,aH) vL);
FD("x")(draw z18--z07 vL scaled 1.4; draw (fW,aH)--z02 vL scaled 1.4);
FD("y")(draw z18--(hW,hH) vL scaled 1.4; draw (fW,aH)--z02 vL scaled 1.4);
FD("z")(draw z12--z16 hL;draw (1.4hP,fP)--(aW-1.4hP,aH-fP) vL scaled 1.4; draw z01--z05 hL);
enddef;
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
def blank_str:= "            " enddef;
def fixed_r(expr n)(expr s)= (substring(0,n-length(s)) of blank_str)&s enddef;
def fixed_l(expr n)(expr s)= s&(substring(0,n-length(s)) of blank_str) enddef;
def fdr(expr n)(expr s)=fixed_r(n)(decimal(s)) enddef;
def warning(expr s)= message "% "&decimal(char_num)&fdr(3)(incr warning_cnt)&")"&s&" !!!"; enddef;
def B_check(expr s)(expr t)(expr n)=
  if com_str[strA[s]]=t: if nA>n:
    warning(fdr(4)(s)&" ["&com_str[strA[s]]&"] has "&fdr(3)(nA)&" bonds"); fi fi
enddef;
vardef stripP(expr a)=if length(a)=4: substring (1,3) of a else: a fi enddef;
def STa(expr a,b)= tblA[incr tbl_cnt]:=a; tblN[tbl_cnt]:=0; wtA[tbl_cnt]:=b; enddef;
def STb(expr a)(text s)=  tblA[incr tbl_cnt]:=a; tblN[tbl_cnt]:=0;
  for list=s: tblN[tbl_cnt]:=tblN[tbl_cnt]+1;
    for j=1 upto tbl_max: if list=tblA[j]: tblB[tbl_cnt][tblN[tbl_cnt]]:=j; fi endfor
  endfor
enddef;
%-------------------------------------------------------------------------------------------------
tbl_cnt:=0;
STa("C",12.0107); STa("H",1.00794);  STa("{Al}",26.9815); STa("{As}",74.9236); STa("B",10.811);
STa("{Br}",79.904); STa("{Ca}",40.078); STa("{Cl}",35.453); STa("{Cu}",63.546); STa("D",2.012);
STa("F",18.9984); STa("{Fe}",55.845); STa("{Hg}",200.59); STa("I",126.90447); STa("K",39.0983);
STa("{Li}",6.941); STa("{Mg}",24.305); STa("N",14.0067); STa("{Na}",22.98977); STa("{Ni}",58.693);
STa("O",15.9994); STa("P",30.973761); STa("S",32.065); STa("{Si}",28.0855); STa("{Sn}",118.71);
STa("{Ti}",47.867); STa("{Zn}",65.409);
tbl_max:=tbl_cnt;;
STb("{H_2_}")("H","H"); STb("OH")("O","H"); STb("O{Na}")("O","{Na}"); STb("CN")("C","N");
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 mol_check=
  hide_H:=warning_cnt:=calc_weight:=calc_weightp:=0; calc_formula:="";
  for i=1 upto tbl_max: sumA[i]:=0; endfor
  for i=1 upto cntA: knownA:=nA:=0;
    for j=1 upto cntB: if     (lineB[j]=dl)or(lineB[j]=dr)or(lineB[j]=dm): bondC[j]:=2;
                       elseif (lineB[j]=tm): bondC[j]:=3; elseif lineB[j]=nl: bondC[j]:=0;
                       elseif lineB[j]=0: bondC[j]:=0; else: bondC[j]:=1; fi
                       if (sB[j]=i)or(eB[j]=i): nA:=nA+bondC[j]; fi endfor
    Bcnt[i]:=nA;
    if com_str[strA[i]]="": com_str[strA[i]]:="C"; fi
    if com_str[strA[i]]="C": if nA<4: hide_H:=hide_H+(4-nA); fi fi
    B_check(i)("C")(4); B_check(i)("H")(1);    B_check(i)("O")(2);
    B_check(i)("F")(1); B_check(i)("{Cl}")(1); B_check(i)("{Br}")(1);
    for j=1 upto tbl_cnt:
      if com_str[strA[i]]=tblA[j]:
        if tblN[j]=0: sumA[j]:=sumA[j]+1;
        else: for k=1 upto tblN[j]: sumA[tblB[j][k]]:=sumA[tblB[j][k]]+1; endfor fi
        knownA:=1; fi  endfor
    if knownA=0: warning(" Unknown Str("&com_str[strA[i]]&") is used "&decimal(i)); fi
  endfor
  sumA[2]:=sumA[2]+hide_H;
  for i=1 upto tbl_max:
    if sumA[i]>=1:
      tmp_wtp:=(wtA[i]/100)*sumA[i];
      if (tmp_wtp<=40)and(calc_weightp<=40): calc_weight:=calc_weight+(wtA[i]*sumA[i]);
      else: calc_weightp:=calc_weightp+tmp_wtp; fi
      calc_formula:=calc_formula&stripP(tblA[i]) if sumA[i]>=2: &decimal(sumA[i]) fi;
    fi
  endfor
enddef;
%------------------------------------------------------------------------------------------------
def checklist_out=
  nA:=0; calc_weight_str:="";
  message "% Molecular name = "& mol_name;
  message "%  There were "&fdr(3)(warning_cnt)&
          " warnings / Expanded command count= "&decimal(cntMC[0]);
  message "%  width * height = " & fdr(8)(max_x-min_x)&" * "&fdr(8)(max_y-min_y);
  message "%  Shift width * height  = "& fdr(8)(min_x)&" * "&fdr(8)(min_y);
  message "%  Bond length = "&fdr(3)(BL)&"   Atom size   = "&fdr(3)(AL);
  message "%  Atom count="&fdr(3)(cntA)&" Bond count="&fdr(3)(cntB)&
          " Ring count="&fdr(3)(cntB-cntA+1)&" Hide H ="&fdr(3)(hide_H);
  message "%-----------------------------------< atom >< bond >-------";
  for i=1 upto cntA: message "%  "&fdr(3)(i)&"  ("&fdr(10)(xpart(posA[i])/BL)&" ) ("&
     fdr(10)(ypart(posA[i])/BL)&" )  "&fixed_l(8)(com_str[strA[i]])&"  "&fdr(3)(Bcnt[i]); endfor
  message "%Bond list---------------------------------------------------------";
  for i=1 upto cntB: if lineB[i]<>0: message "% "&fdr(3)(incr nA)&" "&fdr(3)(sB[i])&
                     " -> "&fdr(3)(eB[i])&" ("&fdr(3)(bondC[i]-si+1)&")"; fi endfor
  message "%Fomula / Molecular weight ---------------------------------------";
  if    calc_weightp<=40: calc_weight_str:=fdr(10)(calc_weight); 
  else: calc_weight_str:=fdr(10)(calc_weightp)&" * 100"; fi
  for i=1 upto tbl_max:
    if sumA[i]>=1:
       message "% "&fixed_l(4)(stripP(tblA[i]))&"("&fdr(9)(wtA[i])&") * "&fdr(6)(sumA[i])&" = "
       if tmp_wtp<=40: &fdr(12)(wtA[i]*sumA[i]); else: &fdr(12)(tmp_wtp)&" * 100"; fi fi  endfor
  message "% Weight  Calc: " &calc_weight_str &" / Input: "
    if mol_weight>0: &decimal(mol_weight) &" / weight gap= " &decimal(calc_weight-mol_weight) fi;
  message "% Fomula  Calc: "&calc_formula&" / Input: "
    if mol_formula<>"":&mol_formula&" / "& 
      if mol_formula=calc_formula: "MACTCH" else: "NOT MACTCH" fi fi;
  message "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%";
enddef;
%------------------------------------------------------------------------------------------------
def MOLfileout=
  mp_log_name:=jobname&"-"&fit_zero(char_num)&decimal(char_num)&"-"&mol_name&".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])/BL)& fdr(10)(ypart(posA[i])/BL)&
           fdr(10)(0)&" "&fixed_l(2)(stripP(com_str[strA[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;
%-----------------------------------------------------------------------------------------------