summaryrefslogtreecommitdiff
path: root/graphics/mcf2graph/mcf2graph.mf
diff options
context:
space:
mode:
authorNorbert Preining <norbert@preining.info>2019-09-02 13:46:59 +0900
committerNorbert Preining <norbert@preining.info>2019-09-02 13:46:59 +0900
commite0c6872cf40896c7be36b11dcc744620f10adf1d (patch)
tree60335e10d2f4354b0674ec22d7b53f0f8abee672 /graphics/mcf2graph/mcf2graph.mf
Initial commit
Diffstat (limited to 'graphics/mcf2graph/mcf2graph.mf')
-rw-r--r--graphics/mcf2graph/mcf2graph.mf1819
1 files changed, 1819 insertions, 0 deletions
diff --git a/graphics/mcf2graph/mcf2graph.mf b/graphics/mcf2graph/mcf2graph.mf
new file mode 100644
index 0000000000..0906454eb5
--- /dev/null
+++ b/graphics/mcf2graph/mcf2graph.mf
@@ -0,0 +1,1819 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% mcf2graph ver 4.44 Copyright (c) 2013-2019 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
+%--------------------------------------------------------------------------------------------------
+% 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 bboxmargin=0 FILENAME
+% Set output first font only : mpost -s bboxmargin=1 FILENAME
+% Set outputformat to "eps"(.mps) : 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 "eps" (.eps) : mpost -s ahangle=3 FILENAME
+% Set output aux file : mpost -s ahlength=1 FILENAME
+% Set output report : mpost -s ahlength=2 FILENAME
+% Set output MOL(V2000) : mpost -s ahlength=5 FILENAME
+% Set output MOL(V3000) : mpost -s ahlength=6 FILENAME
+% Set to use plain.mp (label,arrow) : mpost -s labeloffset=1 FILENAME
+% Set to use plain.mp (label,arrow,atom) : mpost -s labeloffset=2 FILENAME
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+tracingstats:=1;
+%-------------------------------------------------------------------------------------------------
+newinternal char_num,str_cnt,sub_usr,sub_int,tbl_cnt,sharp_char;
+numeric save_num[],comD[][],parD[][],cntD[],tbl_atom[],tbl_subst[][],
+ tbl_atom_wt[],tbl_atom_mi[],tbl_char_wd[],tbl_char_ht[],andA[],and_rot[],chargeA[];
+string save_str[],tbl_atom_str[],strD[],var[],tag[],out_file_name,out_file_aux,out_file_rep,
+ aux_delimiter,atomfont,save_atomfont,save_defaultfont;
+pair save_pair[],msize,mposition,fsize,fmargin,save_mposition;
+picture mol_stru[],save_picture,temp_picture;
+path arrow_path,arrow_head;
+%-------------------------------------------------------------------------------------------------
+char_num:=str_cnt:=proc_end:=mangle:=sw_label_emu:=sw_calc:=sw_extall:=0;
+sw_numberA:=sw_numberB:=sw_mframe:=sw_aux_out:=sw_expand:=sw_fframe:=sw_trimming:=0;
+sw_aframe:=sw_rep_out:=sw_mol_out:=sw_subst_off:=sw_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[];
+ prologues:=3;
+ %-----------------------------------------------------------------------------------------
+ fontmapfile "pdftex.map";
+ %-----------------------------------------------------------------------------------------
+ atomfont:=defaultfont:="";
+ out_file_aux:=jobname&"-info.aux";
+ out_file_rep:=jobname&"-report.txt";
+ def out_file_mol= jobname&"-"&fit_zero(char_num)&"-"&inf_EN&".mol" enddef;
+ %--default ahangle=45---------------------------------------------------------------------
+ if ahangle=0: outputformat:="eps"; % eps format(.mps)
+ elseif ahangle=1: outputformat:="png"; hppp:=vppp:=0.12; % png format(600dpi)
+ elseif ahangle=2: outputformat:="svg"; % svg format
+ elseif ahangle=3: outputformat:="eps"; % eps format(.eps)
+ %
+ elseif ahangle=11: outputformat:="png"; hppp:=vppp:=0.24; % png format(300dpi)
+ elseif ahangle=12: outputformat:="png"; hppp:=vppp:=0.10; % png format(720dpi)
+ elseif ahangle=13: outputformat:="png"; hppp:=vppp:=0.06; % png format(1200dpi)
+ fi
+ %--default ahlength=4---------------------------------------------------------------------
+ if ahlength=1: sw_aux_out:=1; bboxmargin:=0; % output aux file
+ elseif ahlength=2: sw_rep_out:=1; bboxmargin:=0; % output report
+ elseif ahlength=5: sw_mol_out:=1; bboxmargin:=0; % output MOL(V2000)
+ elseif ahlength=6: sw_mol_out:=2; bboxmargin:=0; % output MOL(V3000)
+ fi
+ %-- default bboxmargin=2------------------------------------------------------------------
+ if bboxmargin=0: def shipit = enddef; % No image file
+ elseif bboxmargin=1: proc_end:=1; % output first font only
+ fi
+ %--default labeloffset=3------------------------------------------------------------------
+ if labeloffset=1: sw_arrow:=1; defaultfont:="uhvr8r"; % plain.mp label
+ elseif labeloffset=2: sw_arrow:=1; defaultfont:=atomfont:="uhvr8r"; % plain.mp label,atom
+ fi
+ %--default outputtemplate:="%j-%3c."&"mps"------------------------------------------------
+ if (outputformat="eps")and(ahangle<>3): outputtemplate:="%j-%3c."&"mps";
+ else: outputtemplate:="%j-%3c."&outputformat;
+ fi
+ %-----------------------------------------------------------------------------------------
+ def endchar = endfig enddef;
+ def printf expr s= write s to out_file_name enddef;
+ def # = enddef;
+ vardef totalweight expr a= 0 enddef;
+ def Cp(expr s) = if known s: if s<>0: withcolor color_list[s] fi fi enddef;
+ def ext(text TXT)= sw_extall:=sw_calc:=1; def EXTALL = TXT enddef; enddef;
+ if atomfont="": atomfont:="draw"; fi % default atom font
+ if defaultfont="": defaultfont:="draw"; fi % default label font
+ %-----------------------------------------------------------------------------------------
+else: f_MP:=0;
+ %------------------------------------
+ def image = image_emu enddef;
+ def llcorner = llcorner_emu enddef;
+ def lrcorner = lrcorner_emu enddef;
+ def urcorner = urcorner_emu enddef;
+ def ulcorner = ulcorner_emu enddef;
+ string defaultfont;
+ dotlabeldiam:=3bp;
+ def Cp(expr s) = enddef;
+ def color = transform enddef;
+ def ext(text TXT)= enddef;
+ sw_arrow:=0;
+ atomfont:="draw";
+ defaultfont:="draw";
+ mode_setup;
+fi
+clearit;
+%--------------------------------------------------------------------------------------------------
+message "---------------------------------------------";
+message "This is mcf2graph ver 4.44 2019.07";
+if f_MP=1:
+ message "numbersystem="&numbersystem;
+ if ahlength=1: message "output aux file";
+ message "out_file_aux="&out_file_aux;
+ elseif ahlength=2: message "output report file";
+ message "out_file_rep="&out_file_rep;
+ elseif ahlength=5: message "output MOL file(V2000)";
+ message jobname&"-nnn-"&"inf_EN"&".mol";
+ elseif ahlength=6: message "output MOL file(V3000)";
+ message jobname&"-nnn-"&"inf_EN"&".mol";
+ fi
+ if bboxmargin=0:
+ message "No image file";
+ else:
+ if outputformat="png":
+ message "outputformat="&outputformat &" / ppp="&decimal(hppp);
+ else:
+ message "outputformat="&outputformat;
+ fi
+ message "outputtemplate="&outputtemplate;
+ fi
+fi
+message "---------------------------------------------";
+%--------------------------------------------------------------------------------------------------
+let DIV= /; let MUL= *; let LT= <; let GT= >; let AND= &; let :: = : ; let == = =; let ef=elseif;
+%--------------------------------------------------------------------------------------------------
+primarydef a at b = fat(a,b) enddef;
+def fat(expr a,b)= mposition:=b; a enddef;
+%--------------------------------------------------------------------------------------------------
+?3:=?20:=Ph:=Ph1:=Ph2:=hz:=0; vt:=1;
+ratio_chain_ring:= 0.66; ratio_atom_bond:=0.36;
+ratio_thickness_bond:=0.015; ratio_thickness_char:=0.1;
+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.040;
+offset_thickness:=0.2bp; offset_bond_gap:=0.3bp; offset_zebra_gap:=0.1bp;
+offset_atom:=0.8pt; offset_wedge:=0.4bp; max_labelsize:=20mm;
+thickness_fframe:=0.2bp; thickness_mframe:=0.2bp; thickness_aframe:=0.1bp;
+max_blength:=10mm; blength:=0; mangle:=0;
+%--------------------------------------------------------------------------------------------------
+fsize:=(30mm,20mm); fmargin:=(0.4mm,0.4mm); msize:=(1,1); mposition:=(0.5,0.5);
+%==================================================================================================
+ahangle:=45;
+ahlength:=4bp;
+bboxmargin:=2bp;
+defaultsize:=8bp;
+defaultscale:=1;
+labeloffset:=3bp;
+ext_defaultline:=0.5bp;
+lonepairdiam:=lonepairspace:=circlediam:=circlepen:=0;
+%==================================================================================================
+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,_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,_postG,_postH,
+ _set_clr,_set_adr,_mk_bond,_set_atom,_arg_ang,_chg_atom,_tmp_rot,_fuse,_push,_pop,
+ _size_a,_numeric,_jump_at,_connect_at,_set_and,_chg_charge,_nop);
+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_rep_out,sw_numberA,sw_numberB,sw_mframe,sw_aux_out,sw_expand,sw_mol_out,sw_calc,sw_extall,
+ sw_aframe,sw_fframe,sw_subst_off,sw_single,sw_trimming,sw_arrow,sw_label_emu,
+ ratio_atom_bond,ratio_thickness_bond,ratio_char_bond,
+ ratio_chain_ring,ratio_bondgap_bond,ratio_zebra_black,ratio_zebragap_bond,ratio_thickness_char,
+ ratio_wedge_bond,ratio_atomgap_atom,lonepairdiam,lonepairspace,
+ blength,offset_atom,offset_wedge,max_blength,offset_zebra_gap,offset_bond_gap,
+ thickness_fframe,thickness_mframe,thickness_aframe,offset_thickness,
+ numberA_start,numberA_end,numberB_start,numberB_end,
+ defaultsize,defaultscale,labeloffset,mangle,
+ Me,Et,Pr,Bu,iPr,tBu,CH3,CF3,CCl3,CBr3,NH,NH2,NO2,OH,CHO,COOH,CN,SH,OMe,OEt,SMe,SEt,
+ !CH3,!NH2,!OH,!CHO,!COOH,!CN,!SH,!NO2,
+ fsize,fmargin,msize,mposition,defaultfont,atomfont
+enddef;
+%--------------------------------------------------------------------------------------------------
+def ]]]=] ] ] enddef;
+vardef iif(expr a,b,c)=if a: b else: c fi enddef;
+vardef pic_c(expr i,s)= substring(i,i+1) of s enddef;
+vardef sfB(expr a,b,c)= a shifted ((b,0) rotated c) enddef;
+%--------------------------------------------------------------------------------------------------
+def init_par(text t)=
+nA:=nB:=nC:=0;
+ for list=t:
+ if numeric list: nA:=nA+1; save_num[nA]:=list;
+ elseif pair list: nB:=nB+1; save_pair[nB]:=list;
+ elseif string list: nC:=nC+1; save_str[nC]:=list;
+ fi
+ endfor
+enddef;
+%--------------------------------------------------------------------------------------------------
+def store_par(text t)=
+ nA:=nB:=nC:=0;
+ for list=t:
+ if numeric list: nA:=nA+1; if save_num[nA]<>list: save_num[nA]:=list; fi
+ elseif pair list: nB:=nB+1; if save_pair[nB]<>list: save_pair[nB]:=list; fi
+ elseif string list: nC:=nC+1; if save_str[nC]<>list: save_str[nC]:=list; fi
+ fi
+ endfor
+enddef;
+%--------------------------------------------------------------------------------------------------
+def restore_par(text t)=
+ nA:=nB:=nC:=0;
+ forsuffixes list=t:
+ if numeric list: nA:=nA+1; if list<>save_num[nA]: list:=save_num[nA]; fi
+ elseif pair list: nB:=nB+1; if list<>save_pair[nB]: list:=save_pair[nB]; fi
+ elseif string list: nC:=nC+1; if list<>save_str[nC]: list:=save_str[nC]; fi
+ fi
+ endfor
+enddef;
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+def beginfont(text s)=
+ begingroup
+ save cntA,cntB,cntM,minX,minY,f_beginchar,numS,sftX,sftY,f_ext,blen,ext,add,
+ 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,
+ posA,posM,lineB,sB,eB,angB,angA,wdA,dxA,lenB,ang_br,info;
+ numeric lineB[],sB[],eB[],angB[],angA[],lenB[],angX[],numS[],wdM[],htM[],wdA[],dxA[],dx_A[];
+ pair posA[],posM[][];
+ string info[],sumA,s_tag,s_var,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;
+ %------------------------------------------------------------------------------------------------
+ def ext=ext_font enddef;
+ def add=add_mole enddef;
+ %------------------------------------------------------------------------------------------------
+ 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:="";
+ %------------------------------------------------------------------------------------------------
+ char_num:=char_num+1;
+ store_par(parameter_list);
+ for i:=1 upto max_inf_num: info[i]:=":"; endfor
+ f_ext:=inf_num:=cntM:=0;
+ for list=s: inf_num:=inf_num+1; info[inf_num]:=list; endfor
+ %------------------------------------------------------------------------------------------------
+ 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
+ %------------------------------------------------------------------------------------------------
+ mol_stru[0]:=nullpicture;
+enddef;
+%==================================================================================================
+def endfont=
+ if (f_MP=1)and(sw_extall=1): ext_font(EXTALL); fi
+ if sw_trimming>=1:
+ nA:=nC:=4095; nB:=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_lr;
+ font_ht:=nD-nC+2margin_tb;
+ fsize:=(font_wd,font_ht);
+ for i=1 upto cntM:
+ posM[0][i]:=posM[0][i]+(margin_lr-nA,margin_tb-nC);
+ posM[1][i]:=posM[1][i]+(margin_lr-nA,margin_tb-nC);
+ endfor
+ fi
+ %-----------------------------------------------------------------------------------------------
+ if f_MP=0: beginchar(char_num,font_wd/bp*bp#,font_ht/bp*bp#,0)
+ else: beginfig(char_num) w:=charwd:=font_wd; h:=charht:=font_ht; chardp:=0;
+ fi
+ if (sw_fframe=1)or(sw_fframe=3): ext(draw_frame((0,0),w,h,thickness_fframe);) fi
+ if (sw_fframe=2)or(sw_fframe=3): ext(draw_frame(p0,w0,h0,thickness_fframe);) fi
+ if sw_fframe=4: ext(drawdot(0,0); drawdot(w,0); drawdot(w,h); drawdot(0,h);) fi
+ for i=1 upto cntM:
+ addto currentpicture also mol_stru[i] shifted posM[0][i]; mol_stru[i]:=nullpicture;
+ if sw_mframe=1: ext(draw_frame(p[i],w[i],h[i],thickness_mframe)) fi
+ endfor
+ if f_ext=1: addto currentpicture also mol_stru[0]; mol_stru[0]:=nullpicture; fi
+ endchar;
+ clearit;
+ restore_par(parameter_list);
+ endgroup;
+ 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 == if (known a)and(known b):: change_bond(a,b) else:: _nop fi enddef;
+ tertiarydef a:b == if (known a)and(known b):: change_atom(a,b) else:: _nop fi enddef;
+ def { == '''( enddef;
+ let } == );
+ def &primary s == (_set_and,ASCII(s)) enddef;
+ vardef $primary a == a-4095 enddef;
+ def ^^primary n == (_tmp_rot,n) enddef;
+ def ``primary n == (_chg_len,n) enddef;
+ def '`primary n == (_tmp_len,n) enddef;
+ def <primary n == (_rot_ang,n) enddef;
+ def >>primary n == (_chg_env,n) enddef;
+ def ~~primary n == (_tmp_line,n) enddef;
+ def :>primary n == (_tmp_env,n) enddef;
+ tertiarydef a^b == if known b:: ^^b,a else:: _nop,a fi enddef;
+ tertiarydef a`b == if known b:: '`b,a else:: _nop,a fi enddef;
+ tertiarydef a~b == if known b:: ~~b,a else:: _nop,a fi enddef;
+ tertiarydef a>b == if known b:: :>b,a else:: _nop,a fi enddef;
+ def # == _connect_at enddef;
+ def @ == _jump_at enddef;
+ def \ == @,0 enddef;
+ def \\ == \~dm enddef;
+ def *\ == \~wf enddef;
+ def \* == \~zf enddef;
+ def *\* == \~wv enddef;
+ def |: == (_push,0) enddef;
+ def :| == (_pop,0) enddef;
+ def |< == (_push,1) enddef;
+ def >| == (_pop,1) enddef;
+ def |=primary n == (_push,0),``n enddef;
+ def =| == (_pop,0) enddef;
+ def | == (_push,2) enddef;
+ def || == (_pop,2) enddef;
+ def /secondary n == if known n:: (_postA,n) else:: _nop fi enddef;
+ def //secondary n == if known n:: (_postB,n) else:: _nop fi enddef;
+ def */secondary n == if known n:: (_postC,n) else:: _nop fi enddef;
+ def /*secondary n == if known n:: (_postD,n) else:: _nop fi enddef;
+ def **secondary n == if known n:: (_postF,n) else:: _nop fi enddef;
+ def */*secondary n == if known n:: (_postG,n) else:: _nop fi enddef;
+enddef;
+%=================================================================================================
+vardef '(text TXT)= ''(incr sub_usr)(TXT); sub_usr enddef;
+%-------------------------------------------------------------------------------------------------
+def ''(expr ADR)(text TXT)=
+ begingroup
+ save list_cnt;
+ if unknown inside_def_MC:: set_def_MC fi
+ cntD[ADR]:=list_cnt:=0;
+ for list==TXT::
+ list_cnt:=list_cnt+1;
+ if known list::
+ if pair list::
+ cntD[ADR]:=cntD[ADR]+1;
+ comD[ADR][cntD[ADR]]:=xpart(list);
+ parD[ADR][cntD[ADR]]:=ypart(list);
+ elseif numeric list::
+ if list==_nop::
+ message "unknown command in "AND decimal(list_cnt);
+ elseif list>=sub_emb_start::
+ for i==1 upto cntD[list]::
+ cntD[ADR]:=cntD[ADR]+1;
+ comD[ADR][cntD[ADR]]:=comD[list][i];
+ parD[ADR][cntD[ADR]]:=parD[list][i];
+ endfor
+ else::
+ cntD[ADR]:=cntD[ADR]+1;
+ comD[ADR][cntD[ADR]]:=_mk_bond;
+ parD[ADR][cntD[ADR]]:=list;
+ fi
+ elseif string list::
+ str_cnt:=str_cnt+1;
+ strD[str_cnt]:=list;
+ cntD[ADR]:=cntD[ADR]+1;
+ comD[ADR][cntD[ADR]]:=_set_atom;
+ parD[ADR][cntD[ADR]]:=str_cnt;
+ fi
+ else::
+ message "unknown command in "AND decimal(list_cnt);
+ fi
+ endfor
+ endgroup
+enddef;
+%-------------------------------------------------------------------------------------------------
+vardef '''(text TXT)=
+ sub_int:=sub_int+1;
+ cntD[sub_int]:=0;
+ for list==TXT::
+ if known list::
+ if numeric list::
+ if list==_nop::
+ message "unknown command in "AND decimal(sub_int);
+ else::
+ cntD[sub_int]:=cntD[sub_int]+1;
+ comD[sub_int][cntD[sub_int]]:=_numeric;
+ parD[sub_int][cntD[sub_int]]:=list;
+ fi
+ elseif pair list::
+ cntD[sub_int]:=cntD[sub_int]+1;
+ comD[sub_int][cntD[sub_int]]:=xpart(list);
+ parD[sub_int][cntD[sub_int]]:=ypart(list);
+ fi
+ else::
+ message "unknown command in "AND decimal(sub_int);
+ fi
+ endfor
+ sub_int %------- Retern value -------
+enddef;
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+def fuse_ring(expr a,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 fuse_ring_bonds(expr a,b,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 fuse_ring_rate(expr a,b,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,b) =
+ sub_int:=sub_int+1;
+ cntD[sub_int]:=0;
+ if known b:: if numeric b::
+ if (b>=si)and(b<=bd_):: if b==dl:: PP(a,_dl) else:: PX(a)(_set_line,b) fi
+ elseif (b>=?3)and(b<=?20)::
+ if a>=sub_int_start:: for i==1 upto cntD[a]:: fuse_ring(parD[a][i],b-?3+3) endfor
+ else:: fuse_ring(a,b-?3+3)
+ fi
+ elseif b==Ph1:: fuse_ring(a,6) PA(_dl,-2) PA(_dl,-4)
+ elseif b==Ph2:: fuse_ring(a,6) PA(_dl,-1) PA(_dl,-3) PA(_dl,-5)
+ elseif b==_jump_at:: PA(_jp_bond,a)
+ elseif b==_connect_at:: PA(_cyc_sB,a)
+ elseif comD[b][1]==_fuse::
+ if comD[b][2]<=6:: fuse_ring_bonds(a,parD[b][1],comD[b][2])
+ elseif (comD[b][2]>=11)and(comD[b][2]<=15):: fuse_ring_rate(a,parD[b][1],comD[b][2])
+ fi
+ fi
+ elseif color b:: color_list[incr cntC]:=b; PX(a)(_set_colorB,cntC)
+ fi fi
+ sub_int %------- Retern value -------
+enddef;
+%-------------------------------------------------------------------------------------------------
+vardef change_atom(expr a,b)=
+ sub_int:=sub_int+1;
+ cntD[sub_int]:=0;
+ if known b:: if numeric b::
+ if (b>=H)and(b<=U):: if b==N:: PP(a,_N) elseif b==O:: PP(a,_O) elseif b==S:: PP(a,_S)
+ else:: PX(a)(_chg_atom,b)
+ fi
+ ef b==NH:: PA(_set_clr,1) PP(a,_N) PX(a)(_postH,H) PA(_set_clr,0)
+ ef b==_jump_at:: PA(_jp_atom,a)
+ ef b==_connect_at:: PA(_cyc,a)
+ fi
+ ef pair b::
+ if xpart(b)==_set_and::
+ PA(_set_and,ypart(b)) PA(_chg_charge,a)
+ else::
+ PA(_set_clr,1) PX(a)(xpart(b),ypart(b)) PA(_set_clr,0)
+ fi
+ ef color b:: color_list[incr cntC]:=b; PX(a)(_set_colorA,cntC)
+ fi fi
+ sub_int %------- Retern value -------
+enddef;
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+def puts(expr POS)(expr STR)=
+ begingroup
+ save pA,sA,bA,nB,nC;
+ pair pA;
+ string sA;
+ picture bA;
+ pA:=POS;
+ nB:=defaultscale*defaultsize;
+ nC:=0;
+ %------------------------------------------------------------------------------------------------
+ for i=0 upto length(STR)-1:
+ sA:=pic_c(i,STR);
+ if sw_label_emu=1:
+ if sA="_": nC:=iif(nC=-0.5,0,-0.5);
+ elseif sA="^": nC:=iif(nC= 0.5,0, 0.5);
+ else:
+ if defaultfont="draw":
+ draw_char(sA,pA+(0,nB*nC),nB,ratio_thickness_char*defaultscale*defaultsize,0);
+ pA:=pA+(nB*tbl_char_wd[ASCII(sA)],0);
+ else:
+ bA:=sA infont defaultfont scaled defaultscale;
+ addto currentpicture also bA shifted (pA+(0,nB*nC));
+ pA:=pA+(lrcorner bA-llcorner bA);
+ fi
+ fi
+ else:
+ draw_char(sA,pA,nB,ratio_thickness_char*defaultscale*defaultsize,0);
+ pA:=pA+(nB*tbl_char_wd[ASCII(sA)],0);
+ fi
+ endfor
+ endgroup;
+enddef;
+%==================================================================================================
+def ext_setup=
+ pickup pencircle scaled ext_defaultline;
+ dotlabeldiam:=3bp;
+ labeloffset:=3bp;
+ save em;
+ em=defaultscale*defaultsize;
+ if (f_MP=0)or(sw_label_emu=1):
+ save label,dotlabel;
+ def label = label_emu enddef;
+ def dotlabel = dotlabel_emu enddef;
+ else:
+ defaultfont:="uhvr8r";
+ 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 add_mole(text TXT)=
+ begingroup
+ save w,h,n,l,p,am,aw,A,B,plus,minus,lonepair,**,<<,/*;
+ numeric A[]dir,B[]up,A[]ang,B[]ang;
+ pair p[],A[],B[],B[]s,B[]e,B[]m,A[]up,A[]left,A[]right,A[]down,
+ B[]up,B[]left,B[]right,B[]down;
+ path B[];
+ ext_setup;
+ def plus = circled_plus_add enddef;
+ def minus = circled_minus_add enddef;
+ def lonepair = lone_pair_add enddef;
+ let ** = scaled;
+ let << = rotated;
+ primarydef a /* b = point b of a enddef;
+ w:=mol_wd; h:=mol_ht; l:=blength; aw:=atom_wd;
+ p0:=(minX,minY);
+ An:=cntA; Bn:=cntB;
+ lonepairdiam:=0.3aw;
+ lonepairspace:=.7aw;
+ circlediam:=.6aw;
+ circlepen:=.2bp;
+ for i=1 upto An:
+ A[i]:=posA[i]; A[i]ang:=angX[i]; A[i]up:=dir(angX[i]);
+ A[i]left:=dir(angX[i]+90); A[i]right:=dir(angX[i]-90); A[i]down:=dir(angX[i]+180);
+ endfor
+ for i=1 upto Bn:
+ B[i]s:=posA[sB[i]]; B[i]e:=posA[eB[i]]; B[i]m:=0.5[B[i]s,B[i]e];
+ B[i]:=B[i]s--B[i]e;
+ B[i]ang:=angB[i]; B[i]up:=dir(angB[i]);
+ B[i]down:=dir(angB[i]+180); B[i]left:=dir(angB[i]+90); B[i]right:=dir(angB[i]-90);
+ endfor
+ TXT addto mol_stru[cntM] also currentpicture; clearit;
+ endgroup;
+enddef;
+%--------------------------------------------------------------------------------------------------
+def ext_font(text TXT)=
+ begingroup
+ save w,h,wd,ht,n,p,am,aw;
+ pair p[];
+ ext_setup;
+ w:=xpart(fsize);
+ h:=ypart(fsize);
+ w0:=w-2margin_lr;
+ h0:=h-2margin_tb;
+ p0:=(margin_lr,margin_tb);
+ 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;
+%--------------------------------------------------------------------------------------------------
+vardef image_emu(text TXT) =
+ save_picture:=currentpicture;
+ currentpicture:=nullpicture;
+ TXT;
+ temp_picture:=currentpicture;
+ currentpicture:=save_picture;
+ temp_picture
+enddef;
+%--------------------------------------------------------------------------------------------------
+vardef scan_picture(expr PIC,SD)=
+ save save_pic,nA,nB,nC,nD,nE,nS,iw,erase_h,erase_v;
+ picture save_pic;
+ path erase_h,erase_v;
+ nD:=0.2bp;
+ if (SD=1)or(SD=3): nS:=-max_labelsize; nE:=max_labelsize; nB:=nD; nC:=-nD;
+ elseif (SD=2)or(SD=4): nS:=max_labelsize; nE:=-max_labelsize; nB:=-nD; nC:=0;
+ fi
+ if (SD=1)or(SD=2):
+ erase_h:=unitsquare xscaled 2max_labelsize yscaled nD shifted (-max_labelsize,nC);
+ elseif (SD=3)or(SD=4):
+ erase_v:=unitsquare xscaled nD yscaled 2max_labelsize shifted (nC,-max_labelsize);
+ fi
+ save_pic:=currentpicture;
+ currentpicture:=PIC;
+ erase fill unitsquare scaled nD shifted (-max_labelsize,-max_labelsize);
+ iw:=totalweight currentpicture;
+ if iw>=0:
+ for i=nS step nB until nE:
+ if (SD=1)or(SD=2): erase fill erase_h shifted (0,i);
+ elseif (SD=3)or(SD=4): erase fill erase_v shifted (i,0);
+ fi
+ nA:=i;
+ exitif (totalweight currentpicture)<iw;
+ endfor
+ else:
+ nA:=0;
+ fi
+ currentpicture:=save_pic;
+ nA
+enddef;
+%--------------------------------------------------------------------------------------------------
+vardef llcorner_emu(expr b)= (scan_picture(b,3),scan_picture(b,1)) enddef;
+vardef lrcorner_emu(expr b)= (scan_picture(b,4),scan_picture(b,1)) enddef;
+vardef urcorner_emu(expr b)= (scan_picture(b,4),scan_picture(b,2)) enddef;
+vardef ulcorner_emu(expr b)= (scan_picture(b,3),scan_picture(b,2)) enddef;
+%--------------------------------------------------------------------------------------------------
+vardef circled_plus_add=
+ save nA,nB;
+ nA:=circlediam;
+ nB:=circlepen;
+ image(draw fullcircle scaled nA withpen pencircle scaled nB;
+ draw (-.5nA,0)--(.5nA,0) withpen pencircle scaled nB;
+ draw (0,-.5nA)--(0,.5nA) withpen pencircle scaled nB;
+ )
+enddef;
+%--------------------------------------------------------------------
+vardef circled_minus_add=
+ save nA,nB;
+ nA:=circlediam;
+ nB:=circlepen;
+ image(draw fullcircle scaled nA withpen pencircle scaled nB;
+ draw (-.5nA,0)--(.5nA,0) withpen pencircle scaled nB;
+ )
+enddef;
+%--------------------------------------------------------------------
+vardef lone_pair_add expr ANG=
+ save nA,nB;
+ nA:=lonepairdiam;
+ nB:=lonepairspace;
+ image(draw (0,0) withpen pencircle scaled nA;
+ draw ((0,nB) rotated ANG) withpen pencircle scaled nA;)
+enddef;
+%--------------------------------------------------------------------------------------------------
+vardef label_emu@#(expr OBJ,POS) = %% modified 'thelabel@#(expr s,z)' of plain.mp
+ save oft,fx,fy,wds,sC,bA,pA,pB,pC,pD;
+ pair oft,oft.lft,oft.rt,oft.top,oft.bot,oft.ulft,oft.llft,oft.urt,oft.lrt,pA,pB,pC,pD;
+ string sC;
+ picture bA;
+ wds:=0;
+ %---------------------------------------------------------------
+ if string OBJ:
+ for i=0 upto length(OBJ)-1:
+ sC:=pic_c(i,OBJ);
+ 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:
+ bA:=sC infont defaultfont scaled defaultscale;
+ wds:=wds+xpart(lrcorner bA-llcorner bA);
+ fi
+ fi
+ endfor
+ fi
+ %---------------------------------------------------------------
+ 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;
+ %---------------------------------------------------------------
+ if string OBJ:
+ puts(POS+(labeloffset*oft@#)-(wds*fx@#,defaultscale*defaultsize*fy@#))(OBJ);
+ elseif picture OBJ:
+ pA:=llcorner(OBJ);
+ pB:=urcorner(OBJ);
+ pC:=.5(pB-pA) xscaled xpart(oft@#) yscaled ypart(oft@#);
+ pD:=.5(pA+pB);
+ addto currentpicture also OBJ shifted (POS+labeloffset*oft@#+pC-pD);
+ fi
+enddef;
+%-------------------------------------------------------------------------------------------------
+vardef dotlabel_emu@#(expr OBJ,POS)=
+ label_emu@#(OBJ,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:=(0,0)--(ahlength,-(sind 0.5ahangle)*ahlength)--
+ (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 a,b)=
+ if a>=sub_int_start:: for i==1 upto cntD[a]:: sub_add(b,parD[a][i]) endfor else:: sub_add(b,a) 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(_set_adr,parD[c][i]) sub_add(a,b)
+ else:: sub_add(comD[c][i],parD[c][i]) fi
+ endfor
+ else:: sub_add(_set_adr,c) sub_add(a,b)
+ fi
+enddef;
+%=================================================================================================
+def MCat(expr FW,FH)(text TXT)=
+ save_mposition:=mposition;
+ mposition:=(FW,FH);
+ MC(TXT)
+ mposition:=save_mposition;
+enddef;
+%-------------------------------------------------------------------------------------------------
+def MC(text TXT)=
+ 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,tempA,
+ maxX,maxY,f_char,ps_adr,ps_com,sA,sC,sD,pA,pB,factor,m_wd,m_ht,
+ op_com,op_par,op_cnt,crR,colorA,colorB,PA,PO,PP,PX,defaultsize,defaultscale;
+ %-----------------------------------------------------------------------------------------------
+ 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[];
+ string sA,sC,sD;
+ pair pA,pB;
+ %-----------------------------------------------------------------------------------------------
+ if (sw_numberA>=1)or(sw_numberB>=1): ratio_atom_bond:=0.25; fi
+ if (sw_expand=1)or(sw_mol_out>=1): expand_set; fi
+ sub_usr:=sub_usr_start;
+ sub_int:=sub_int_start;
+ cntA:=cntB:=cntP:=cntC:=0; strD[0]:=""; str_cnt:=2000; crR:=-ratio_chain_ring;
+ %-----------------------------------------------------------------------------------------------
+ font_wd:=xpart(fsize);
+ font_ht:=ypart(fsize);
+ margin_lr:=xpart(fmargin);
+ margin_tb:=ypart(fmargin);
+ %===============================================================================================
+ ''(0)(TXT,(_term,0));
+ %-----------------------------------------------------------------------------------------------
+ proc_bond_atom(1);
+ %-----------------------------------------------------------------------------------------------
+ if (cntP>0)and(sw_subst_off=0): post_get(1); fi
+ %-----------------------------------------------------------------------------------------------
+ char_use_check;
+ %-scaling---------------------------------------------------------------------------------------
+ if blength>1: blen:=blength; proc_size_setup; proc_skeleton; proc_scaling;
+ elseif blength>0:
+ blen:=font_wd*blength;
+ proc_size_setup; proc_skeleton; proc_scaling;
+ else:
+ blen:=3mm;
+ proc_size_setup;
+ if xpart(msize)<1: m_wd:=font_wd*xpart(msize); else: m_wd:=font_wd; fi
+ if ypart(msize)<1: m_ht:=font_ht*ypart(msize); else: m_ht:=font_ht; fi
+ for i=1 upto 6:
+ proc_skeleton; proc_scaling;
+ if (mol_ht/mol_wd)>(m_ht/m_wd):
+ if ypart(msize)>1: factor:=ypart(msize)/mol_ht;
+ else: factor:=((font_ht-2margin_tb)*ypart(msize))/mol_ht;
+ fi
+ else:
+ if xpart(msize)>1: factor:=xpart(msize)/mol_wd;
+ else: factor:=((font_wd-2margin_lr)*xpart(msize))/mol_wd;
+ fi
+ fi
+ exitif (factor>=1-eps)and(factor<=1+eps);
+ blen:=blen*factor;
+ proc_size_setup;
+ endfor
+ if blen>max_blength:
+ blen:=max_blength; proc_size_setup; proc_skeleton; proc_scaling;
+ fi
+ fi
+ %-draw atom--------------------------------------------------------------------------------------
+ if (sw_numberA=0)and(sw_numberB=0): for i=1 upto cntA: draw_atom(i); endfor fi
+ %-draw charge------------------------------------------------------------------------------------
+ for i=1 upto cntA:
+ if andA[i]<>0:
+ sA:=char(andA[i]); nA:=angX[i]+and_rot[i]; nC:=nA mod 90;
+ if numS[i]=0: nB:=.5atom_wd;
+ else: nB:=.85atom_wd+iif(nC<45,sind(nC),cosd(nC))*.5atom_wd;
+ fi
+ pA:=sfB(posA[i]-(.35atom_wd,.35atom_wd),nB,nA);
+ draw_char(sA,pA,atom_wd,bond_pen_wd*ratio_char_bond,0);
+ else: sA:="";
+ fi
+ nA:=length(strD[numS[i]]); sC:=substring(nA-3,nA-2) of strD[numS[i]];
+ if (sA="+")or(sC="+"): chargeA[i]:=1; ef (sA="-")or(sC="-"): chargeA[i]:=-1;
+ else: chargeA[i]:=0;
+ fi
+ endfor
+ %-draw bond-------------------------------------------------------------------------------------
+ for i=1 upto cntB: if lineB[i]<si_ : draw_bond(i); fi endfor
+ for i=1 upto cntB: if lineB[i]>=si_: draw_bond(i); fi endfor
+ %-atom numbering--------------------------------------------------------------------------------
+ if sw_numberA>=1:
+ for i=1 upto cntA:
+ if (i>=numberA_start)and(i<=numberA_end):
+ if sw_numberA=2: nA:=i-numberA_start+1;
+ elseif sw_numberA=3: nA:=iif(numberA_end<cntA,numberA_end-i+1,cntA-i+1);
+ else: nA:=i;
+ fi
+ erase fill unitsquare xscaled (.8atom_wd*length(decimal(nA)))
+ yscaled atom_wd shifted (posA[i]-(.5atom_wd,.5atom_wd));
+ defaultsize:=atom_wd; defaultscale:=1;
+ puts(posA[i]-(.5atom_wd,.5atom_wd))(decimal(nA));
+ fi
+ endfor
+ fi
+ %-bond numbering--------------------------------------------------------------------------------
+ if sw_numberB>=1:
+ for i=1 upto cntB:
+ if (i>=numberB_start)and(i<=numberB_end):
+ if sw_numberB=2: nB:=i-numberB_start+1;
+ elseif sw_numberB=3: nB:=iif(numberB_end<cntB,numberB_end-i+1,cntB-i+1);
+ else: nB:=i;
+ fi
+ erase fill unitsquare yscaled atom_wd xscaled (.8atom_wd*length(decimal(nB)))
+ shifted (.5[posA[sB[i]],posA[eB[i]]]-(.5atom_wd,.5atom_wd));
+ defaultsize:=atom_wd; defaultscale:=1;
+ puts(0.5[posA[sB[i]],posA[eB[i]]]-(.5atom_wd,.5atom_wd))(decimal(nB));
+ fi
+ endfor
+ fi
+ %-----------------------------------------------------------------------------------------------
+ if xpart(mposition)>1: sftX:=xpart(mposition)-minX;
+ else: sftX:=margin_lr-minX+(font_wd-mol_wd-2margin_lr)*xpart(mposition);
+ fi
+ if ypart(mposition)>1: sftY:=ypart(mposition)-minY;
+ else: sftY:=margin_tb-minY+(font_ht-mol_ht-2margin_tb)*ypart(mposition);
+ fi
+ cntM:=cntM+1;
+ posM[0][cntM]:=(sftX,sftY);
+ posM[1][cntM]:=(minX+sftX,minY+sftY);
+ posM[2][cntM]:=(maxX+sftX,maxY+sftY);
+ wdM[cntM]:=mol_wd;
+ htM[cntM]:=mol_ht;
+ mol_stru[cntM]:=currentpicture;
+ clearit;
+ endgroup;
+ if ((sw_aux_out=1)or(sw_rep_out=1)or(sw_mol_out>=1)or(sw_calc=1))and(f_MP=1): proc_calc; 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 post_put=
+ begingroup
+ save nA;
+ if f_at=1: nA:=getA(adrT); check_adrA(nA); else: nA:=cntA+1; fi
+ cntP:=cntP+1; ps_adr[cntP]:=nA; ps_com[cntP]:=par; 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
+ endgroup
+enddef;
+%-------------------------------------------------------------------------------------------------
+def post_get(expr n)=
+ 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: post_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 withpen pensquare scaled PN;
+enddef;
+%-------------------------------------------------------------------------------------------------
+def proc_size_setup=
+ if (blen*ratio_atom_bond+offset_atom)<.8blen:
+ atom_wd:=blen*ratio_atom_bond+offset_atom;
+ else:
+ atom_wd:=.8blen; ratio_chain_ring:= .5;
+ fi
+ wedge_wd:= blen*ratio_wedge_bond+offset_wedge;
+ zebra_gap:= blen*ratio_zebragap_bond+offset_zebra_gap;
+ bondgap:= blen*ratio_bondgap_bond+offset_bond_gap;
+ bond_pen_wd:= blen*ratio_thickness_bond+offset_thickness;
+enddef;
+%-------------------------------------------------------------------------------------------------
+def proc_scaling=
+ begingroup
+ save nU,nD,nP,nL,nR,xpos,ypos;
+ minX:=minY:=4095;
+ maxX:=maxY:=-4095;
+ for i=1 upto cntA:
+ xpos:=xpart(posA[i]);
+ ypos:=ypart(posA[i]);
+ if numS[i]<>0:
+ nU:=nD:=nP:=nL:=nR:=0;
+ for j=0 upto length(strD[numS[i]])-1:
+ sA:=pic_c(j,strD[numS[i]]);
+ if (sA="^"): nU:=.5atom_wd;
+ elseif (sA="_"): nD:=.5atom_wd;
+ elseif (sA<>"{")and(sA<>"}"): nP:=nP+atom_wd*tbl_char_wd[ASCII(sA)];
+ fi
+ endfor
+ if (angX[i]<=90)or(angX[i]>=270): nR:=nP; else: nL:=nP; fi
+ if (xpos-nL+.5atom_wd)<minX: minX:=xpos-nL+.5atom_wd; fi
+ if (xpos+nR-.5atom_wd)>maxX: maxX:=xpos+nR-.5atom_wd; fi
+ if (ypos-nD-.5atom_wd)<minY: minY:=ypos-nD-.5atom_wd; fi
+ if (ypos+nU+.5atom_wd)>maxY: maxY:=ypos+nU+.5atom_wd; fi
+ else: if xpos<minX: minX:=xpos; fi if xpos>maxX: maxX:=xpos; fi
+ if ypos<minY: minY:=ypos; fi if ypos>maxY: maxY:=ypos; fi
+ fi
+ endfor
+ mol_wd:=maxX-minX; mol_ht:=maxY-minY;
+ endgroup
+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; andAT:=0;
+ for i=0 upto 5: stkA[i]:=stkB[i]:=0; endfor
+ %-----------------------------------------------------------------------------------------------
+ for i=n upto cntD[0]:
+ nC:=comD[0][i]; par:=parD[0][i];
+ if nC=_push:
+ if par=1: stkL[adrS]:=bondL; adrS:=adrS+1; stkA[adrS]:=adrA:=cntA; stkB[adrS]:=adrB:=cntB;
+ elseif par=0: temp_len:=bondL;
+ elseif par=2: stkA[adrS+1]:=cntA; stkB[adrS+1]:=cntB;
+ fi
+ ef nC=_pop: if par=1: adrS:=adrS-1; adrA:=stkA[adrS]; adrB:=stkB[adrS]; bondL:=stkL[adrS];
+ ef par=0: bondL:=temp_len;
+ ef par=2: stkA[adrS+1]:=0;
+ fi
+ ef nC=_mk_bond: if (par=0)and(rotT<>0): rotT:=0; fi add_atom;
+ ef nC=_set_adr: adrT:=par;
+ ef nC=_set_atom: strAT:=par;
+ ef nC=_postA: post_put;
+ ef nC=_postB: lineT:=dm; post_put;
+ ef nC=_postC: lineT:=wf; post_put;
+ ef nC=_postD: lineT:=zf; post_put;
+ ef nC=_postE: lineT:=nl; post_put;
+ ef nC=_postF: lineT:=0; post_put;
+ ef nC=_postG: lineT:=wv; post_put;
+ ef nC=_postH: lineT:=nl; lenT:=_size_a; post_put;
+ ef nC=_jp_bond: termA; tempB:=getB(par); check_adrB(tempB); sB[cntB+1]:=sB[tempB]; f_bra:=1;
+ ef nC=_jp_atom: termA; tempA:=getA(par); check_adrA(tempA); sB[cntB+1]:=tempA; f_bra:=1;
+ ef nC=_jp_atom_abs: sB[cntB+1]:=par; f_bra:=1; temp_cntB:=cntB;
+ ef nC=_chg_atom: numS[getA(adrT)]:=parD[par][1];
+ ef nC=_N: numS[getA(par)]:=parD[N][1];
+ ef nC=_O: numS[getA(par)]:=parD[O][1];
+ ef nC=_S: numS[getA(par)]:=parD[S][1];
+ ef nC=_chg_len: if par=_ring_len: bondL:=ringL;
+ ef par=0: if lenT<>crR: bondL:=lenT; else: if bondL<0: bondL:=1; fi fi
+ else: bondL:=par; fi
+ ef nC=_get_len: if par=0: if bondL=crR: bondL:=lenT; fi else: ringL:=lenB[getB(par)]; fi
+ ef nC=_tmp_len: lenT:=par;
+ ef nC=_set_line: lineB[getB(adrT)]:=par;
+ ef nC=_dl: lineB[getB(par)]:=dl;
+ ef nC=_mb: lineB[getB(-1)]:=par;
+ ef (nC=_chg_line)or(nC=_tmp_line): lineT:=par;
+ ef nC=_tmp_rot: rotT:=par;
+ ef nC=_cyc: f_end:=getA(par); check_adrA(f_end); add_atom;
+ ef nC=_cyc_eB: f_end:=eB[getB(par)]; add_atom;
+ ef nC=_cyc_sB: f_end:=sB[getB(par)]; add_atom;
+ ef nC=_chg_env: envB:=par;
+ ef nC=_tmp_env: envT:=par;
+ ef nC=_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
+ ef par=0: f_lineT:=f_rotT:=f_lenT:=f_envT:=rotT:=envT:=0; lineT:=si; lenT:=crR;
+ fi
+ ef nC=_term: termA;
+ ef nC=_set_colorA: colorA[getA(adrT)]:=par;
+ ef nC=_set_colorB: colorB[getB(adrT)]:=par;
+ ef nC=_set_and: andAT:=par;
+ ef nC=_chg_charge: andA[getA(par)]:=andAT; andAT:=0; if rotT<>0: and_rot[getA(par)]:=rotT; fi
+ else:
+ fi
+ endfor
+enddef;
+%-------------------------------------------------------------------------------------------------
+def add_atom=
+ cntB:=cntB+1;
+ lineB[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;
+ andA[cntA]:=andAT; andAT:=strAT:=and_rot[cntA]:=0;
+ if rotT<>0: and_rot[cntA]:=rotT; rotT:=0; fi
+ 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 check_adrA(expr n)=
+ if (n>iif(f_term=0,cntA+1,cntA))or(n<=0): errmessage("adrA=[ "&decimal(n)&" ]"); fi enddef;
+def check_adrB(expr n)= if (n>cntB)or(n<=0): errmessage("adrB=[ "&decimal(n)&" ]"); fi enddef;
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+def proc_skeleton=
+ begingroup
+ save posBs,posBe,nC;
+ pair posBs,posBe;
+ adrA:=adrB:=cntA:=cntB:=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; angT:=mangle;
+ angA[0]:=angB[0]:=angX[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]:
+ nC:=comD[0][i]; par:=parD[0][i];
+ if nC=_push: if par=1: stkM[adrS]:=envB; adrS:=adrS+1; stkA[adrS]:=adrA:=cntA;
+ stkB[adrS]:=adrB:=cntB;
+ ef par=0: temp_len:=bondL;
+ ef par=2: stkA[adrS+1]:=cntA; stkB[adrS+1]:=cntB;
+ fi
+ ef nC=_pop: if par=1: adrS:=adrS-1; adrA:=stkA[adrS]; adrB:=stkB[adrS]; envB:=stkM[adrS];
+ ef par=0: temp_len:=bondL;
+ ef par=2: stkA[adrS+1]:=0;
+ fi
+ ef nC=_jp_bond: termB; tempB:=getB(par); posBs:=posA[sB[tempB]];
+ angT:=angB[tempB]; f_bra:=1; rotT:=0;
+ ef nC=_jp_atom: termB; adrT:=getA(par); posBs:=posA[adrT];
+ angT:=angX[adrT]; f_bra:=1; rotT:=0;
+ ef nC=_jp_atom_abs: adrT:=par; posBs:=posA[adrT];
+ angT:=angX[adrT]; f_bra:=1; rotT:=0; temp_cntB:=cntB;
+ ef nC=_adj_ang: if (angT<40)or(angT>320): angT:=0;
+ ef angT<140: angT:=90; ef angT<220: angT:=180; else: angT:=270; fi
+ ef nC=_mk_bond: if (par=0)and(rotT<>0):par:=rotT; rotT:=0; fi add_bond(par);
+ ef nC=_rot_ang: angT:=(angT+par) mod 360;
+ ef nC=_tmp_rot: rotT:=par;
+ ef (nC>=_postA)and(nC<=_postH): rotT:=0;
+ ef nC=_chg_env: envB:=par;
+ ef nC=_tmp_env: envT:=par;
+ ef nC=_set_clr: f_at:=par; if par=0: lineT:=si; lenT:=crR; rotT:=envT:=0; fi
+ ef nC=_cyc: f_end:=1; proc_cyc(getA(par));
+ ef nC=_cyc_sB: f_end:=1; proc_cyc(sB[getB(par)]);
+ ef nC=_cyc_eB: f_end:=1; proc_cyc(eB[getB(par)]);
+ ef nC=_term: termB;
+ else:
+ fi
+ endfor
+ endgroup
+enddef;
+%-------------------------------------------------------------------------------------------------
+def add_bond(expr ROT)=
+ begingroup
+ save nA,nB;
+ if ROT=_arg_ang: nA:=proc_env(angT,envB); else: nA:=ROT; fi
+ if f_bra=0:
+ adrT:=cntA:=cntA+1; posA[cntA]:=posBs; angA[cntA]:=angT;
+ angX[cntA]:=(angT+nA/2+iif(nA>=0,-90,90)) mod 360;
+ 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];
+ if nA<0: nB:=glu_atom(adrT)+glu_atom(cntA+1); nA:=abs(nA);
+ else: nB:=0;
+ fi
+ posBe:=sfB(posBs,nA*blen+nB,angT);
+ fi
+ posA[cntA+1]:=posBe; f_term:=0;
+ else:
+ f_end:=0; f_term:=1;
+ fi
+ cntB:=cntB+1; posBs:=posBe;
+ endgroup
+enddef;
+%==================================================================================================
+vardef getA(expr ADR)=
+ if ADR>=0: stkA[adrS+1]+ADR ef ADR>=-999: cntA+ADR+1 else: stkA[adrS]+ADR+4095 fi
+enddef;
+%--------------------------------------------------------------------------------------------------
+vardef getB(expr ADR)=
+ if ADR>=1: stkB[adrS+1]+ADR ef ADR=0: tempB ef ADR>=-999: cntB+ADR+1 else: stkB[adrS]+ADR+4095 fi
+enddef;
+%--------------------------------------------------------------------------------------------------
+def termA=
+ if f_term=0:
+ if f_bra=0:
+ cntA:=cntA+1; numS[cntA]:=strAT; andAT:=strAT:=and_rot[cntA]:=andA[cntA]:=0;
+ if rotT<>0: and_rot[cntA]:=rotT; rotT:=0; fi
+ 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: cntA:=cntA+1; angX[cntA]:=angT mod 360; else:f_bra:=0; fi
+ f_term:=1;
+ fi
+enddef;
+%--------------------------------------------------------------------------------------------------
+def proc_cyc(expr ADR)= add_bond(angle(posA[ADR]-posBs)-angT); enddef;
+%--------------------------------------------------------------------------------------------------
+vardef glu_atom(expr NUM)=
+ save nB,nC;
+ if numS[NUM]<>0:
+ nB:=angT mod 90; nC:=0.5atom_wd;
+ (iif(nB<45,sind(nB),cosd(nB))*nC)++nC
+ else: 0
+ fi
+enddef;
+%--------------------------------------------------------------------------------------------------
+vardef proc_env(expr ANG,ENV)=
+ save nA,nCW,nCC;
+ nCC:=60; nCW:=-nCC;
+ nA:=(ANG mod 360);
+ if ENV>=sub_emb_start:
+ parD[ENV][cntB-temp_cntB]
+ else:
+ if ENV=hz: if nA=0:nCC ef nA<=90:nCW ef nA<=180:nCC ef nA<270:nCW else:nCC fi
+ ef ENV=vt: if nA=0:nCW ef nA<90:nCC ef nA<=180:nCW ef nA<=270:nCC else:nCW fi
+ ef (ENV>=-180)and(ENV<=180): ENV
+ fi
+ fi
+enddef;
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+def draw_atom(expr NUM)=
+ begingroup
+ save slen,f_wd,f_ht,r_ff,pA,pB,bA,sA,sB,dx,nA,nB,nC,nD;
+ string sA,sB;
+ pair pA,pB;
+ picture bA;
+ %----------------------------------------------------------------------------------------------
+ sA:=strD[numS[NUM]]; slen:=length(sA)-1;
+ nA:=angX[NUM]; dxA[NUM]:=dx:=iif((nA<=90)or(nA>=270),1,-1);
+ wdA[NUM]:=nC:=0; pB:=(0,0);
+ pA:=posA[NUM]-(.5atom_wd*dx,.5atom_wd);
+ if (atomfont<>"draw")and(f_MP=1):
+ bA:="C" infont atomfont;
+ r_ff:=atom_wd/(ypart(ulcorner bA)-ypart(llcorner bA));
+ fi
+ for i=0 upto slen:
+ if nC=0:
+ sB:=pic_c(i,sA);
+ if (dx=-1)and(sB="{"):
+ nD:=i+1; nC:=0; for j=nD upto slen: nC:=nC+1; exitif pic_c(j,sA)="}"; endfor
+ fi
+ else: nC:=nC-1; sB:=pic_c(nD+nC,sA);
+ fi
+ if sB="_": pB:=iif(pB=(0,0),(0,-.5atom_wd),(0,0));
+ elseif sB="^": pB:=iif(pB=(0,0),(0, .5atom_wd),(0,0));
+ elseif (sB<>"{")and(sB<>"}"):
+ if (atomfont<>"draw")and(f_MP=1):
+ bA:=sB infont atomfont;
+ f_wd:=(xpart(lrcorner bA)-xpart(llcorner bA))*r_ff;
+ f_ht:=(ypart(urcorner bA)-ypart(llcorner bA))*r_ff;
+ if dx=-1: pA:=pA-(f_wd,0); fi
+ addto currentpicture also bA scaled (r_ff*(1-2ratio_atomgap_atom))
+ shifted (pA+pB+(f_wd*ratio_atomgap_atom,f_ht*ratio_atomgap_atom)) Cp(colorA[NUM]);
+ if sw_aframe=1: draw_frame(pA+pB,f_wd,f_ht,thickness_aframe); fi
+ if dx=1: pA:=pA+(f_wd,0); fi
+ else:
+ f_wd:=atom_wd*tbl_char_wd[ASCII(sB)];
+ if dx=-1: pA:=pA-(f_wd,0); fi
+ draw_char(sB,pA+pB,atom_wd,bond_pen_wd*ratio_char_bond,NUM);
+ if sw_aframe=1: draw_frame(pA+pB,f_wd,atom_wd,thickness_aframe); fi
+ if dx=1: pA:=pA+(f_wd,0); fi
+ fi
+ wdA[NUM]:=wdA[NUM]+f_wd;
+ fi
+ endfor
+ endgroup
+enddef;
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+def draw_bond(expr NUM)=
+ begingroup
+ save ww,ap,am,ang,col,len,Ls,Le,nA,nB,nC,nD,nL,nS,nE,pA,zA,zL,wpcs;
+ pair pA,Ls,Le;
+ path zA,zL;
+ def wpcs expr n= withpen pencircle scaled n enddef;
+ %------------------------------------------------------------------------------------------------
+ nL:=lineB[NUM]; ang:=angB[NUM]; nS:=sB[NUM]; nE:=eB[NUM]; col:=colorB[NUM];
+ zL:=posA[nS]--posA[nE]; ww:=wedge_wd; ap:=ang+90; am:=ang-90;
+ %------------------------------------------------------------------------------------------------
+ if (numS[nS]=0)and(numS[nE]=0)or(sw_numberA=1)or(sw_numberB=1):
+ Ls:=posA[nS]; Le:=posA[nE]; pA:=(.1,.9);
+ ef numS[nS]=0: Le:=zL intersectionpoint frame_str(nE); Ls:=posA[nS]; pA:=(.15,1);
+ ef numS[nE]=0: Ls:=zL intersectionpoint frame_str(nS); Le:=posA[nE]; pA:=(0,.85);
+ else: Ls:=zL intersectionpoint frame_str(nS); Le:=zL intersectionpoint frame_str(nE); pA:=(0,1);
+ fi
+ zA:=Ls--Le; len:=length(Le-Ls);
+ %------------------------------------------------------------------------------------------------
+ pickup pencircle scaled bond_pen_wd;
+ if (nL=si)or(sw_single=1): draw zA Cp(col);
+ ef nL=dl: draw zA Cp(col); draw sfB(subpath pA of zA,bondgap,ap) Cp(col);
+ ef nL=dr: draw zA Cp(col); draw sfB(subpath pA of zA,bondgap,am) Cp(col);
+ ef nL=dm: draw sfB(zA,bondgap/1.75,ap) Cp(col); draw sfB(zA,bondgap/1.75,am) Cp(col);
+ ef nL=db: nA:=iif(((ang-angX[nS]) mod 360)<=180,ap,am);
+ draw zA Cp(col); draw sfB(subpath pA of zA,bondgap,nA) Cp(col);
+ ef nL=tm: draw zA Cp(col);draw sfB(zA,bondgap,ap) Cp(col); draw sfB(zA,bondgap,am) Cp(col);
+ ef nL=wf: fill Ls--sfB(Le,ww,am)--sfB(Le,ww,ap)--cycle Cp(col);
+ ef nL=wb: fill sfB(Ls,ww,am)--Le--sfB(Ls,ww,ap)--cycle Cp(col);
+ ef nL=bd: draw zA withpen penrazor rotated ap scaled bondgap Cp(col);
+ ef nL=bz: bz_put(sfB(Ls,ww,ap),sfB(Le,ww,ap),sfB(Ls,ww,am),sfB(Le,ww,am));
+ ef nL=zf: wz_put(Ls,sfB(Le,ww,ap),sfB(Le,ww,am));
+ ef nL=zb: wz_put(Le,sfB(Ls,ww,am),sfB(Ls,ww,ap));
+ ef nL=dt: for i=0 step .75zebra_gap/len until 1: drawdot i[Ls,Le] Cp(col); endfor
+ ef nL=wv: nA:=3bond_pen_wd; nB:=len/nA;
+ draw Le for i=1 upto nB:
+ ..controls(((i-.5)/nB)[sfB(Le,nA,iif(odd(i),ap,am)),sfB(Ls,nA,iif(odd(i),ap,am))])
+ ..(i/nB)[Le,Ls] endfor ..Ls Cp(col);
+ ef nL=vf: draw zA Cp(col);draw sfB(Le,bondgap,ang-150)--Le--sfB(Le,bondgap,ang+150) Cp(col);
+ ef nL=vb: draw zA Cp(col);draw sfB(Ls,bondgap,ang-30)--Ls--sfB(Ls,bondgap,ang+30) Cp(col);
+ ef nL=si_: erase draw subpath (0.15,0.85) of zA wpcs 0.8bondgap; draw zA Cp(col);
+ ef nL=wf_: erase draw subpath (0.15,0.85) of (Ls--sfB(Le,ww,am)) wpcs 0.8bondgap;
+ erase draw subpath (0.15,0.85) of (Ls--sfB(Le,ww,ap)) wpcs 0.8bondgap;
+ fill Ls--sfB(Le,ww,am)--sfB(Le,ww,ap)--cycle Cp(col);
+ ef nL=wb_: erase draw subpath (0.15,0.85) of (sfB(Ls,ww,am)--Le) wpcs 0.8bondgap;
+ erase draw subpath (0.15,0.85) of (sfB(Ls,ww,ap)--Le) wpcs 0.8bondgap;
+ fill sfB(Ls,ww,am)--Le--sfB(Ls,ww,ap)--cycle Cp(col);
+ ef nL=bd_: erase draw subpath(0.15,0.85) of zA wpcs 1.6bondgap;
+ draw zA withpen penrazor rotated ap scaled bondgap Cp(col);
+ fi
+ endgroup
+enddef;
+%------------------------------------------------------------------------------------------------
+def wz_put(expr PA,PB,PD)=
+ for i=0 upto len/zebra_gap:
+ nA:=zebra_gap*i/len; nD:=(zebra_gap*i+ratio_zebra_black*zebra_gap)/len;
+ if nD>((len-zebra_gap)/len): nD:=1; fi
+ fill nA[PB,PA]--nA[PD,PA]--nD[PD,PA]--nD[PB,PA]--cycle Cp(col);
+ endfor
+enddef;
+%------------------------------------------------------------------------------------------------
+def bz_put(expr PA,PB,PC,PD)=
+ for i=0 upto len/zebra_gap:
+ nA:=zebra_gap*i/len; nD:=(zebra_gap*i+ratio_zebra_black*zebra_gap)/len;
+ fill nA[PB,PA]--nA[PD,PC]--nD[PD,PC]--nD[PB,PA]--cycle Cp(col);
+ endfor
+enddef;
+%------------------------------------------------------------------------------------------------
+vardef frame_str(expr NUM)=
+ save nA,nB;
+ nA:=1.12atom_wd; nB:=wdA[NUM]+.12atom_wd;
+ ((0,0)--(nB,0)--(nB,nA)--(0,nA)--cycle) shifted
+ (posA[NUM]-(.5nA+iif((dxA[NUM]=-1)and(wdA[NUM]>atom_wd),nB-nA,0),.5nA))
+enddef;
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+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;
+%-------------------------------------------------------------------------------------------------
+sub_usr:=sub_emb_start;
+%-------------------------------------------------------------------------------------------------
+lr:='(60 for i==1 upto 10:: ,-60,60 endfor); rl:='(-60,lr);
+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:=!x2:='(!,!); Bu:=!x3:='(!,!,!);
+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");S:='("S");P:='("P");F:='("F");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");
+H[1]:='("{H^+^}");H[-1]:='("{H^-^}");C[1]:='("{C^+^}");C[-1]:='("{C^-^}");
+O[1]:='("{O^+^}");O[-1]:='("{O^-^}");N[1]:='("{N^+^}");N[-1]:='("{N^-^}");
+S[1]:='("{S^+^}");S[-1]:='("{S^-^}");P[1]:='("{P^+^}");P[-1]:='("{P^-^}");
+Li[1]:='("{Li^+^}"); Na[1]:='("{Na^+^}"); Cl[-1]:='("{Cl^-^}"); Br[-1]:='("{Br^-^}");
+%-------------------------------------------------------------------------------------------------
+R:='("R"); R1:='("{R^1^}"); R2:='("{R^2^}"); R3:='("{R^3^}"); R4:='("R^4^"); R5:='("{R^5^}");
+%-------------------------------------------------------------------------------------------------
+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_}"); NH:='(N,(_postE,H));
+NMe:=N!:='(N,/Me); iPr:=Me!:='(/Me,60); tBu:='(/Me,/Me^60,60);
+SO:='(S,//O); SOO :='(S,//O^-35,//O^35);
+OMe:=O!:='(O,!); OEt:=O!2:='(O,!x2); OPr:=O!3:='(O,!x3); OiPr:=OMe!:='(O,!,iPr);
+SMe:=S!:='(S,!); SEt:=S!2:='(S,!x2); SPr:=S!3:='(S,!x3); SiPr:=SMe!:='(S,!,iPr);
+COO:='(//O,!,O); COOMe:=COO!:='(COO,!); COOEt:=COO!2:='(COO,!x2); COOiPr:=COOMe!:='(COO,!,iPr);
+COOPr:=COO!3:='(COO,!x3); COOtBu:='(COO,!,tBu); COMe:=CO!:='(//O,!); COEt:=CO!2:='(//O,!x2);
+OCOMe:=OCO!:='(O,!,//O,!); NMeMe:=NMe!:='(N!,!); NHCOMe:=NHCO!:='(NH,!,//O,!);
+NHiPr:=NHMe!:='(NH,!,iPr); NHtBu:='(NH,!,tBu); NHMe:=NH!:='(NH,!); NHEt:=NH!2:='(NH,!x2);
+!NH!:='(!,NH,!); !CO!:='(!,//O,!); !OH:='(!,OH); !SH:='(!,SH); !NH2:='(!,NH2); !OMe:=!O!:='(!,OMe);
+!COOH:='(!,COOH); !CH3:='(!,CH3); !CN:='(!,CN); !iPr:=!Me!:='(!,iPr); !tBu:='(!,tBu); !Ph:='(!,Ph);
+!CHO:='(!,CHO); !NO2:='(!,NO2); !Cl:='(!,Cl); !F:='(!,F);
+!?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);
+%==================================================================================================
+init_par(parameter_list);
+%--------------------------------------------------------------------------------------------------
+%%%%%%message "count of sub_usr =" & decimal(sub_usr);
+%--------------------------------------------------------------------------------------------------
+def expand_set=
+ CH3:='(/H,/H^60,60,H); NH:='(N,/H); NH2:='(N,/H,60,H); NO2:='(N,//O,60~dm,O); OH:='(O,!,H);
+ CHO:='(//O,!,H); COOH:='(//O,!,O,!,H); CN:='(!~tm,N); SH:='(S,!,H); !CH3:='(!,CH3); !OH:='(!,OH);
+ !NH2:='(!,NH2); !CHO:='(!,CHO); !COOH:='(!,COOH); !CN:='(!,CN); !SH:='(!,SH); !NO2:='(!,NO2);
+enddef;
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+def char_size_set(expr WD)(expr HT)(expr STR)=
+ for j=0 upto length(STR)-1:
+ nA:=ASCII(pic_c(j,STR));
+ tbl_char_wd[nA]:=WD;
+ tbl_char_ht[nA]:=HT;
+ endfor
+enddef;
+%-------------------------------------------------------------------------------------------------
+char_size_set( 1)( 1)("CGHMNOQW");
+char_size_set( .9)( 1)("ABDFIJKPRSTUVXY/><#\%@");
+char_size_set( .8)( 1)("ELZ&");
+char_size_set( .7)( 1)(" ()[]0123456789nh=tfg?~");
+char_size_set( .7)( .9)("$");
+char_size_set( .7)( .7)("-+*");
+char_size_set(.45)(.95)("l");
+char_size_set(.75)( .8)("opq");
+char_size_set( .8)( .8)("e");
+char_size_set( .9)( .8)("wm");
+char_size_set( .7)( .8)("abdcksuvrxyz");
+char_size_set(.35)( .9)("i");
+char_size_set( .5)( .9)("j");
+char_size_set(.35)( 1)("!|");
+char_size_set( .4)( 1)(".,:;'`^");
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+def draw_char(expr CHR,POS,WD,PEN,NUM)=
+begingroup
+save Z,aW,aH,fW,fH,hW,hW,hH,fP,hP,zO,zOh,pos,dw,dwh,dwv,cdw,ppcs,sbp,sC;
+path zO,zOh,zOa;
+string sC;
+pair Z[],pos;
+%-------------------------------------------------------------------------------------------------
+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;
+%-------------------------------------------------------------------------------------------------
+sC:=CHR; fP:=PEN; hP:=0.5fP;
+aW:=WD*tbl_char_wd[ASCII(sC)]*(1-2ratio_atomgap_atom);
+aH:=WD*tbl_char_ht[ASCII(sC)]*(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);
+Z22:=(fW,fH); Z23:=(hW,fW);
+zO:=Z10..(.8aW,fH-.5hP)..tension 1.5..(.2aW,fH-.5hP)..Z09..
+ (.2aW,1.5hP)..tension 1.5..(.8aW,1.5hP)..cycle;
+zOh:=(hP,.25aH)..Z19..(fW,.25aH)..Z20..cycle;
+zOa:=(hP,.35aH)..(hW,hP)..(fW,.35aH)..(hW,.7aH)..cycle;
+%-------------------------------------------------------------------------------------------------
+ppcs fP;
+if sC="A": dwvs(1.14) Z02--Z06--Z05; dw .33[Z02,Z06]--.33[Z05,Z06];
+ef sC="B": dw Z13--Z14{right}..(.9fH,.75aH)..{left}Z20--Z09--Z20{right}..(.9fH,.25aH)..
+ {left}Z19--Z03; dwv Z02--Z18;
+ef sC="C": cdw sbp(.05,.95)zO;
+ef sC="D": dw Z13--Z14..Z10..Z19--Z03; dwv Z02--Z18;
+ef sC="E": pickup pensquare scaled fP; dw Z21--Z03--Z13--Z22; dw Z09--Z10;
+ef sC="F": dwh Z12--Z16; dwh (0,.45aH)--(fW,.45aH); dw Z02--Z13;
+ef sC="G": cdw sbp(.06,.97)zO; dwh bot Z20-- bot Z17;
+ef sC="H": dwv Z02--Z18; dw Z09--Z10; dwv Z05--Z15;
+ef sC="I": dwv Z19--Z14; dwh (hW-fP,hP)--(hW+fP,hP); dwh (hW-fP,fH)--(hW+fP,fH);
+ef sC="J": cdw Z09..(hP,.4aH){down}..{right}Z19{right}..{up}(fW,.4aH)..Z15;
+ef sC="K": cdw Z02--Z18; cdw .35[.45[Z02,Z18],Z16]--Z05; cdw .35[Z02,Z18]--Z16;
+ef sC="L": dwh Z04--Z01; dwv Z02--Z18;
+ef sC="M": dwv Z02--Z18; dwvs(1.14) Z18--Z19--Z15; dwv Z15--Z05;
+ef sC="N": dwv Z02--Z18; dwv Z05--Z15; dwvs(1.4) (1.4hP,aH)--(aW-1.4hP,0);
+ef sC="O": dw zO;
+ef sC="P": dwv Z02--Z18; dw Z13--(.65aW,fH){right}..(fW,.7aH)..{left}(.65aW,.44aH)..(hP,.44aH);
+ef sC="Q": dw zO; dw (.6aW,.4aH)--Z05;
+ef sC="R": dwv Z02--Z18; dw Z13--(.65aW,fH){right}..(fW,.7aH)..{left}(.65aW,.44aH)..(hP,.44aH);
+ cdw Z05{up}..{left}(hW,.44aH);
+ef sC="S": cdw sbp(.05,.45)zO; cdw sbp(.55,.95)zO; dw (fW,.3aH){up}..{up}(hP,.7aH);
+ef sC="T": dwh Z12--Z16; dwv .5[Z12,Z16]--Z07;
+ef sC="U": cdw Z18..Z09{down}..{right}Z19{right}..{up}Z10..Z15;
+ef sC="U": cdw Z18..(hP,.4fH){down}..{right}Z19{right}..{up}(fW,.4fH)..Z15;
+ef sC="V": dwvs(1.2) Z18--Z07--Z15;
+ef sC="W": dwvs(1.08) Z18--(.25aW,0)--Z06--(.75aW,0)--Z15;
+ef sC="X": dwvs(1.4) Z18..Z05; dwvs(1.4) Z02..Z15;
+ef sC="Y": dwvs(1.2) Z18--Z20--Z15; dwv Z20--Z07;
+ef sC="Z": dwh Z12--Z16; dwvs(1.4) (1.4hP,fP)--(aW-1.4hP,aH-fP); dwh Z01--Z04;
+ef sC="a": dw Z19..Z10..Z14..Z09..cycle; dwv Z05--Z15;
+ef sC="b": dw Z19..Z10..Z11..Z09..cycle; dwv Z02--(hP,1.3aH)
+ef sC="c": cdw sbp(.06,.94)Z10..Z14..Z09..Z19..cycle;
+ef sC="d": dw Z19..Z10..Z11..Z09..cycle; dwv Z05--(fW,1.3aH);
+ef sC="e": cdw sbp(0,.92)Z10..Z14..Z09..Z19..cycle; dw Z10--Z09;
+ef sC="f": cdw (.4fW,0)--(.4fW,.75aH){up}..(.75aW,fH)..{down}(fW,.8aH); dwh Z08--Z17;
+ef sC="g": dw zOa; dw sbp(0,.5)zOh shifted (0,-.5fH); cdw (aW-hP,.7aH)--(aW-hP,-.25aH);
+ef sC="h": cdw Z02..(hP,.3aH){up}..(hW,.7fH)..{down}(fW,.3aH)..Z05; dwv (hP,.3aH)--Z18;
+ef sC="i": dwv Z07--(hW,.7aH); ppcs 1.4fP; dw Z14;
+ef sC="j": cdw (fW,.7aH)--Z21..(.25aW,-.66fP)..Z03; ppcs 1.4fP; dw Z22;
+ef sC="k": dwv Z02--(hP,1.3fH); cdw .5[Z02,Z18]--Z05; cdw .5[Z02,Z18]--Z16;
+ef sC="l": dwv Z07--Z06; dwh Z14--Z13; dwh Z19--Z21;
+ef sC="m": cdw Z02..(hP,.3aH){up}..(.28aW,fH)..{down}(hW,.3aH)..Z07;
+ cdw (hW,.6aH){up}..(.7aW,aH-hP)..{down}(fW,.6aH)..Z05; dwv (hP,.3aH)--(hP,aH);
+ef sC="n": cdw Z02{up}..(hW,.8fH)..{down}(fW,.5aH)..Z05; dwv (hP,0)--(hP,.8aH);
+ef sC="o": dw Z19..Z10..Z14..Z09..cycle;
+ef sC="p": dw Z19..Z10..Z14..Z09..cycle; dwv (hP,aH)--(hP,-.3aH);
+ef sC="q": dw Z19..Z10..Z14..Z09..cycle; dwv (fW,aH)--(fW,-.3aH);
+ef sC="r": cdw (sbp(.33,.72)Z19..Z10..Z14..Z09..cycle) shifted(0,-hP); dwv Z02--Z18;
+ef sC="s": cdw sbp(.05,.45)zO; cdw sbp(.55,.95)zO; dw (fW,.3aH){up}..{up}(hP,.7aH);
+ef sC="t": dwv Z07--Z06; dwh (0,.66aH)--(aW,.66aH);
+ef sC="u": cdw Z18..(hP,.55aH){down}..Z19..(fW,.55aH){up}..Z15; dwv Z15--Z05;
+ef sC="v": dwv Z18--Z07--Z15;
+ef sC="w": dwv Z18--(.25aW,0)--Z06--(.75aW,0)--Z15;
+ef sC="x": dwvs(1.4) Z18--Z05; dwvs(1.4) Z15--Z02;
+ef sC="y": dwvs(1.4) (Z18--Z20) shifted (0,-.3aH); dwvs(1.4) (Z15--Z02) shifted (0,-.3aH);
+ef sC="z": dwh Z12--Z16; dwvs(1.4) (1.4hP,fP)--(aW-1.4hP,aH-fP); dwh Z01--Z04;
+ef sC="0": dw Z09...Z14...Z10...Z19...cycle;
+ef sC="1": dwv Z07--(hW,aH-.3hP)--(hW-fP,aH-fP)--(hW-fP,aH-1.5fP);
+ef sC="2": cdw (hP,1.3hP)..(.4fW,.35fH)..(fW,.65aH)..Z14..(hP,.65aH); dwh Z04--Z01;
+ef sC="3": cdw sbp(0,.75)zOh; cdw sbp(.25,.98)zOh shifted (0,hH-hP); dwh (.3aW,hH)--Z20;
+ef sC="4": dwh (0,.25aH)--(aW,.25aH); dwv (.75aW,0)--(.75aW,aH)--(1.2hP,.25aH+hP);
+ dwv (.75aW+.5hP,aH)--(1.7hP,.25aH+hP);
+ef sC="5": dwh Z12--Z16; dwv Z13--(hP,.55fH);
+ cdw (.5hP,.18aH)..(.65aW,1.3hP)..(fW,.4aH)..(hW,.63aH)..(.7hP,.56aH);
+ef sC="6": dw Z19..(fW,.5fW)..Z23..(hP,.5fW)..cycle; cdw (.8fP,hH)--Z06;
+ef sC="7": dwh (0,.fH)--Z16; dwvs(1.2) (aW-1.2hP,aH-fP)--(.4aW,0);
+ef sC="8": dw zOh; dw (hP,.75aH)...Z14...(fW,.75aH)...Z20...cycle;
+ef sC="9": dw (Z19..(fW,.5fW)..Z23..(hP,.5fW)..cycle) shifted (0,.32aH); cdw (fW-.45fP,hH)--Z07;
+ef sC=" ":
+ef sC=".": ppcs 1.4fP; dw Z19;
+ef sC=",": dw (hW+.5fP,hP)..(hW+.3fP,-fP)..(hW-.5fP,hP-2fP); ppcs 1.4fP; dw Z19;
+ef sC="'": dw (hW+.5fP,fH)..(hW+.3fP,fH-fP)..(hW-.5fP,fH-2fP); ppcs 1.4fP; dw Z14;
+ef sC="`": dw (hW-.5fP,fH-2fP)..(hW-.3fP,fH-fP)..(hW+.5fP,fH); ppcs 1.4fP; dw (hW,fH-2fP);
+ef sC=":": ppcs 1.4fP; dw (hW,.2aH); dw (hW,.8aH);
+ef sC=";": dw (hW+hP,.2aH)..(hW-hP,.2aH-2fP); ppcs 1.4fP; dw (hW,.2aH); dw (hW,.8aH);
+ef sC="(": dw Z19...Z09...Z14;
+ef sC=")": dw Z19...Z10...Z14;
+ef sC="[": dwv Z07--Z06; dwh Z14--Z22; dwh Z19--Z21;
+ef sC="]": dwv Z07--Z06; dwh Z14--Z13; dwh Z03--Z19;
+ef sC="<": cdw Z01--Z17--Z12;
+ef sC=">": cdw Z16--Z08--Z04;
+ef sC="-": dwh Z09--Z10;
+ef sC="=": dwh (hP,.3aH)--(fW,.3aH); dwh (hP,.6aH)--(fW,.6aH);
+ef sC="/": dw Z22..Z01;
+ef sC="+": dwv Z19--Z14; dwh Z09--Z10;
+ef sC="*": dw Z19--Z14; dw Z09--Z10; dw (.2aW,.2aH)--(.8aW,.8aH); dw (.2aW,.8aH)--(.8aW,.2aH);
+ef sC="$": cdw sbp(.05,.45)zO; cdw sbp(.55,.95)zO; dw (fW,.3aH){up}..{up}(hP,.7aH);
+ dwv (hW,-fP)--(hW,fH+1.5fP);
+ef sC="#": dwv (.3aW,0)--(.3aW,aH); dwv (.7aW,0)--(.7aW,aH);
+ dwh (0,.3aH)--(aW,.3aH); dwh (0,.7aH)--(aW,.7aH);
+ef sC="!": dwv Z06--(hW,.25aH); ppcs 1.4fP; dw Z07;
+ef sC="?": cdw (hP,.75fH)..(hW,aH)..(fW,.75fH)..(hW,.4fH)--(hW,.2fH); ppcs 1.4fP; dw Z07;
+ef sC="|": dwv Z07--Z06;
+ef sC="\": dw Z13--Z21;
+ef sC="%": dw Z22..Z01; dw fullcircle scaled 2.7fP shifted (.2fH,.9fH);
+ dw fullcircle scaled 2.7fP shifted (.73fH,.20fH);
+ef sC="~": dw (hP,.8aH)..(.3aW,.9aH)..(.6aW,.7aH)..(fW,.8aH);
+ef sC="&": cdw Z21..(hW,.35aH)..(.25aW,.75aH)..(hW,.fH)..(.75aW,.75fH)..(hP,.3aH)..(hW,.hP)..Z10;
+ef sC="@": cdw sbp(0,.7)zO; dwv (fW,hH)--(fW,0);
+ dw (fW,.45aH)..(.7aW,.75aH)..(.3aW,.45aH)..(.7aW,.15aH)..cycle;
+else:
+fi
+endgroup
+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 ATOM)=
+ if length(ATOM)=4: substring (1,3) of ATOM
+ elseif length(ATOM)=6: substring (1,2) of ATOM
+ else: ATOM
+ fi
+enddef;
+%==================================================================================================
+def STa(expr ATOM,WT,MI)=
+ tbl_cnt:=tbl_cnt+1;
+ tbl_atom_str[tbl_cnt]:=ATOM;
+ tbl_atom[tbl_cnt]:=0;
+ tbl_atom_wt[tbl_cnt]:=WT;
+ tbl_atom_mi[tbl_cnt]:=MI;
+enddef;
+%----------------------------------------------------------------------------------
+def STb(expr ATOM)(text TXT)=
+ tbl_cnt:=tbl_cnt+1;
+ tbl_atom_str[tbl_cnt]:=ATOM;
+ tbl_atom[tbl_cnt]:=0;
+ for list=TXT:
+ 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("{N^+^}",14.0067, 14.00307400443);
+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("{O^-^}",15.9994, 15.99491461957);
+STa("{O^p^}",15.9994, 15.99491461957); STa("P" ,30.973762, 30.97376199842);
+STa("S" ,32.065, 31.9720711744); STa("{S^p^}",32.065, 31.9720711744);
+STa("{S^m^}",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=
+ begingroup
+ save warning_cnt,MWp,knownA,bondC,tmp_wtp,bond_cnt,cnt_hide_H;
+ numeric sumA[],bondC[],hideH[];
+ string sumA;
+ cnt_hide_H:=warning_cnt:=num_MW:=num_MI:=MWp:=0;
+ %------------------------------------------------------------------------------------------
+ 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;
+ ef lineB[j]=tm: bondC[j]:=3;
+ ef (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 numS[i]=0: 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);
+ ef strD[numS[i]]="N": bond_check(i)(3,5);
+ ef strD[numS[i]]="H": bond_check(i)(1);
+ ef strD[numS[i]]="O": bond_check(i)(2);
+ ef strD[numS[i]]="S": bond_check(i)(2,4,6);
+ ef strD[numS[i]]="P": bond_check(i)(5);
+ ef strD[numS[i]]="OH": bond_check(i)(1);
+ ef strD[numS[i]]="COOH": bond_check(i)(1);
+ ef strD[numS[i]]="CN": bond_check(i)(1);
+ ef strD[numS[i]]="N{H_2_}": bond_check(i)(1);
+ ef strD[numS[i]]="F": bond_check(i)(1);
+ ef strD[numS[i]]="{Cl}": bond_check(i)(1);
+ ef 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):
+ num_MW:= num_MW+tbl_atom_wt[i]*sumA[i];
+ num_MI:= num_MI+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(num_MI);
+ cal_MW:=substring (0,8) of decimal(num_MW);
+ if sw_aux_out=1: proc_auxfile_out; fi
+ if sw_rep_out=1: proc_report_out; fi
+ if sw_mol_out>=1: proc_mol_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;
+ out_file_name:=out_file_aux;
+ 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 "["&decimal(char_num)&"]:"&inf_EN;
+ out_file_name:=out_file_rep;
+ printf "------------------------------------------------------------------";
+ printf " Molecular name = "& inf_EN;
+ printf " Warnings = "&fdr(3)(warning_cnt)&" / Expanded command = "&decimal(cntD[0]);
+ printf " Width * Height = " & fdr(10)(mol_wd)&" * "&fdr(10)(mol_ht);
+ printf " Shift width * height = "& fdr(10)(minX)&" * "&fdr(10)(minY);
+ printf " Bond length = "&fdr(3)(blen)&" Atom size = "&fdr(3)(atom_wd);
+ printf " 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);
+ printf "------------------------------------------------------------------";
+ printf "< NO. >( x axis , y axis )< atom >< bond >< hideH >< chg >";
+ for i=1 upto cntA:
+ printf " A"&fdl(4)(i)&" ("&fdr(10)(round_auto(xpart(posA[i])/blen))&" , "&
+ fdr(10)(round_auto(ypart(posA[i])/blen))&" ) "&fixed_l(8)(strD[numS[i]])&
+ " "&fdr(3)(Bcnt[i])
+ &iif(hideH[i]>0,fdr(8)(hideH[i])," ")
+ if chargeA[i]<>0: &fdr(8)(chargeA[i]) fi;
+ endfor
+ printf "------------------------------------------------------------------";
+ printf "< 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
+ printf " 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*blen))&")";
+ fi
+ endfor
+ printf "------------------------------------------------------------------";
+ printf "<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];
+ printf " "&
+ 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
+ printf " Molecular Weight [Mono Isotopic] = "&
+ fixed_r(12)(cal_MW_str)&"["&fixed_r(12)(cal_MI_str)&"]";
+ printf "------------------------------------------------------------------";
+ printf " Weight Calc: " &cal_MW_str &" / Input: "
+ if inf_MW<>"": &inf_MW &" / weight gap= " &decimal(num_MW-scantokens(inf_MW)) fi;
+ printf " Fomula Calc: "&cal_FM&" / Input: "
+ if inf_FM<>"": &inf_FM&" / "& iif(inf_FM=cal_FM,"MACTCH","NOT MACTCH") fi;
+ printf "==================================================================";
+enddef;
+%==================================================================================================
+def proc_mol_out=
+ begingroup
+ save chg_cnt,chg_atm,chg_chg,nA,nB;
+ nA:=nB:=chg_cnt:=0;
+ message "["&decimal(char_num)&"]:"&inf_EN;
+ out_file_name:=out_file_mol;
+ if sw_mol_out<=2:
+ out_file_name:=out_file_mol;
+ if sw_mol_out=1: proc_vdk;
+ elseif sw_mol_out=2: proc_vtk;
+ fi
+ fi
+ endgroup
+enddef;
+%-V2000------------------------------------------------------------------------------------------
+def proc_vdk=
+ 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])/blen)& fdr(10)(ypart(posA[i])/blen)&
+ fdr(10)(0)&" "&fixed_l(2)(stripP(strD[numS[i]]))&" 0 0 0 0";
+ if chargeA[i]<>0: chg_atm[incr chg_cnt]:=i; chg_chg[chg_cnt]:=chargeA[i]; fi
+ endfor
+ for i=1 upto cntB:
+ if lineB[i]<>0:
+ proc_bond_class(lineB[i]);
+ printf fdr(3)(sB[i])&fdr(3)(eB[i])&fdr(3)(nA)&fdr(3)(nB)&" 0 0";
+ fi
+ endfor
+ if chg_cnt>0:
+ printf "M CHG"&fdr(3)(chg_cnt)
+ for i=1 upto chg_cnt: &fdr(4)(chg_atm[i])&fdr(4)(chg_chg[i]) endfor;
+ fi
+ printf "M END";
+enddef;
+%-V3000---------------------------------------------------------------------------------------
+def proc_vtk=
+ printf ""; printf " -MCFtoMOL- "&fixed_l(20)(info[1]);
+ printf "";
+ printf " 0 0 0 0 0 999 V3000";
+ printf "M V30 BEGIN CTAB";
+ printf "M V30 COUNTS "&decimal(cntA)&" "&decimal(cntB)&" 0 0 0";
+ printf "M V30 BEGIN ATOM";
+ for i=1 upto cntA:
+ printf "M V30 "&decimal(i)&" "&stripP(strD[numS[i]])&" "&
+ decimal(xpart(posA[i])/blen)&" "&decimal(ypart(posA[i])/blen)&" 0 0"
+ if chargeA[i]<>0: &" CHG="&decimal(chargeA[i]) fi;
+ endfor
+ printf "M V30 END ATOM";
+ printf "M V30 BEGIN BOND";
+ for i=1 upto cntB:
+ if lineB[i]<>0:
+ proc_bond_class(lineB[i]);
+ printf "M V30 "&decimal(i)&" "&decimal(nA)&" "&decimal(sB[i])&" "&decimal(eB[i]);
+ fi
+ endfor
+ printf "M V30 END BOND";
+ printf "M V30 END CTAB";
+ printf "M END";
+enddef;
+%-------------------------------------------------------------------------------------------------
+vardef fit_zero(expr n)=if n<=9: "00" elseif n<=99: "0" fi &decimal(n) enddef;
+%-------------------------------------------------------------------------------------------------
+def proc_bond_class(expr n)=
+ if (n=dl)or(n=dr)or(n=dm): nA:=2;
+ ef n=tm: nA:=3;
+ ef (n=wf)or(n=zb)or(n=bd): nB:=1;
+ ef (n=zf)or(n=wb)or(n=dt): nB:=6;
+ ef n=wv: nB:=4;
+ else: nA:=1; nB:=0;
+ fi
+enddef;
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%