diff options
Diffstat (limited to 'Master/texmf-dist/metapost/context/base')
21 files changed, 2456 insertions, 730 deletions
diff --git a/Master/texmf-dist/metapost/context/base/metafun.mpiv b/Master/texmf-dist/metapost/context/base/metafun.mpiv index d600764a3d0..8247c121f2f 100644 --- a/Master/texmf-dist/metapost/context/base/metafun.mpiv +++ b/Master/texmf-dist/metapost/context/base/metafun.mpiv @@ -11,10 +11,9 @@ %C therefore copyrighted by \PRAGMA. See mreadme.pdf for %C details. -%D First we input John Hobby's metapost plain file. However, -%D because we want to prevent dependency problems and in the -%D end even may use a patched version, we prefer to use a -%D copy. +%D First we input John Hobby's metapost plain file. However, because we want to +%D prevent dependency problems and in the end even may use a patched version, +%D we prefer to use a copy. input "mp-base.mpiv" ; input "mp-tool.mpiv" ; diff --git a/Master/texmf-dist/metapost/context/base/mp-abck.mpiv b/Master/texmf-dist/metapost/context/base/mp-abck.mpiv index 02fab033787..abd7d8848ec 100644 --- a/Master/texmf-dist/metapost/context/base/mp-abck.mpiv +++ b/Master/texmf-dist/metapost/context/base/mp-abck.mpiv @@ -5,7 +5,7 @@ %D subtitle=anchored background macros, %D author=Hans Hagen, %D date=\currentdate, -%D copyright={PRAGMA / Hans Hagen \& Ton Otten}] +%D copyright={PRAGMA ADE \& \CONTEXT\ Development Team}] %C %C This module is part of the \CONTEXT\ macro||package and is %C therefore copyrighted by \PRAGMA. See mreadme.pdf for diff --git a/Master/texmf-dist/metapost/context/base/mp-apos.mpiv b/Master/texmf-dist/metapost/context/base/mp-apos.mpiv index f92efc5fda8..7b77377545a 100644 --- a/Master/texmf-dist/metapost/context/base/mp-apos.mpiv +++ b/Master/texmf-dist/metapost/context/base/mp-apos.mpiv @@ -5,7 +5,7 @@ %D subtitle=anchored background macros, %D author=Hans Hagen, %D date=\currentdate, -%D copyright={PRAGMA / Hans Hagen \& Ton Otten}] +%D copyright={PRAGMA ADE \& \CONTEXT\ Development Team}] %C %C This module is part of the \CONTEXT\ macro||package and is %C therefore copyrighted by \PRAGMA. See mreadme.pdf for diff --git a/Master/texmf-dist/metapost/context/base/mp-asnc.mpiv b/Master/texmf-dist/metapost/context/base/mp-asnc.mpiv index dfd88317c0c..2626e4d584e 100644 --- a/Master/texmf-dist/metapost/context/base/mp-asnc.mpiv +++ b/Master/texmf-dist/metapost/context/base/mp-asnc.mpiv @@ -5,7 +5,7 @@ %D subtitle=anchored background macros, %D author=Hans Hagen, %D date=\currentdate, -%D copyright={PRAGMA / Hans Hagen \& Ton Otten}] +%D copyright={PRAGMA ADE \& \CONTEXT\ Development Team}] %C %C This module is part of the \CONTEXT\ macro||package and is %C therefore copyrighted by \PRAGMA. See mreadme.pdf for diff --git a/Master/texmf-dist/metapost/context/base/mp-butt.mpiv b/Master/texmf-dist/metapost/context/base/mp-butt.mpiv index df7e9e4fdab..6f5b90a7e66 100644 --- a/Master/texmf-dist/metapost/context/base/mp-butt.mpiv +++ b/Master/texmf-dist/metapost/context/base/mp-butt.mpiv @@ -5,7 +5,7 @@ %D subtitle=buttons, %D author=Hans Hagen, %D date=\currentdate, -%D copyright={PRAGMA / Hans Hagen \& Ton Otten}] +%D copyright={PRAGMA ADE \& \CONTEXT\ Development Team}] %C %C This module is part of the \CONTEXT\ macro||package and is %C therefore copyrighted by \PRAGMA. See licen-en.pdf for diff --git a/Master/texmf-dist/metapost/context/base/mp-char.mpiv b/Master/texmf-dist/metapost/context/base/mp-char.mpiv index c293b728468..f604accd8e4 100644 --- a/Master/texmf-dist/metapost/context/base/mp-char.mpiv +++ b/Master/texmf-dist/metapost/context/base/mp-char.mpiv @@ -5,7 +5,7 @@ %D subtitle=charts, %D author=Hans Hagen, %D date=\currentdate, -%D copyright={PRAGMA / Hans Hagen \& Ton Otten}] +%D copyright={PRAGMA ADE \& \CONTEXT\ Development Team}] %C %C This module is part of the \CONTEXT\ macro||package and is %C therefore copyrighted by \PRAGMA. See licen-en.pdf for diff --git a/Master/texmf-dist/metapost/context/base/mp-chem.mpiv b/Master/texmf-dist/metapost/context/base/mp-chem.mpiv index cb595f2c661..2addb0a73ea 100644 --- a/Master/texmf-dist/metapost/context/base/mp-chem.mpiv +++ b/Master/texmf-dist/metapost/context/base/mp-chem.mpiv @@ -3,15 +3,15 @@ %D version=2009.05.13, %D title=\CONTEXT\ \METAPOST\ graphics, %D subtitle=chemicals, -%D author=Hans Hagen, +%D author=Hans Hagen \& Alan Braslau, %D date=\currentdate, -%D copyright=\PRAGMA] +%D copyright={PRAGMA ADE \& \CONTEXT\ Development Team}] %C %C This module is part of the \CONTEXT\ macro||package and is %C therefore copyrighted by \PRAGMA. See licen-en.pdf for %C details. -%D This module in incomplete and experimental. +%D This module is incomplete and experimental. % either consistent setting or not @@ -20,821 +20,1671 @@ if known context_chem : endinput ; fi ; boolean context_chem ; context_chem := true ; numeric - chem_width, chem_radical_min, chem_radical_max, chem_text_max, chem_circle_radius, - chem_rotation, chem_adjacent, chem_stack, chem_substituent, chem_direction, chem_setting_scale, - chem_setting_offset, chem_text_offset, chem_picture_offset, chem_center_offset, chem_substituent_offset, - chem_setting_l, chem_setting_r, chem_setting_t, chem_setting_b ; + chem_num[], % scratch + chem_text_min, chem_text_max, + chem_rotation, chem_adjacent, chem_stack_n, + chem_substituent, chem_substituent.lft, chem_substituent.rt, + chem_setting_offset, chem_text_offset, chem_picture_offset, + chem_center_offset, chem_dbl_offset, + chem_bb_angle, chem_axis_rulethickness, + chem_setting_l, chem_setting_r, chem_setting_t, chem_setting_b, + chem_setting_rotation, chem_emwidth, chem_b_length, + chem_front_b[] ; boolean chem_setting_axis, - chem_setting_fixedwidth, chem_setting_fixedheight, - chem_doing_pb, chem_text_trace ; + chem_doing_pb, chem_bd_wedge, + chem_star[], chem_front[], chem_stacked[], chem_tetra[] ; + +string + chem_previous ; path - chem_setting_bbox ; + chem_path[], % scratch + chem_b_path[], chem_c_path[], + chem_r_path[], chem_r_path.lft[], chem_r_path.rt[] ; pair - chem_shift, - chem_adjacent_p, chem_substituent_p, chem_direction_p, chem_move_p ; + chem_origin, chem_mirror, + chem_pair[], % scratch + chem_sb_pair, chem_sb_pair.m, chem_sb_pair.p, chem_sb_pair.b ; + +picture + chem_pic, % scratch + % The use of dashpattern is found to dot the starting point with chem_sb_dash.m... + %chem_sb_dash, chem_sb_dash.m, chem_sb_dash.p, chem_sb_dash.b, + chem_axis_color ; + +transform + chem_t ; % scratch + +color lightblue ; lightblue := (173/255,216/255,230/255) ; + +% debugging + +boolean chem_trace_nesting ; chem_trace_nesting := false ; +boolean chem_trace_text ; chem_trace_text := false ; +boolean chem_trace_boundingbox ; chem_trace_boundingbox := false ; + +chem_axis_color := image(draw origin withcolor lightblue) ; +chem_setting_axis := false ; +chem_axis_rulethickness := 1pt ; +chem_emwidth := 10pt ; % EmWidth or \the\emwidth does not work... +chem_b_length := 3 chem_emwidth ; +chem_text_offset := -.3chem_emwidth ; % -.71chem_emwidth ; % 1/sqrt(2) +chem_center_offset := .5 chem_emwidth ; +chem_picture_offset := chem_emwidth ; +chem_dbl_offset := .05 ; +chem_bb_angle := angle(1,2chem_dbl_offset) ; +chem_text_min := 0.75 ; +chem_text_max := 1.25 ; +chem_dot_factor := 4 ; % *linewidth +chem_sb_pair := (0.25,0.75) ; %chem_sb_dash := dashpattern(off 0.25 on 0.5 off 0.25) ; +chem_sb_pair.m := (0.25,1 ) ; %chem_sb_dash.m := dashpattern(off 0.25 on 0.75) ; +chem_sb_pair.p := (0 ,0.75) ; %chem_sb_dash.p := dashpattern(on 0.75 off 0.25) ; +chem_sb_pair.b := (0, 1 ) ; %chem_sb_dash.b := dashpattern(on 1) ; + +chem_bd_wedge := false ; % true is incorrect, but quite common... + +def chem_reset = + chem_rotation := 0 ; + chem_mirror := origin ; + chem_adjacent := 0 ; + chem_substituent := 0 ; + chem_substituent.lft := 0 ; + chem_substituent.rt := 0 ; + chem_stack_n := 0 ; + chem_doing_pb := false ; + chem_origin := origin ; + chem_previous := "one" ; + pair chem_mark_pair[] ; +enddef ; + +chem_reset ; + +newinternal numeric + one, carbon, alkyl, newmanstagger, newmaneclipsed, + three, four, five, six, seven, eight, nine, + fivefront, sixfront, chair, boat ; + +vardef chem_init_some (suffix $) (expr e) = + if not known chem_star[$] : chem_star[$] := false ; fi + if not known chem_front[$] : chem_front[$] := false ; fi + if not known chem_stacked[$] : chem_stacked[$] := false ; fi + if not known chem_tetra[$] : chem_tetra[$] := false ; fi + + % We define all paths as closed, so that they may be indexed mod length. + if path(e) : + chem_b_path[$] := e if not cycle(e) : -- cycle fi ; + chem_num0 := length(chem_b_path[$]) ; + else : % polygon + chem_num0 := e ; + chem_num1 := 360/chem_num0 ; + chem_b_path[$] := + ( + for i=0 upto chem_num0-1 : + dir(if chem_star[$] : -i else : (.5-i) fi *chem_num1) -- + endfor + cycle + ) + if chem_front[$] : + rotated (chem_num1-90) + fi + if not chem_star[$] : + scaled (.5/(sind .5chem_num1)) + fi ; + fi ; -numeric - chem_width[], chem_angle[], chem_start[], chem_initialrot[], chem_initialmov[] ; + if chem_front[$] and (not known chem_front_b[$]) : + chem_front_b[$] := floor(.5(length chem_b_path[$])) + 1 ; + fi -pair - chem_stack_d[], - chem_b_zero[], chem_n_zero[], - chem_r_max[], chem_r_min[], - chem_r_zero[], chem_mr_zero[], chem_pr_zero[], chem_crz_zero[], - chem_rt_zero[], chem_rtt_zero[], chem_rbt_zero[], - chem_mid_zero[] ; + chem_num2 := 0 ; + chem_c_path[$] := + reverse(fullcircle) rotated angle(point 0 of chem_b_path[$]) + if not chem_star[$] : + hide (for i=0 upto chem_num0-1: + if abs(point i+.5 of chem_b_path[$]) < + abs(point chem_num2+.5 of chem_b_path[$]) : + chem_num2 := i ; + fi + endfor) + scaled (2*(abs(point chem_num2+.5 of chem_b_path[$]) - chem_dbl_offset)) + fi ; -path - chem_b_path[], chem_bx_path[], chem_eb_path[], chem_sr_path[], chem_br_path[], - chem_sb_path[], chem_msb_path[], chem_psb_path[], - chem_s_path[], chem_ss_path[], chem_mss_path[], chem_pss_path[], - chem_e_path[], chem_sd_path[], chem_bb_path[], chem_oe_path[], - chem_bd_path[], chem_bw_path[], - chem_ddt_path[], chem_ddb_path[], chem_ldt_path[], chem_ldb_path[], chem_rdt_path[], chem_rdb_path[], - chem_dbl_path[], chem_dbr_path[], - chem_ad_path[], chem_au_path[], - chem_r_path[], chem_rl_path[], chem_rr_path[], - chem_rb_path[], chem_prb_path[], chem_mrb_path[], - chem_srl_path[], chem_srr_path[], - chem_msr_path[], chem_psr_path[], - chem_mr_path[], chem_pr_path[], - chem_c_path[], chem_cc_path[], - chem_midt_path[], chem_midb_path[], chem_midst_path[], chem_midsb_path[] ; - -chem_setting_scale := 1 ; -chem_base_width := 40pt ; -chem_text_offset := 3pt ; -chem_center_offset := 6pt ; -chem_picture_offset := 10pt ; -chem_substituent_offset := 10pt ; -chem_radical_min := 1.25 ; -chem_radical_max := 1.50 ; -chem_text_min := 0.75 ; -chem_text_max := 1.75 ; -chem_circle_radius := 0.80 ; -chem_circle_radius := 1.10 ; -chem_rotation := 1 ; -chem_adjacent := 0 ; -chem_substituent := 0 ; -chem_direction := 0 ; -chem_stack_n := 0 ; -chem_doing_pb := false ; -chem_shift := origin ; -chem_dot_factor := 4 ; -chem_text_trace := false ; -chem_bd_n := 4 ; -chem_bw_n := 4 ; -chem_bd_angle := 4 ; -chem_bb_angle := 4 ; - -vardef chem_start_structure(expr n, l, r, t, b, scale, axis, fixedwidth, fixedheight, offset) = - chem_setting_axis := axis ; - chem_setting_l := l * scale ; - chem_setting_r := r * scale ; - chem_setting_t := t * scale ; - chem_setting_b := b * scale ; - chem_setting_fixedwidth := fixedwidth ; - chem_setting_fixedheight := fixedheight ; - chem_setting_offset := offset ; - if scale <> chem_setting_scale : - chem_setting_scale := scale ; - chem_init_all ; - fi ; - chem_rotation := 1 ; - chem_adjacent := 0 ; - chem_substituent := 0 ; - chem_direction := 0 ; - chem_stack_n := 0 ; - chem_doing_pb := false ; - chem_shift := origin ; -enddef ; - -def chem_stop_structure = - currentpicture := currentpicture shifted - chem_shift ; - % axis here - if chem_setting_fixedwidth : - chem_setting_l := - xpart llcorner currentpicture ; - chem_setting_r := xpart urcorner currentpicture ; + chem_r_path[$] := + if chem_star[$] : + chem_b_path[$] + else : + ( + for i=0 upto chem_num0-1 : + (unitvector point i of chem_b_path[$]) + shifted point i of chem_b_path[$] -- + endfor + cycle + ) + fi ; + + chem_r_path.lft[$] := + ( + for i=0 upto chem_num0-1 : + if chem_front[$] : + up + scaled .5 + shifted point i of chem_b_path[$] + elseif chem_star[$] : + point i of chem_b_path[$] + else : + point i+1 of chem_b_path[$] + rotatedabout(point i of chem_b_path[$],180) + fi -- + endfor + cycle + ) ; + chem_r_path.rt[$] := + ( + for i=0 upto chem_num0-1 : + if chem_front[$] : + down + scaled .5 + shifted point i of chem_b_path[$] + elseif chem_star[$] : + point i+2 of chem_b_path[$] + else : + point i-1 of chem_b_path[$] + rotatedabout(point i of chem_b_path[$],180) + fi -- + endfor + cycle + ) ; + +enddef ; + +% The following is used only once: +def chem_init_all = +begingroup + save a, b, c, d, e ; numeric a, b, c, d, e ; + save lft, rt ; path lft, rt ; + + % tetrahedrial angle + a := 2angle(1,sqrt 2) ; + + % solve for chair + 2b = 180 - .5a ; + 4c = 180 - .5a ; + d + e = 360 - 2a ; + d = 5e ; % this is the one tunable parameter which fixes the perspective. + z2 = z1 shifted dir(90+a+d) ; + z3 = z2 shifted dir(270-a) ; + z4 = z3 shifted dir(90+a) ; + z6 = z1 shifted dir(90+a) ; + z5 = z6 shifted dir(270-a) ; + z4 = z1 xyscaled (-1,-1) ; + z5 = z2 xyscaled (-1,-1) ; + + save indx ; numeric indx ; indx = 2 ; % starting value doesn't matter, really. + % polygons + three := incr indx ; % 3 (these numbers don't matter - they are just indices) + four := incr indx ; % 4 + five := incr indx ; % 5 + six := incr indx ; % 6 + seven := incr indx ; % 7 + eight := incr indx ; % 8 + nine := incr indx ; % 9 + + chem_init_some(three,3) ; + chem_init_some(four, 4) ; + chem_init_some(five, 5) ; + chem_init_some(six, 6) ; + chem_init_some(seven,7) ; + chem_init_some(eight,8) ; + chem_init_some(nine, 9) ; + + % star-form + one := incr indx ; % 10 + carbon := incr indx ; % 11 + alkyl := incr indx ; % 12 + newmanstagger := incr indx ; % 13 + newmaneclipsed := incr indx ; % 14 + + chem_star[one] := true ; + chem_star[carbon] := true ; chem_tetra[carbon] := true ; + chem_star[alkyl] := true ; chem_tetra[alkyl] := true ; + chem_star[newmanstagger] := true ; chem_tetra[newmanstagger] := true ; + chem_star[newmaneclipsed] := true ; chem_tetra[newmaneclipsed] := true ; + chem_stacked[newmanstagger] := true ; + chem_stacked[newmaneclipsed] := true ; + chem_init_some(one, 8) ; + chem_init_some(carbon, dir(0)--dir(360-a)--dir(180-.5a+b)--dir(180-.5a)) ; + chem_init_some(alkyl, dir(0)--dir(360-a)--dir(360-a-90)--dir(90)) ; + chem_init_some(newmanstagger, dir(30)--dir(270)--dir(150)--dir(330)--dir(210)--dir(90)) ; + chem_init_some(newmaneclipsed, dir(30)--dir(270)--dir(150)--dir(0)--dir(240)--dir(120)) ; + + % front views + fivefront := incr indx ; % 15 + sixfront := incr indx ; % 16 + chair := incr indx ; % 17 + boat := incr indx ; % 18 + + chem_front[fivefront] := true ; chem_front_b[fivefront] := 3 ; + chem_front[sixfront] := true ; chem_front_b[sixfront] := 3 ; + chem_init_some(fivefront,5) ; + chem_init_some(sixfront, 6) ; + % chair + chem_front[chair] := true ; chem_front_b[chair] := 4 ; + chem_init_some(chair, z1--z2--z3--z4--z5--z6) ; + lft := dir(90-a)--down--dir(90+a+d)--down--dir(90+a)--down ; + rt := up--dir(270+a)--up--dir(270-a)--up--dir(90+e) ; + chem_r_path.lft[chair] := + for i=0 upto 5 : point i of lft shifted point i of chem_b_path[chair] -- endfor + cycle ; + chem_r_path.rt[chair] := + for i=0 upto 5 : point i of rt shifted point i of chem_b_path[chair] -- endfor + cycle ; + % boat + chem_front[boat] := true ; chem_front_b[boat] := 4 ; + chem_init_some(boat, + for i=1 upto 4 : point i-1 of chem_b_path[sixfront] -- endfor + point 2 of chem_b_path[sixfront] yscaled .5 -- + point 1 of chem_b_path[sixfront] yscaled .5 + ) ; + lft := dir(30+.5a)--dir(330+.5a)--dir(210-.5a)--dir(150-.5a)--dir(120)--dir(60) ; + rt := dir(30-.5a)--dir(330-.5a)--dir(210+.5a)--dir(150+.5a)--dir(120+a)--dir(60-a) ; + chem_r_path.lft[boat] := + for i=0 upto 5 : point i of lft shifted point i of chem_b_path[boat] -- endfor + cycle ; + chem_r_path.rt[boat] := + for i=0 upto 5 : point i of rt shifted point i of chem_b_path[boat] -- endfor + cycle ; +endgroup +enddef ; + +chem_init_all ; % WHY does this not work unless defined and then called? + + +% Like most often in ConTeXt, we will trap but then silently ignore mistaken use, +% unless of course the error be too harmful... + +% \startchemical + +def chem_start_structure(expr i, l, r, t, b, rotation, unit, factor, offset, axis, rulethickness, axiscolor) = + save chem_setting_l, chem_setting_r, chem_setting_t, chem_setting_b ; + + chem_emwidth := unit ; + chem_b_length := factor * unit ; + if numeric l : + chem_setting_l := -l ; + fi + if numeric r : + chem_setting_r := r ; + fi + if numeric t : + chem_setting_t := t ; + fi + if numeric b : + chem_setting_b := -b ; + fi + chem_setting_rotation := rotation ; + chem_setting_offset := offset ; + chem_setting_axis := if boolean axis : axis else : (axis<>0) fi ; + chem_axis_rulethickness := .75*(rulethickness) ; % axis 50% thinner than frame and bonds. + chem_axis_color := image(draw origin withcolor axiscolor) ; % so we handle all color models + + chem_reset ; +enddef ; + +% \stopchemical + +vardef chem_stop_structure = + % Make sure that all of the saved stack has been restored... (this was a gotcha!) + forever : + exitif chem_stack_n=0 ; + chem_restore ; + endfor + + currentpicture := (currentpicture shifted -chem_origin) rotated chem_setting_rotation ; + + save l, r, b, t ; + l := min(xpart llcorner currentpicture, xpart lrcorner currentpicture) ; + r := max(xpart llcorner currentpicture, xpart lrcorner currentpicture) ; + b := min(ypart llcorner currentpicture, ypart ulcorner currentpicture) ; + t := max(ypart llcorner currentpicture, ypart ulcorner currentpicture) ; + + if unknown chem_setting_l : chem_setting_l := l ; fi + if unknown chem_setting_r : chem_setting_r := r ; fi + if unknown chem_setting_b : chem_setting_b := b ; fi + if unknown chem_setting_t : chem_setting_t := t ; fi + + if chem_setting_axis : % put it behind the picture + chem_pic := currentpicture ; currentpicture := nullpicture ; + chem_num0 := .5chem_b_length ; + chem_num1 := .2chem_num0 ; + % draw the axes to the bounding box of the entire structure, + % not necessarily the bounding box of the final figure + draw (l,0) -- (r,0) + withpen pencircle scaled chem_axis_rulethickness withcolor colorpart(chem_axis_color) ; + draw (0,b) -- (0,t) + withpen pencircle scaled chem_axis_rulethickness withcolor colorpart(chem_axis_color) ; + for i = 0 step chem_num0 until r : + draw (i,-chem_num1) -- (i,chem_num1) + withpen pencircle scaled chem_axis_rulethickness withcolor colorpart(chem_axis_color) ; + endfor + for i = 0 step -chem_num0 until l : + draw (i,-chem_num1) -- (i,chem_num1) + withpen pencircle scaled chem_axis_rulethickness withcolor colorpart(chem_axis_color) ; + endfor + for i = 0 step chem_num0 until t : + draw (-chem_num1,i) -- (chem_num1,i) + withpen pencircle scaled chem_axis_rulethickness withcolor colorpart(chem_axis_color) ; + endfor + for i = 0 step -chem_num0 until b : + draw (-chem_num1,i) -- (chem_num1,i) + withpen pencircle scaled chem_axis_rulethickness withcolor colorpart(chem_axis_color) ; + endfor + addto currentpicture also chem_pic ; fi ; - if chem_setting_fixedheight : - chem_setting_t := ypart urcorner currentpicture ; - chem_setting_b := - ypart llcorner currentpicture ; + if chem_trace_boundingbox : + fill boundingbox currentpicture withcolor blue withtransparency(1,.25) ; fi ; - chem_setting_bbox := - (-chem_setting_l,-chem_setting_b) -- ( chem_setting_r,-chem_setting_b) -- - ( chem_setting_r, chem_setting_t) -- (-chem_setting_l, chem_setting_t) -- cycle ; - % maybe put it behind the picture - if chem_setting_axis : - save stp ; stp := chem_base_width/ 2 * chem_setting_scale ; - save siz ; siz := chem_base_width/10 * chem_setting_scale ; - draw (-chem_setting_l,0) -- (chem_setting_r,0) withcolor blue ; - draw (0,-chem_setting_b) -- (0,chem_setting_t) withcolor blue ; - for i = 0 step stp until chem_setting_r : draw (i,-siz) -- (i,siz) withcolor blue ; endfor ; - for i = 0 step -stp until -chem_setting_l : draw (i,-siz) -- (i,siz) withcolor blue ; endfor ; - for i = 0 step stp until chem_setting_t : draw (-siz,i) -- (siz,i) withcolor blue ; endfor ; - for i = 0 step -stp until -chem_setting_b : draw (-siz,i) -- (siz,i) withcolor blue ; endfor ; - draw chem_setting_bbox withcolor blue ; + setbounds currentpicture to + ((chem_setting_l,chem_setting_b) -- (chem_setting_r,chem_setting_b) -- + (chem_setting_r,chem_setting_t) -- (chem_setting_l,chem_setting_t) -- cycle) ; + if chem_trace_boundingbox : + fill boundingbox currentpicture withcolor red withtransparency(1,.25) ; fi ; - setbounds currentpicture to chem_setting_bbox ; enddef ; -def chem_start_component = enddef ; -def chem_stop_component = enddef ; +% \chemical + +vardef chem_start_component = enddef ; +vardef chem_stop_component = enddef ; -def chem_pb = -% draw boundingbox currentpicture withpen pencircle scaled 1mm withcolor blue ; -% draw origin withpen pencircle scaled 2mm withcolor blue ; +vardef chem_pb = % PB : + if chem_trace_nesting : + draw boundingbox currentpicture + withpen pencircle scaled 1mm withcolor colorpart(chem_axis_color) ; + draw origin withpen pencircle scaled 2mm withcolor colorpart(chem_axis_color) ; + fi ; chem_doing_pb := true ; enddef ; -def chem_pe = -% draw boundingbox currentpicture withpen pencircle scaled .5mm withcolor red ; -% draw origin withpen pencircle scaled 1mm withcolor red ; - currentpicture := currentpicture shifted - chem_shift ; -% draw origin withpen pencircle scaled .5mm withcolor green ; - chem_shift := origin ; +vardef chem_pe = % PE + if chem_trace_nesting : + draw boundingbox currentpicture withpen pencircle scaled .5mm withcolor red ; + draw origin withpen pencircle scaled 1mm withcolor red ; + fi ; + currentpicture := currentpicture shifted -chem_origin ; + if chem_trace_nesting : + draw origin withpen pencircle scaled .5mm withcolor green ; + fi ; + chem_origin := origin ; chem_doing_pb := false ; enddef ; -vardef chem_do (expr p) = - if chem_doing_pb : +vardef chem_do (expr pos) = + if (unknown chem_doing_pb) or (not chem_doing_pb) : + pos + else : chem_doing_pb := false ; -% save pp ; pair pp ; pp := point 1 of ((origin -- p) enlonged chem_picture_offset) ; -% currentpicture := currentpicture shifted - pp ; -% chem_shift := chem_shift - center pp ; - currentpicture := currentpicture shifted - p ; - chem_shift := chem_shift - p ; + currentpicture := currentpicture shifted -pos ; + chem_origin := chem_origin shifted -pos ; origin % nullpicture - else : - p fi enddef ; -vardef chem_b (expr n, f, t, r, c) = - chem_draw (n, chem_b_path[n], f, t, r, c) ; -enddef ; -vardef chem_sb (expr n, f, t, r, c) = - chem_draw (n, chem_sb_path[n], f, t, r, c) ; +picture chem_stack_p[] ; +pair chem_stack_origin[], chem_stack_mirror[] ; +numeric chem_stack_rotation[] ; +string chem_stack_previous[] ; + +vardef chem_save = % SAVE + chem_stack_p [incr chem_stack_n] := currentpicture ; + chem_stack_origin [ chem_stack_n] := chem_origin ; chem_origin := origin ; + chem_stack_rotation[ chem_stack_n] := chem_rotation ; + chem_stack_mirror [ chem_stack_n] := chem_mirror ; + chem_stack_previous[ chem_stack_n] := chem_previous ; + currentpicture := nullpicture ; enddef ; -vardef chem_s (expr n, f, t, r, c) = - chem_draw (n, chem_s_path[n], f, t, r, c) ; +vardef chem_restore = % RESTORE + if chem_stack_n>0 : + currentpicture := currentpicture shifted -chem_origin ; + addto chem_stack_p [chem_stack_n] also currentpicture ; + currentpicture := chem_stack_p [chem_stack_n] ; + chem_stack_p[chem_stack_n] := nullpicture ; + chem_origin := chem_stack_origin [chem_stack_n] ; + chem_rotation := chem_stack_rotation[chem_stack_n] ; + chem_mirror := chem_stack_mirror [chem_stack_n] ; + chem_previous := chem_stack_previous[chem_stack_n] ; + chem_stack_n := chem_stack_n - 1 ; + fi ; enddef ; -vardef chem_ss (expr n, f, t, r, c) = - chem_draw (n, chem_ss_path[n], f, t, r, c) ; -enddef ; +% chem_adj and chem_sub are to be followed by chem_set(n) which does all the work... -vardef chem_mid (expr n, r, c) = - chem_draw_fixed (n, chem_midt_path[n], r, c) ; - chem_draw_fixed (n, chem_midb_path[n], r, c) ; +vardef chem_adj (suffix $) (expr d, s) = % ADJ + % scale s is ignored (for now?) + if not chem_front[$] : + chem_substituent := 0 ; + chem_substituent.lft := 0 ; + chem_substituent.rt := 0 ; + chem_adjacent := d ; + fi enddef ; -vardef chem_mids (expr n, r, c) = - chem_draw_fixed (n, chem_midst_path[n], r, c) ; - chem_draw_fixed (n, chem_midsb_path[n], r, c) ; +vardef chem_lsub (suffix $) (expr d, s) = % LSUB + chem_sub.lft($,d,s) ; enddef ; -vardef chem_mss (expr n, f, t, r, c) = - chem_draw (n, chem_mss_path[n], f, t, r, c) ; +vardef chem_rsub (suffix $) (expr d, s) = % RSUB + chem_sub.rt ($,d,s) ; enddef ; -vardef chem_pss (expr n, f, t, r, c) = - chem_draw (n, chem_pss_path[n], f, t, r, c) ; +vardef chem_sub@# (suffix $) (expr d, s) = % SUB + % scale s is ignored (for now?) + chem_adjacent := 0 ; + chem_substituent := 0 ; + chem_substituent.lft := 0 ; + chem_substituent.rt := 0 ; + % then : + chem_substituent@# := d ; enddef ; -vardef chem_msb (expr n, f, t, r, c) = - chem_draw (n, chem_msb_path[n], f, t, r, c) ; +def chem_transformed (suffix $) = % not vardef! + scaled chem_b_length + if not chem_front[$] : + if chem_mirror<>origin : reflectedabout(origin,chem_mirror) fi + rotated chem_rotation + fi enddef ; -vardef chem_psb (expr n, f, t, r, c) = - chem_draw (n, chem_psb_path[n], f, t, r, c) ; +vardef chem_draw (expr what, r, c) (text extra) = + draw what + withpen pencircle scaled r + withcolor c %\MPcolor{c} + extra ; enddef ; -vardef chem_eb (expr n, f, t, r, c) = - chem_draw (n, chem_eb_path[n], f, t, r, c) ; +vardef chem_fill (expr what, r, c) (text extra) = + fill what + withpen pencircle scaled r + withcolor c %\MPcolor{c} + extra ; enddef ; -vardef chem_db (expr n, f, t, r, c) = - if n = 1 : - chem_draw (n, chem_msb_path [n], f, t, r, c) ; - chem_draw (n, chem_psb_path [n], f, t, r, c) ; - else : - chem_draw (n, chem_dbl_path [n], f, t, r, c) ; - chem_draw (n, chem_dbr_path [n], f, t, r, c) ; - fi ; +vardef chem_drawarrow (expr what, r, c) (text extra) = + drawarrow what + withpen pencircle scaled r + withcolor c %\MPcolor{c} + extra ; enddef ; -vardef chem_er (expr n, f, t, r, c) = - chem_draw (n, chem_rl_path[n], f, t, r, c) ; - chem_draw (n, chem_rr_path[n], f, t, r, c) ; -enddef ; +vardef chem_set (suffix $) = + forsuffixes P = scantokens chem_previous : -vardef chem_dr (expr n, f, t, r, c) = - chem_draw (n, chem_srl_path[n], f, t, r, c) ; - chem_draw (n, chem_srr_path[n], f, t, r, c) ; -enddef ; + % This is a fairly complicated optimization and ajustement. It took some + % thinking to get right, so beware! -vardef chem_ad (expr n, f, t, r, c) = - chem_draw_arrow(n, chem_ad_path[n], f, t, r, c) ; -enddef ; + if (chem_adjacent<>0) and chem_star[P] and chem_star[$] : + % nop + chem_adjacent := 0 ; + elseif (chem_adjacent<>0) and (chem_front[P] or chem_front[$]) : + % not allowed for FRONT + chem_adjacent := 0 ; + elseif chem_adjacent<>0 : + chem_substituent := 0 ; + chem_substituent.lft := 0 ; + chem_substituent.rt := 0 ; + % move to the bond midpoint of the first structure + chem_pair0 := center ( + if chem_star[P] : + origin -- point (chem_adjacent-1) + else : + subpath (chem_adjacent-1,chem_adjacent) + fi + of chem_b_path[P] + ) chem_transformed(P) ; + % find the closest opposite bond of the second structure + chem_pair1 := chem_pair0 rotated if chem_star[P] : 90 else : 180 fi ; + chem_num0 := abs(chem_pair1) ; + chem_num1 := if chem_tetra[$] : 1 else : length chem_b_path[$] fi ; + % only consider even indices (cardinal points) for ONE + chem_num2 := if chem_star[$] and not chem_tetra[$] : 2 else : 1 fi ; + for i=0 step chem_num2 until chem_num1 : + chem_pair2 := ( + ( + unitvector + center ( + if chem_star[$] : + origin -- point i + else : + subpath (i,i+1) + fi + of chem_b_path[$]) + ) + scaled chem_num0 + ) chem_transformed($) ; + if i=0 : + chem_pair3 := chem_pair2 ; + chem_num3 := 0 ; + elseif (abs(chem_pair1 shifted -chem_pair2)) < (abs(chem_pair1 shifted -chem_pair3)) : + chem_pair3 := chem_pair2 ; + chem_num3 := i ; + fi + endfor + if chem_star[$] : + chem_pair4 := chem_pair0 shifted + -((point (chem_adjacent-1) of chem_b_path[P]) chem_transformed(P)) ; + fi + % adjust the bond angles + chem_rotation := (chem_rotation + angle(chem_pair1)-angle(chem_pair3)) mod 360 ; + if not chem_star[$] : + chem_pair4 := + if chem_star[P] : + (point chem_num3 + else : + center(subpath (chem_num3,chem_num3+1) + fi + of chem_b_path[$]) + chem_transformed($) ; + fi + if not chem_star[P] : + chem_pair4 := chem_pair4 shifted -chem_pair0 ; + fi + currentpicture := currentpicture shifted chem_pair4 ; + chem_origin := chem_origin shifted chem_pair4 ; + chem_adjacent := 0 ; + fi ; -vardef chem_au (expr n, f, t, r, c) = - chem_draw_arrow(n, chem_au_path[n], f, t, r, c) + % Insure that only one, if any, will be nonzero + if ((chem_substituent <> 0) and (chem_substituent.lft <> 0)) or + ((chem_substituent <> 0) and (chem_substituent.rt <> 0)) or + ((chem_substituent.lft <> 0) and (chem_substituent.rt <> 0)) : + chem_substituent := 0 ; + chem_substituent.lft := 0 ; + chem_substituent.rt := 0 ; + fi + if (chem_substituent <> 0) or (chem_substituent.lft <> 0) or (chem_substituent.rt <> 0) : + % move origin to radical endpoint of the first structure + if chem_substituent.lft > 0 : + chem_pair0 := point chem_substituent.lft-1 of chem_r_path.lft[P] ; + chem_substituent := chem_substituent.lft ; + chem_substituent.lft := 0 ; + elseif chem_substituent.rt > 0 : + chem_pair0 := point chem_substituent.rt-1 of chem_r_path.rt[P] ; + chem_substituent := chem_substituent.rt ; + chem_substituent.rt := 0 ; + else : + chem_pair0 := point chem_substituent-1 of chem_r_path[P] ; + fi + chem_pair1 := chem_pair0 if not chem_star[P] : + shifted -(point chem_substituent-1 of chem_b_path[P]) fi ; + chem_t := identity chem_transformed(P) ; + chem_pair0 := chem_pair0 transformed chem_t ; % radical + chem_pair1 := chem_pair1 transformed chem_t ; % recentered (see below) + currentpicture := currentpicture shifted -chem_pair0 ; + chem_origin := chem_origin shifted -chem_pair0 ; + if (not (chem_star[P] and chem_star[$])) or chem_tetra[P] or chem_tetra[$] : + if chem_tetra[P] and chem_tetra[$] and ((chem_substituent=1) or (chem_substituent=2)): + chem_rotation := (chem_rotation + 180) mod 360 ; % trans-alkane + chem_pair2 := (point .5 of chem_b_path[$]) ; % bisector, not chem_transformed + if chem_mirror=origin : + chem_mirror := chem_pair2 ; + else : + chem_num0 := angle(chem_mirror)-angle(chem_pair2) ; + if (chem_num0>0) and (chem_num0> 180) : + chem_num0 := 360 - chem_num0 ; + elseif (chem_num0<0) and (chem_num0<-180) : + chem_num0 := -360 - chem_num0 ; + fi + chem_rotation := (chem_rotation + 2chem_num0) mod 360 ; + chem_mirror := origin ; + fi + fi + chem_t := identity chem_transformed($) ; + chem_pair1 := chem_pair1 rotated 180 ; % opposite direction of radical bond + % find the closest node + chem_num0 := abs(chem_pair1) ; % distance + % search to find the nearest node of $; only consider 1 and 2 for CARBON,ALKYL + chem_num1 := if chem_tetra[$] : 1 else : length chem_b_path[$] fi ; + % only consider even indices (cardinal points) for ONE + chem_num2 := if chem_star[$] and not chem_tetra[$] : 2 else : 1 fi ; + for i=0 step chem_num2 until chem_num1 : + chem_pair2 := (unitvector(point i of chem_b_path[$]) scaled chem_num0) + transformed chem_t ; + if i=0 : + chem_pair3 := chem_pair2 ; + chem_num3 := 0 ; + elseif (abs(chem_pair1 shifted -chem_pair2)) < + (abs(chem_pair1 shifted -chem_pair3)) : + chem_pair3 := chem_pair2 ; + chem_num3 := i ; + fi + endfor + if not chem_front[$] : % adjust rotation + chem_rotation := (chem_rotation + angle(chem_pair1)-angle(chem_pair3)) mod 360 ; + fi ; + chem_t := identity chem_transformed($) ; + chem_pair4 := (point chem_num3 of chem_b_path[$]) transformed chem_t ; + if not chem_star[$] : + currentpicture := currentpicture shifted chem_pair4 ; + chem_origin := chem_origin shifted chem_pair4 ; + fi + fi + chem_substituent := 0 ; + fi ; + endfor + chem_previous := str $ ; enddef ; -vardef chem_r (expr n, f, t, r, c) = - if n < 0 : - chem_draw_vertical (n, chem_r_path[n], f, t, r, c) ; +% line (f_rom, t_o, r_ule, c_olor) + +vardef chem_b@# (suffix $) (expr f, t, r, c) = % B + if chem_star[$] : + chem_r@#($,f,t,r,c) ; + elseif length(str @#)>0 : + chem_sb@#($,f,t,r,c) ; else : - chem_draw (n, chem_r_path[n], f, t, r, c) ; - fi ; + chem_draw( + (subpath (f-1,t) of chem_b_path[$]) chem_transformed($), + r,c,) ; + fi enddef ; -vardef chem_rd (expr n, f, t, r, c) = - chem_dashed_normal (n, chem_r_path[n], f, t, r, c) +vardef chem_sb@# (suffix $) (expr f, t, r, c) = % SB + if chem_star[$] : + chem_sr@#($,f,t,r,c) ; + else : + %chem_draw( + % (subpath (f-1,t) of chem_b_path[$]) chem_transformed($), + % r,c,dashed chem_sb_dash@# scaled chem_b_length) ; + chem_t := identity chem_transformed($) ; + for i=f upto t : + chem_draw( + (subpath (chem_sb_pair@# shifted (i-1,i-1)) of chem_b_path[$]) + transformed chem_t, + r,c,) ; + endfor + fi enddef ; -vardef chem_mrd (expr n, f, t, r, c) = - chem_dashed_normal (n, chem_mr_path[n], f, t, r, c) +vardef chem_sd@# (suffix $) (expr f, t, r, c) = % SD + if chem_star[$] : + chem_rd@#($,f,t,r,c) ; + else : + chem_t := identity chem_transformed($) ; + for i=f upto t : + chem_draw( + (subpath (chem_sb_pair@# shifted (i-1,i-1)) of chem_b_path[$]) + transformed chem_t, + r,c,dashed evenly) ; + endfor + fi enddef ; -vardef chem_prd (expr n, f, t, r, c) = - chem_dashed_normal (n, chem_pr_path[n], f, t, r, c) +vardef chem_r_fragment@# (suffix $) (expr i) = + ( + if chem_star[$] : + origin + else : + point i-1 of chem_b_path[$] + fi -- + point i-1 of chem_r_path@#[$] + ) % no ; enddef ; -vardef chem_br (expr n, f, t, r, c) = - chem_fill (n, chem_br_path[n], f, t, r, c ) +vardef chem_r@# (suffix $) (expr f, t, r, c) = % R + if length(str @#)>0 : + chem_sr@#($,f,t,r,c) ; + else : + chem_sr.b($,f,t,r,c) ; + fi enddef ; -vardef chem_rb (expr n, f, t, r, c) = - chem_fill (n, chem_rb_path[n], f, t, r, c) +vardef chem_er@# (suffix $) (expr f, t, r, c) = % ER + if length(str @#)>0: + chem_dr@#($,f,t,r,c) ; + else : + chem_dr.b($,f,t,r,c) ; + fi enddef ; -vardef chem_mrb (expr n, f, t, r, c) = - chem_fill (n, chem_mrb_path[n], f, t, r, c) +vardef chem_dr@# (suffix $) (expr f, t, r, c) = % DR + if not chem_front[$] : + chem_t := identity chem_transformed($) ; + for i=f upto t : + chem_path0 := (subpath chem_sb_pair@# of chem_r_fragment($,i)) ; + chem_draw( + (chem_path0 paralleled chem_dbl_offset) transformed chem_t, + r,c,) ; + chem_draw( + (chem_path0 paralleled -chem_dbl_offset) transformed chem_t, + r,c,) ; + endfor + fi enddef ; -vardef chem_prb (expr n, f, t, r, c) = - chem_fill (n, chem_prb_path[n], f, t, r, c) +vardef chem_lr@# (suffix $) (expr f, t, r, c) = % LR + if length(str @#)>0 : + chem_lsr@#($,f,t,r,c) ; + else : + chem_lsr.b($,f,t,r,c) ; + fi enddef ; -vardef chem_mr (expr n, f, t, r, c) = - if n < 0 : - chem_draw_vertical(n, chem_mr_path[n], f, t, r, c) +vardef chem_rr@# (suffix $) (expr f, t, r, c) = % RR + if length(str @#)>0 : + chem_rsr@#($,f,t,r,c) ; else : - chem_draw (n, chem_mr_path[n], f, t, r, c) + chem_rsr.b($,f,t,r,c) ; fi enddef ; -vardef chem_pr (expr n, f, t, r, c) = - if n < 0 : - chem_draw_vertical(n, chem_pr_path[n], f, t, r, c) - else : - chem_draw (n, chem_pr_path[n], f, t, r, c) +vardef chem_eb@# (suffix $) (expr f, t, r, c) = % EB + if not chem_star[$] : + %chem_draw( + % ((subpath (f-1,t) of chem_b_path[$]) paralleled -2chem_dbl_offset) + % chem_transformed($), + % r,c,dashed chem_sb_dash scaled chem_b_length) ; + for i=f upto t : + chem_t := identity chem_transformed($) ; + chem_draw( + ((subpath (chem_sb_pair@# shifted (i-1,i-1)) of chem_b_path[$]) + paralleled -2chem_dbl_offset) transformed chem_t, + r,c,) ; + endfor fi enddef ; -vardef chem_sr (expr n, f, t, r, c) = - chem_draw (n, chem_sr_path[n], f, t, r, c) +vardef chem_ad@# (suffix $) (expr f, t, r, c) = % AD + if not chem_star[$] : + chem_t := identity chem_transformed($) ; + for i=f upto t : + chem_drawarrow( + ((subpath (chem_sb_pair@# shifted (i-1,i-1)) of chem_b_path[$]) + paralleled 2chem_dbl_offset) transformed chem_t, + r,c,) ; + endfor + fi enddef ; -vardef chem_msr (expr n, f, t, r, c) = - chem_draw (n, chem_msr_path[n], f, t, r, c) +vardef chem_au@# (suffix $) (expr f, t, r, c) = % AU + if not chem_star[$] : + chem_t := identity chem_transformed($) ; + for i=f upto t : + chem_drawarrow( + reverse( + (subpath (chem_sb_pair@# shifted (i-1,i-1)) of chem_b_path[$]) + paralleled 2chem_dbl_offset) transformed chem_t, + r,c,) ; + endfor + fi enddef ; -vardef chem_psr (expr n, f, t, r, c) = - chem_draw (n, chem_psr_path[n], f, t, r, c) +vardef chem_es@# (suffix $) (expr f, t, r, c) = % ES + if chem_star[$] : + chem_t := identity chem_transformed($) ; + for i=f upto t : + chem_draw( + ((point i-1 of chem_r_path[$]) scaled (xpart chem_sb_pair)) transformed chem_t, + chem_dot_factor*r,c,) ; + endfor + fi enddef ; -vardef chem_c (expr n, f, t, r, c) = - chem_draw (n, chem_c_path[n], f, t, r, c) +vardef chem_ed@# (suffix $) (expr f, t, r, c) = % ED + chem_t := identity chem_transformed($) ; + for i=f upto t : + if chem_star[$] : + chem_path0 := subpath chem_sb_pair of chem_r_fragment($,i) ; + chem_draw( + (point 0 of (chem_path0 paralleled -chem_dbl_offset)) transformed chem_t, + chem_dot_factor*r,c,) ; + chem_draw( + (point 0 of (chem_path0 paralleled chem_dbl_offset)) transformed chem_t, + chem_dot_factor*r,c,) ; + else : + chem_draw( + ((subpath (chem_sb_pair shifted (i-1,i-1)) of chem_b_path[$]) + paralleled -2chem_dbl_offset) transformed chem_t, + r,c,dashed evenly) ; + fi + endfor +enddef ; + +vardef chem_ep@# (suffix $) (expr f, t, r, c) = % EP + if chem_star[$] : + chem_t := identity chem_transformed($) ; + for i=f upto t : + chem_path0 := subpath chem_sb_pair of chem_r_fragment($,i) ; + chem_draw( + (point 0 of (chem_path0 paralleled -chem_dbl_offset) -- + point 0 of (chem_path0 paralleled chem_dbl_offset)) transformed chem_t, + r,c,) ; + endfor + fi enddef ; -vardef chem_cc (expr n, f, t, r, c) = - chem_draw (n, chem_cc_path[n], f, f, r, c) +vardef chem_et@# (suffix $) (expr f, t, r, c) = % ET + if chem_star[$] : + chem_t := identity chem_transformed($) ; + for i=f upto t : + chem_path0 := subpath chem_sb_pair of chem_r_fragment($,i) ; + chem_draw( + (point 0 of (chem_path0 paralleled -2chem_dbl_offset)) transformed chem_t, + chem_dot_factor*r,c,) ; + chem_draw( + (point 0 of chem_path0) transformed chem_t, + chem_dot_factor*r,c,) ; + chem_draw( + (point 0 of (chem_path0 paralleled 2chem_dbl_offset)) transformed chem_t, + chem_dot_factor*r,c,) ; + endfor + fi enddef ; -vardef chem_cd (expr n, f, t, r, c) = - chem_dashed_connected (n, chem_c_path[n], f, t, r, c) +vardef chem_db@# (suffix $) (expr f, t, r, c) = % DB + if chem_star[$] : + chem_dr@#($,f,t,r,c) ; + elseif not chem_front[$] : + chem_t := identity chem_transformed($) ; + %chem_draw( + % ((subpath (f-1,t) of chem_b_path[$]) paralleled -chem_dbl_offset) + % transformed chem_t, + % r,c,dashed chem_sb_dash@# scaled chem_b_length) ; + %chem_draw( + % ((subpath (f-1,t) of chem_b_path[$]) paralleled chem_dbl_offset) + % transformed chem_t, + % r,c,dashed chem_sb_dash@# scaled chem_b_length) ; + for i=f upto t : + chem_path0 := subpath (chem_sb_pair@# shifted (i-1,i-1)) of chem_b_path[$] ; + chem_draw( + (chem_path0 paralleled -chem_dbl_offset) transformed chem_t, + r,c,) ; + chem_draw( + (chem_path0 paralleled chem_dbl_offset) transformed chem_t, + r,c,) ; + % todo : this should be cut-off where it overlaps a neighboring standard bond. + endfor + fi enddef ; -vardef chem_ccd (expr n, f, t, r, c) = - chem_dashed_normal (n, chem_cc_path[n], f, f, r, c) +vardef chem_tb@# (suffix $) (expr f, t, r, c) = % TB + if chem_star[$] : + chem_t := identity chem_transformed($) ; + for i=f upto t : + chem_path0 := subpath chem_sb_pair@# of chem_r_fragment($,i) ; + chem_draw( + (chem_path0 paralleled -2chem_dbl_offset) transformed chem_t, + r,c,) ; + chem_draw( + chem_path0 transformed chem_t, + r,c,) ; + chem_draw( + (chem_path0 paralleled 2chem_dbl_offset) transformed chem_t, + r,c,) ; + endfor + fi enddef ; -vardef chem_rn (expr n, i, t) = - chem_rt (n,i,t) ; +vardef chem_sr@# (suffix $) (expr f, t, r, c) = % SR + chem_t := identity chem_transformed($) ; + if chem_stacked[$] : + chem_num0 := length chem_b_path[$] ; chem_num1 := floor(.5chem_num0) ; + for i=f upto t : + chem_draw( + (subpath (if i>chem_num1: .5,ypart fi chem_sb_pair@#) of chem_r_fragment($,i)) + transformed chem_t, + r,c,) ; + endfor + else : + for i=f upto t : + chem_draw( + (subpath chem_sb_pair@# of chem_r_fragment($,i)) + transformed chem_t, + r,c,) ; + endfor + fi enddef ; -vardef chem_rtn (expr n, i, t) = - chem_rtt(n,i,t) ; +vardef chem_rd@# (suffix $) (expr f, t, r, c) = % RD + chem_t := identity chem_transformed($) ; + if chem_stacked[$] : + chem_num0 := length chem_b_path[$] ; chem_num1 := floor(.5chem_num0) ; + for i=f upto t : + chem_draw( + (subpath (if i>chem_num1: .5,ypart fi chem_sb_pair@#) of chem_r_fragment($,i)) + transformed chem_t, + r,c,dashed evenly) ; + endfor + else : + for i=f upto t : + chem_draw( + (subpath chem_sb_pair@# of chem_r_fragment($,i)) + transformed chem_t, + r,c,dashed evenly) ; + endfor + fi enddef ; -vardef chem_rbn (expr n, i, t) = - chem_rbt(n,i,t) ; +vardef chem_rh@# (suffix $) (expr f, t, r, c) = % RH + chem_t := identity chem_transformed($) ; + for i=f upto t : + chem_draw( + (subpath chem_sb_pair@# of chem_r_fragment($,i)) + transformed chem_t, + chem_dot_factor*r,c,dashed withdots scaled ((.5chem_b_length/3)/5bp)) ; + % not symmetric - needs to be tweaked... + endfor +enddef ; + +vardef chem_lrh@# (suffix $) (expr f, t, r, c) = % LRH + chem_t := identity chem_transformed($) ; + for i=f upto t : + chem_draw( + (subpath chem_sb_pair@# of chem_r_fragment.lft($,i)) + transformed chem_t, + chem_dot_factor*r,c,dashed withdots scaled ((.5chem_b_length/3)/5bp)) ; + % not symmetric - needs to be tweaked... + endfor +enddef ; + +vardef chem_rrh@# (suffix $) (expr f, t, r, c) = % RRH + chem_t := identity chem_transformed($) ; + for i=f upto t : + chem_draw( + (subpath chem_sb_pair@# of chem_r_fragment.rt($,i)) + transformed chem_t, + chem_dot_factor*r,c,dashed withdots scaled ((.5chem_b_length/3)/5bp)) ; + % not symmetric - needs to be tweaked... + endfor +enddef ; + +vardef chem_hb@# (suffix $) (expr f, t, r, c) = % HB + if chem_star[$] : + chem_rh@#($,f,t,r,c) + fi enddef ; -vardef chem_tb (expr n, f, t, r, c) = % one - chem_draw (n, chem_msb_path[n], f, t, r, c) ; - chem_draw (n, chem_sb_path [n], f, t, r, c) ; - chem_draw (n, chem_psb_path[n], f, t, r, c) ; +vardef chem_bb@# (suffix $) (expr f, t, r, c) = % BB + if chem_star[$] : + chem_rb@#($,f,t,r,c) ; + elseif chem_front[$] : + chem_t := identity chem_transformed($) ; + chem_draw( + (subpath (f-1,t) of chem_b_path[$]) transformed chem_t, + r,c,) ; + chem_num0 := length chem_b_path[$] ; % total number of bonds + chem_num1 := chem_front_b[$] ; % number of bonds to be made bold + % bold bonds within f and t + chem_num2 := if f<0 :((f+1) mod chem_num0) + chem_num0 else : ((f-1) mod chem_num0) + 1 fi ; + chem_num3 := if t<0 :((t+1) mod chem_num0) + chem_num0 else : ((t-1) mod chem_num0) + 1 fi ; + if chem_num3<chem_num2 : + chem_num4 := chem_num3 ; + chem_num3 := chem_num2 ; + chem_num2 := chem_num4 ; + fi + if chem_num2<chem_num1 : % Are there any bonds to be made bold? + if chem_num2=1 : % Skip the first bold bond. + chem_fill( + (point chem_num2-1 of chem_b_path[$] -- + point chem_num2 of chem_b_path[$] shifted (0,-chem_dbl_offset) -- + point chem_num2 of chem_b_path[$] shifted (0, chem_dbl_offset) -- + cycle) transformed chem_t, + r,c,) ; + fi + if (chem_num2<=chem_num1-1) and (chem_num3>1) : + chem_path0 := subpath (if chem_num2>2 : chem_num2-1 else : 1 fi, + if chem_num3<chem_num1 : chem_num3 else : chem_num1-1 fi) + of chem_b_path[$] ; + chem_fill( + (chem_path0 paralleled -chem_dbl_offset -- + reverse(chem_path0) paralleled -chem_dbl_offset -- + cycle) transformed chem_t, + r,c,) ; + fi + if chem_num3>=chem_num1 : + chem_fill( + (point chem_num1 of chem_b_path[$] -- + point chem_num1-1 of chem_b_path[$] shifted (0,-chem_dbl_offset) -- + point chem_num1-1 of chem_b_path[$] shifted (0, chem_dbl_offset) -- + cycle) transformed chem_t, + r,c,) ; + fi + fi + fi enddef ; -vardef chem_ep (expr n, f, t, r, c) = % one - chem_draw (n, chem_e_path[n], f, t, r, c) ; +vardef chem_rb@# (suffix $) (expr f, t, r, c) = % RB + chem_t := identity chem_transformed($) ; + for i=f upto t : + chem_path0 := subpath chem_sb_pair@# of chem_r_fragment($,i) ; + chem_fill( + (point 0 of chem_path0 -- + point 1 of chem_path0 + rotatedaround(point 0 of chem_path0, -chem_bb_angle) -- + point 1 of chem_path0 + rotatedaround(point 0 of chem_path0, chem_bb_angle) -- + cycle) transformed chem_t, + r,c,) ; + endfor +enddef ; + +vardef chem_lrb@# (suffix $) (expr f, t, r, c) = % LRB + if not chem_star[$] : + chem_t := identity chem_transformed($) ; + for i=f upto t : + chem_path0 := subpath chem_sb_pair@# of chem_r_fragment.lft($,i) ; + chem_fill( + (point 0 of chem_path0 -- + point 1 of chem_path0 + rotatedaround(point 0 of chem_path0, -chem_bb_angle) -- + point 1 of chem_path0 + rotatedaround(point 0 of chem_path0, chem_bb_angle) -- + cycle) transformed chem_t, + r,c,) ; + endfor + fi enddef ; -vardef chem_es (expr n, f, t, r, c) = % one - chem_draw_dot (n, center chem_e_path[n], f, t, r, c) ; +vardef chem_rrb@# (suffix $) (expr f, t, r, c) = % RRB + if not chem_star[$] : + chem_t := identity chem_transformed($) ; + for i=f upto t : + chem_path0 := subpath chem_sb_pair@# of chem_r_fragment.rt($,i) ; + chem_fill( + (point 0 of chem_path0 -- + point 1 of chem_path0 + rotatedaround(point 0 of chem_path0, -chem_bb_angle) -- + point 1 of chem_path0 + rotatedaround(point 0 of chem_path0, chem_bb_angle) -- + cycle) transformed chem_t, + r,c,) ; + endfor + fi enddef ; -vardef chem_ed (expr n, f, t, r, c) = % one - chem_draw_dot (n, point 0 of chem_e_path[n], f, t, r, c) ; - chem_draw_dot (n, point 1 of chem_e_path[n], f, t, r, c) ; +vardef chem_lsr@# (suffix $) (expr f, t, r, c) = % LSR + if not chem_star[$] : + chem_t := identity chem_transformed($) ; + for i=f upto t : + chem_draw( + (subpath chem_sb_pair@# of chem_r_fragment.lft($,i)) transformed chem_t, + r,c,) ; + endfor + fi enddef ; -vardef chem_et (expr n, f, t, r, c) = % one - chem_draw_dot (n, point 0 of chem_e_path[n], f, t, r, c) ; - chem_draw_dot (n, center chem_e_path[n], f, t, r, c) ; - chem_draw_dot (n, point 1 of chem_e_path[n], f, t, r, c) ; +vardef chem_rsr@# (suffix $) (expr f, t, r, c) = % RSR + if not chem_star[$] : + chem_t := identity chem_transformed($) ; + for i=f upto t : + chem_draw( + (subpath chem_sb_pair@# of chem_r_fragment.rt($,i)) transformed chem_t, + r,c,) ; + endfor + fi enddef ; -vardef chem_sd (expr n, f, t, r, c) = % one - chem_draw (n, chem_ddt_path[n], f, t, r, c) ; - chem_draw (n, chem_ddb_path[n], f, t, r, c) ; +vardef chem_lrd@# (suffix $) (expr f, t, r, c) = % LRD + if not chem_star[$] : + chem_t := identity chem_transformed($) ; + for i=f upto t : + chem_draw( + (subpath chem_sb_pair@# of chem_r_fragment.lft($,i)) transformed chem_t, + r,c,dashed evenly) ; + endfor + fi enddef ; -vardef chem_rdd (expr n, f, t, r, c) = % one - chem_draw (n, chem_ldt_path[n], f, t, r, c) ; - chem_draw (n, chem_ldb_path[n], f, t, r, c) ; - chem_draw (n, chem_psb_path[n], f, t, r, c) ; +vardef chem_rrd@# (suffix $) (expr f, t, r, c) = % RRD + if not chem_star[$] : + chem_t := identity chem_transformed($) ; + for i=f upto t : + chem_draw( + (subpath chem_sb_pair@# of chem_r_fragment.rt($,i)) transformed chem_t, + r,c,dashed evenly) ; + endfor + fi enddef ; -vardef chem_ldd (expr n, f, t, r, c) = % one - chem_draw (n, chem_msb_path[n], f, t, r, c) ; - chem_draw (n, chem_rdt_path[n], f, t, r, c) ; - chem_draw (n, chem_rdb_path[n], f, t, r, c) ; +vardef chem_s@# (suffix $) (expr f, t, r, c) = % S + if length(str @#)>0 : + chem_ss@#($,f,t,r,c) ; + else : + chem_ss.b($,f,t,r,c) ; + fi enddef ; -vardef chem_hb (expr n, f, t, r, c) = % one - chem_draw_dot (n, point 0 of chem_sb_path[n], f, t, r, c) ; - chem_draw_dot (n, center chem_sb_path[n], f, t, r, c) ; - chem_draw_dot (n, point 1 of chem_sb_path[n], f, t, r, c) ; +vardef chem_ss@# (suffix $) (expr f, t, r, c) = % SS + if not (chem_star[$] or chem_front[$]) : + chem_draw( + subpath chem_sb_pair@# of (point f-2 of chem_b_path[$] -- point t of chem_b_path[$]) + chem_transformed($), + r,c,) ; + fi enddef ; -vardef chem_bb (expr n, f, t, r, c) = % one - if n < 0 : - chem_fill (n, chem_bb_path[n], 1, 1, r, c) ; - chem_b (n, f, t, r, c) ; +vardef chem_mid@# (suffix $) (expr f, t, r, c) = % MID + if length(str @#)>0 : + chem_mids@#($,f,t,r,c) ; else : - chem_fill (n, chem_bb_path[n], f, t, r, c) ; - fi ; + chem_mids.b($,f,t,r,c) ; + fi enddef ; -vardef chem_oe (expr n, f, t, r, c) = % one - chem_draw (n, chem_oe_path[n], f, t, r, c) ; +vardef chem_mids@# (suffix $) (expr f, t, r, c) = % MIDS + if not (chem_star[$] or chem_front[$]) : + chem_t := identity chem_transformed($) ; + for i=f upto t : + chem_draw( + (subpath chem_sb_pair@# of (origin -- point i-1 of chem_b_path[$])) + transformed chem_t, + r,c,) ; + endfor + fi enddef ; -vardef chem_bd (expr n, f, t, r, c) = % one - for i=0 upto 5 : - chem_draw (n, subpath (2i,2i+1) of chem_bd_path[n], f, t, r, c) ; - endfor ; +vardef chem_cd (suffix $) (expr r, c) = % CD + chem_draw( + chem_c_path[$] chem_transformed($), + r,c,dashed evenly) ; enddef ; -vardef chem_bw (expr n, f, t, r, c) = % one - chem_draw (n, chem_bw_path[n], f, t, r, c) ; +vardef chem_c (suffix $) (expr r, c) = % C + chem_draw( + chem_c_path[$] chem_transformed($), + r,c,) ; enddef ; -vardef chem_z_zero@#(text t) = - chem_text@#(t, chem_do(origin)) ; +vardef chem_ccd (suffix $) (expr f, t, r, c) = % CCD + chem_num0 := ypart((origin--center(subpath (f-2,f-1) of chem_b_path[$])) + intersectiontimes chem_c_path[$]) ; + chem_num1 := ypart((origin--center(subpath (t-1,t) of chem_b_path[$])) + intersectiontimes chem_c_path[$]) ; + if chem_num1>chem_num0 : + chem_num0 := chem_num0 + length chem_c_path[$] ; + fi + chem_draw( + subpath (chem_num1,chem_num0) of chem_c_path[$] chem_transformed($), + r,c,dashed evenly) ; +enddef ; + +vardef chem_cc (suffix $) (expr f, t, r, c) = % CC + chem_num0 := ypart((origin--center(subpath (f-2,f-1) of chem_b_path[$])) + intersectiontimes chem_c_path[$]) ; + chem_num1 := ypart((origin--center(subpath (t-1,t) of chem_b_path[$])) + intersectiontimes chem_c_path[$]) ; + if chem_num1>chem_num0 : + chem_num0 := chem_num0 + length chem_c_path[$] ; + fi + chem_draw( + subpath (chem_num1,chem_num0) of chem_c_path[$] chem_transformed($), + r,c,) ; +enddef ; + +vardef chem_ldb@# (suffix $) (expr f, t, r, c) = % LD + if chem_star[$] : + chem_t := identity chem_transformed($) ; + for i=f upto t : + chem_path0 := subpath chem_sb_pair@# of chem_r_fragment($,i) ; + chem_draw( + chem_path0 transformed chem_t, + r,c,) ; + chem_draw( + (chem_path0 paralleled 2chem_dbl_offset) transformed chem_t, + r,c,) ; + endfor + fi enddef ; -vardef chem_cz_zero@#(text t) = - chem_text@#(t, chem_do(origin)) ; +vardef chem_rdb@# (suffix $) (expr f, t, r, c) = % LD + if chem_star[$] : + chem_t := identity chem_transformed($) ; + for i=f upto t : + chem_path0 := subpath chem_sb_pair@# of chem_r_fragment($,i) ; + chem_draw( + chem_path0 transformed chem_t, + r,c,) ; + chem_draw( + (chem_path0 paralleled -2chem_dbl_offset) transformed chem_t, + r,c,) ; + endfor + fi enddef ; -vardef chem_z@#(expr n, p) (text t) = - if p = 0 : - chem_text@#(t, chem_do(origin)) ; - else : - chem_text@#(t, chem_do(chem_b_zero[n] rotated chem_ang(n,p))) ; - fi ; +vardef chem_ldd@# (suffix $) (expr f, t, r, c) = % LDD + if chem_star[$] : + chem_t := identity chem_transformed($) ; + for i=f upto t : + chem_path0 := subpath chem_sb_pair@# of chem_r_fragment($,i) ; + chem_draw( + chem_path0 transformed chem_t, + r,c,) ; + chem_draw( + (chem_path0 paralleled 2chem_dbl_offset) transformed chem_t, + r,c,dashed evenly) ; + endfor + fi enddef ; -vardef chem_cz@#(expr n, p) (text t) = - if n = 1 : - chem_c_text(t, chem_do(chem_crz_zero[n] rotated chem_ang(n,p))) ; - else : - chem_text@#(t, chem_do(chem_b_zero[n] rotated chem_ang(n,p))) ; - fi ; +vardef chem_rdd@# (suffix $) (expr f, t, r, c) = % RDD + if chem_star[$] : + chem_t := identity chem_transformed($) ; + for i=f upto t : + chem_path0 := subpath chem_sb_pair@# of chem_r_fragment($,i) ; + chem_draw( + chem_path0 transformed chem_t, + r,c,) ; + chem_draw( + (chem_path0 paralleled -2chem_dbl_offset) transformed chem_t, + r,c,dashed evenly) ; + endfor + fi enddef ; -vardef chem_midz@#(expr n, p) (text t) = - chem_text@#(t, chem_do(chem_mid_zero[n] rotated chem_ang(n,p))) ; +vardef chem_oe@# (suffix $) (expr f, t, r, c) = % OE + if chem_star[$] : + chem_t := identity chem_transformed($) ; + for i=f upto t : + chem_path0 := subpath chem_sb_pair@# of chem_r_fragment($,i) ; + chem_path1 := chem_path0 paralleled -.5chem_dbl_offset ; + chem_path2 := chem_path0 paralleled .5chem_dbl_offset ; + chem_draw( + ( point 0 of chem_path0 -- + .2[point 0 of chem_path0, point infinity of chem_path0].. + .3[point 0 of chem_path1, point infinity of chem_path1].. + .4[point 0 of chem_path0, point infinity of chem_path0].. + .5[point 0 of chem_path2, point infinity of chem_path2].. + .6[point 0 of chem_path0, point infinity of chem_path0].. + .7[point 0 of chem_path1, point infinity of chem_path1].. + .8[point 0 of chem_path0, point infinity of chem_path0]-- + point infinity of chem_path0) transformed chem_t, + r,c,) ; + endfor + fi enddef ; -vardef chem_rz@#(expr n, p) (text t) = - if n < 0 : - % quite special - chem_text@#(t, chem_do(chem_r_zero[n] shifted (chem_b_zero[n] rotated chem_ang(n,p)))) ; - else : - chem_text@#(t, chem_do(chem_r_zero[n] rotated chem_ang(n,p))) ; - fi ; +vardef chem_bw@# (suffix $) (expr f, t, r, c) = % BW + if chem_star[$] : + chem_t := identity chem_transformed($) ; + for i=f upto t : + chem_path0 := subpath chem_sb_pair@# of chem_r_fragment($,i) ; + chem_path1 := chem_path0 paralleled -.5chem_dbl_offset ; + chem_path2 := chem_path0 paralleled .5chem_dbl_offset ; + chem_draw( + ( point 0 of chem_path0.. + .1[point 0 of chem_path1, point infinity of chem_path1].. + .2[point 0 of chem_path0, point infinity of chem_path0].. + .3[point 0 of chem_path2, point infinity of chem_path2].. + .4[point 0 of chem_path0, point infinity of chem_path0].. + .5[point 0 of chem_path1, point infinity of chem_path1].. + .6[point 0 of chem_path0, point infinity of chem_path0].. + .7[point 0 of chem_path2, point infinity of chem_path2].. + .8[point 0 of chem_path0, point infinity of chem_path0].. + .9[point 0 of chem_path1, point infinity of chem_path1].. + point infinity of chem_path0) transformed chem_t, + r,c,) ; + endfor + fi enddef ; -vardef chem_crz@#(expr n, p) (text tx) = - chem_text(tx, chem_do(chem_crz_zero[n] rotated chem_ang(n,p))) ; +vardef chem_bd@# (suffix $) (expr f, t, r, c) = % BD + if chem_star[$] : chem_rbd#@($,f,t,r,c) ; fi enddef ; -vardef chem_mrz@#(expr n, p) (text t) = - if n < 0 : - % quite special - chem_text@#(t, chem_do(chem_mr_zero[n] shifted (chem_b_zero[n] rotated chem_ang(n,p)))) ; - else : - chem_text@#(t, chem_do(chem_mr_zero[n] rotated chem_ang(n,p))) ; - fi ; +vardef chem_rbd@# (suffix $) (expr f, t, r, c) = % RBD + chem_t := identity chem_transformed($) ; + for i=f upto t : + chem_path0 := subpath chem_sb_pair@# of chem_r_fragment($,i) ; + if chem_bd_wedge : + chem_path1 := chem_path0 rotated -chem_bb_angle ; + chem_path2 := chem_path0 rotated chem_bb_angle ; + else : + chem_path1 := chem_path0 paralleled -chem_dbl_offset ; + chem_path2 := chem_path0 paralleled chem_dbl_offset ; + fi + for j=0 upto 3 : + chem_draw( + (point (j/3) of chem_path1 -- point (j/3) of chem_path2) transformed chem_t, + 2r,c,) ; + endfor + endfor +enddef ; + +vardef chem_lrbd@# (suffix $) (expr f, t, r, c) = % LRBD + if not chem_star[$] : + chem_t := identity chem_transformed($) ; + for i=f upto t : + chem_path0 := subpath chem_sb_pair@# of chem_r_fragment.lft($,i) ; + if chem_bd_wedge : + chem_path1 := chem_path0 rotated -chem_bb_angle ; + chem_path2 := chem_path0 rotated chem_bb_angle ; + else : + chem_path1 := chem_path0 paralleled -.5chem_dbl_offset ; + chem_path2 := chem_path0 paralleled .5chem_dbl_offset ; + fi + for j=0 upto 3 : + chem_draw( + (point (j/3) of chem_path1 -- point (j/3) of chem_path2) transformed chem_t, + 2r,c,) ; + endfor + endfor + fi enddef ; -vardef chem_prz@#(expr n, p) (text t) = - if n < 0 : - % quite special - chem_text@#(t, chem_do(chem_pr_zero[n] shifted (chem_b_zero[n] rotated chem_ang(n,p)))) ; - else : - chem_text@#(t, chem_do(chem_pr_zero[n] rotated chem_ang(n,p))) ; - fi ; +vardef chem_rrbd@# (suffix $) (expr f, t, r, c) = % RRBD + if not chem_star[$] : + chem_t := identity chem_transformed($) ; + for i=f upto t : + chem_path0 := subpath chem_sb_pair@# of chem_r_fragment.rt($,i) ; + if chem_bd_wedge : + chem_path1 := chem_path0 rotated -chem_bb_angle ; + chem_path2 := chem_path0 rotated chem_bb_angle ; + else : + chem_path1 := chem_path0 paralleled -.5chem_dbl_offset ; + chem_path2 := chem_path0 paralleled .5chem_dbl_offset ; + fi + for j=0 upto 3 : + chem_draw( + (point (j/3) of chem_path1 -- point (j/3) of chem_path2) transformed chem_t, + 2r,c,) ; + endfor + endfor + fi enddef ; -vardef chem_rt@#(expr n, p) (text t) = - chem_text@#(t, chem_do(chem_rt_zero[n] rotated chem_ang(n,p))) ; +% text, number (no alignment on number); + +vardef chem_z@#(suffix $) (expr p) (text t) = % Z + draw chem_text@# + (t,chem_do( + if p=0 : + origin + else : + (point p-1 of chem_b_path[$]) chem_transformed($) + fi + )) ; enddef ; -vardef chem_rtt@#(expr n, p) (text t) = - chem_text@#(t, chem_do(chem_rtt_zero[n] rotated chem_ang(n,p))) ; +vardef chem_cz@#(suffix $) (expr p) (text t) = chem_z@#($,p,t) ; enddef ; % CZ ? + +vardef chem_midz@#(suffix $) (expr p) (text t) = % MIDZ + if not (chem_star[$] or chem_front[$]) : + draw chem_text@# + (t,chem_do( + (xpart chem_sb_pair, 0) scaled (xpart point 0 of chem_b_path[$]) + chem_transformed($) + )) ; + fi enddef ; -vardef chem_rbt@#(expr n, p) (text t) = - chem_text@#(t, chem_do(chem_rbt_zero[n] rotated chem_ang(n,p))) ; +vardef chem_rz@#(suffix $) (expr p) (text t) = % RZ + draw chem_text@# + (t, chem_do((point p-1 of chem_r_path[$]) chem_transformed($))) ; enddef ; -vardef chem_zt@#(expr n, p) (text t) = - if n = 1 : - chem_text@#(t, chem_do(chem_rt_zero[n] rotated chem_ang(n,p))) ; - else : - chem_text@#(t, chem_do(chem_n_zero[n] rotated chem_ang(n,p))) ; - fi ; +vardef chem_lrz@#(suffix $) (expr p) (text t) = % LRZ + if not chem_star[$] : + draw chem_text@# + (t, + chem_do((point p-1 of chem_r_path.lft[$]) chem_transformed($))) ; + fi enddef ; -vardef chem_zn@#(expr n, p) (text t) = - if n = 1 : - chem_text@#(t, chem_do(chem_rt_zero[n] rotated chem_ang(n,p))) ; - else : - chem_text@#(t, chem_do(chem_n_zero[n] rotated chem_ang(n,p))) ; - fi ; +vardef chem_rrz@#(suffix $) (expr p) (text t) = % RRZ + if not chem_star[$] : + draw chem_text@# + (t, chem_do((point p-1 of chem_r_path.rt[$]) chem_transformed($))) ; + fi enddef ; -vardef chem_zbt@#(expr n, p) (text t) = - chem_text@#(t, chem_do(chem_rtt_zero[n] rotated chem_ang(n,p))) ; +vardef chem_zn@#(suffix $) (expr p) (text t) = % ZN + chem_zt($,p,t) ; enddef ; -vardef chem_zbn@#(expr n, p) (text t) = - chem_text@#(t, chem_do(chem_rtt_zero[n] rotated chem_ang(n,p))) ; +vardef chem_zt@#(suffix $) (expr p) (text t) = % ZT + draw chem_text@#(t,chem_do ((point p-1 of chem_b_path[$]) chem_transformed($) + scaled chem_text_min)) ; enddef ; -vardef chem_ztt@#(expr n, p) (text t) = - chem_text@#(t, chem_do(chem_rbt_zero[n] rotated chem_ang(n,p))) ; +vardef chem_zln@#(suffix $) (expr p) (text t) = % ZLN + chem_zlt($,p,t) ; enddef ; -vardef chem_ztn@#(expr n, p) (text t) = - chem_text@#(t, chem_do(chem_rbt_zero[n] rotated chem_ang(n,p))) ; +vardef chem_zlt@#(suffix $) (expr p) (text t) = % ZLT + draw chem_text@#(t, chem_do((point p-1.5 of chem_b_path[$]) chem_transformed($) + scaled chem_text_min)) ; enddef ; -vardef chem_symbol(expr t) = - draw textext(t) ; +vardef chem_zrn@#(suffix $) (expr p) (text t) = % ZRN + chem_zrt($,p,t) ; enddef ; -vardef chem_text@#(expr txt, z) = % adapted copy of thelabel@ - save p ; picture p ; - p := textext(txt) ; - p := p - if (mfun_labtype@# >= 10) : shifted (0,ypart center p) fi - shifted (z + chem_text_offset*mfun_laboff@# - (mfun_labxf@#*lrcorner p + mfun_labyf@#*ulcorner p + (1-mfun_labxf@#-mfun_labyf@#)*llcorner p)) ; - if chem_text_trace : - draw z withpen pencircle scaled 2pt withcolor red ; - draw boundingbox p withpen pencircle scaled 1pt withcolor red ; - fi ; - draw p +vardef chem_zrt@#(suffix $) (expr p) (text t) = % ZRT + draw chem_text@#(t, chem_do((point p-0.5 of chem_b_path[$]) chem_transformed($) + scaled chem_text_min)) ; enddef ; -vardef chem_c_text(expr txt, z) = % adapted copy of thelabel@ - save p ; picture p ; p := textext(txt) ; - save b ; path b ; b := (boundingbox p) shifted z ; - save a ; pair a ; a := (origin--z) intersection_point b ; - if intersection_found : - draw p shifted (z enlonged arclength(a -- center b)) ; - else : - draw p shifted z ; +vardef chem_crz@#(suffix $) (expr p) (text t) = % CRZ ???? + if chem_star[$] : + draw chem_text@#(t, chem_do((point p-1 of chem_b_path[$] enlonged chem_center_offset) + chem_transformed($))) ; fi -% draw b withcolor green ; -% draw a withcolor red ; enddef ; -vardef chem_ang (expr n, d) = - ((-1 * (d-1) * chem_angle[n]) + (-chem_rotation+1) * 90 + chem_start[n]) % no ; +vardef chem_rn@#(suffix $) (expr i, t) = % RN + chem_rt($,i,t) ; enddef ; -vardef chem_rot (expr n, d) = - chem_rotation := d ; +vardef chem_rt@#(suffix $) (expr p) (text t) = % RT + draw chem_text@#(t, chem_do((center chem_r_fragment($,p)) chem_transformed($))) ; enddef ; -vardef chem_adj (expr n, d) = - chem_adjacent := d ; +vardef chem_lrn@#(suffix $) (expr i, t) = % LRN + chem_lrt($,i,t) ; enddef ; -vardef chem_sub (expr n, d) = - chem_substituent := d ; +vardef chem_lrt@#(suffix $) (expr p) (text t) = % LRT + draw chem_text@#(t, chem_do((center chem_r_fragment.lft($,p)) chem_transformed($))) ; enddef ; -vardef chem_dir (expr n, d) = - if n = 1 : - chem_direction_p := (origin - 2*center(chem_b_path[n] rotated chem_ang(n,d+1))) ; - currentpicture := currentpicture shifted chem_direction_p ; - chem_shift := chem_shift + chem_direction_p ; - fi ; +vardef chem_rrn@# (suffix $) (expr i, t) = % RRN + chem_rrt($,i,t) ; enddef ; -vardef chem_mov (expr n, d) = - if d = 0 : - currentpicture := currentpicture shifted - chem_shift ; - chem_shift := origin ; - else : - chem_move_p := (origin - 2*center(chem_b_path[n] rotated chem_ang(n,d+chem_initialmov[n]))) ; - currentpicture := currentpicture shifted chem_move_p ; - chem_shift := chem_shift + chem_move_p ; - fi ; +vardef chem_rrt@#(suffix $) (expr p) (text t) = % RRT + draw chem_text@#(t, chem_do((center chem_r_fragment.rt($,p)) chem_transformed($))) ; enddef ; -vardef chem_off (expr n, d) = - if (d = 1) or (d = 2) or (d = 8) : % positive - currentpicture := currentpicture shifted (-chem_setting_offset,0) ; - chem_shift := chem_shift + (-chem_setting_offset,0) - elseif (d = 4) or (d = 5) or (d = 6) : % negative - currentpicture := currentpicture shifted ( chem_setting_offset,0) ; - chem_shift := chem_shift + ( chem_setting_offset,0) - fi ; +vardef chem_symbol(expr t) = draw textext(t) ; enddef ; + +vardef chem_align@#(expr pic) = + pic + if (mfun_labtype@# >= 10) : + shifted (0,ypart center pic) + fi + shifted (-(mfun_labxf@#*lrcorner pic + mfun_labyf@#*ulcorner pic + (1-mfun_labxf@#-mfun_labyf@#)*llcorner pic)) enddef ; -vardef chem_set(expr n, m) = - if chem_adjacent > 0 : - chem_adjacent_d := xpart chem_b_zero[n] + xpart chem_b_zero[m] ; - if chem_adjacent = 1 : chem_adjacent_p := (-chem_adjacent_d, 0) ; - elseif chem_adjacent = 2 : chem_adjacent_p := (0, -chem_adjacent_d) ; - elseif chem_adjacent = 3 : chem_adjacent_p := ( chem_adjacent_d, 0) ; - elseif chem_adjacent = 4 : chem_adjacent_p := (0, chem_adjacent_d) ; - else : chem_adjacent_p := origin ; - fi ; - currentpicture := currentpicture shifted chem_adjacent_p ; - chem_shift := chem_shift + chem_adjacent_p ; - chem_adjacent := 0 ; - fi ; - if chem_substituent > 0 : - if m = 1 : - chem_substituent_d := xpart chem_crz_zero[n] + chem_substituent_offset ; +vardef chem_text@#(expr txt, z) = + chem_pic := textext(txt) ; + if length(str @#)=0 : + chem_pic := chem_align(chem_pic) ; + elseif (str @#) = "auto" : + if z<>origin : + chem_num0 := abs(angle(z rotated chem_setting_rotation)) ; + if chem_num0<=60 : + chem_pic := chem_align.rt (chem_pic) xshifted chem_text_offset ; + elseif chem_num0>=120 : + chem_pic := chem_align.lft(chem_pic) xshifted -chem_text_offset ; + else : + chem_pic := chem_align (chem_pic) ; + fi + else : + chem_pic := chem_align (chem_pic) ; + fi else : - chem_substituent_d := xpart chem_crz_zero[n] + xpart chem_b_zero[m] ; - fi ; - if chem_substituent = 1 : chem_substituent_p := (-chem_substituent_d, 0) ; % - ? - elseif chem_substituent = 2 : chem_substituent_p := (0, chem_substituent_d) ; - elseif chem_substituent = 3 : chem_substituent_p := ( chem_substituent_d, 0) ; - elseif chem_substituent = 4 : chem_substituent_p := (0, -chem_substituent_d) ; - else : chem_substituent_p := origin ; - fi ; - currentpicture := currentpicture shifted chem_substituent_p ; - chem_shift := chem_shift + chem_substituent_p ; - chem_substituent := 0 ; - fi ; - chem_rotation := chem_initialrot[m] ; + chem_pic := chem_align@#(chem_pic) shifted (chem_text_offset*mfun_laboff@#) ; + fi + chem_pic := (chem_pic rotated -chem_setting_rotation) shifted z ; + + if chem_trace_text : + draw z withpen pencircle scaled 2pt withcolor red ; + draw boundingbox chem_pic withpen pencircle scaled 1pt withcolor red ; + fi + + chem_pic enddef ; -vardef chem_draw (expr n, path_fragment, from_point, to_point, linewidth, linecolor) = - for i:=from_point upto to_point: - draw (path_fragment rotated chem_ang(n,i)) withpen pencircle scaled linewidth withcolor linecolor ; - endfor ; +% transform + +% rotations and reflections + +vardef chem_rot (suffix $) (expr d, s) = % ROT + if not chem_front[$] : + if d=0 : + chem_rotation := 0 + else : + chem_num0 := if chem_stacked[$] : 3 else : 0 fi ; + chem_num1 := .5(angle(point d+chem_num0 of chem_b_path[$]) - + angle(point d+chem_num0-1 of chem_b_path[$])) ; + chem_rotation := (chem_rotation + s*chem_num1) mod 360 ; + fi + fi enddef ; -vardef chem_fill (expr n, path_fragment, from_point, to_point, linewidth, linecolor) = - for i:=from_point upto to_point: - fill (path_fragment rotated chem_ang(n,i)) withpen pencircle scaled 0 withcolor linecolor ; - endfor ; +vardef chem_mir (suffix $) (expr d, s) = % MIR + % We take the scale factor s to multiply the rotation, but only ONCE. + % For example: CARBON,.5MIR12 will give a rotation by 104° + if not chem_front[$] : + if d=0 : % inversion + if chem_mirror=origin : + chem_rotation := (chem_rotation + 180*s) mod 360 ; + else : + chem_mirror := chem_mirror rotated 90 ; + fi + else : + chem_pair0 := (point d-1 of chem_b_path[$]) scaled s ; % not chem_transformed + if chem_mirror=origin : + chem_mirror := chem_pair0 ; + else : + chem_num0 := angle(chem_mirror)-angle(chem_pair0) ; + if (chem_num0>0) and (chem_num0> 180) : + chem_num0 := 360 - chem_num0 ; + elseif (chem_num0<0) and (chem_num0<-180) : + chem_num0 := -360 - chem_num0 ; + fi + chem_num0 := chem_num0 * s ; + chem_rotation := (chem_rotation + 2chem_num0) mod 360 ; + chem_mirror := origin ; + fi + fi + fi enddef ; -vardef chem_dashed_normal (expr n, path_fragment, from_point, to_point, linewidth, linecolor) = - for i:=from_point upto to_point: - draw (path_fragment rotated chem_ang(n,i)) withpen pencircle scaled linewidth withcolor linecolor dashed evenly ; - endfor ; +% translations + +vardef chem_dir (suffix $) (expr d, s) = % DIR (same as MOV(d-1)MOV(d+1)) + if not chem_front[$] : + if d=0 : + currentpicture := currentpicture shifted -chem_origin ; + chem_origin := origin ; + else : + chem_pair0 := + (((point d-2 of chem_b_path[$]) shifted (point d of chem_b_path[$])) scaled s) + chem_transformed($) ; + currentpicture := currentpicture shifted -chem_pair0 ; + chem_origin := chem_origin shifted -chem_pair0 ; + fi + fi +enddef ; + +vardef chem_mov (suffix $) (expr d, s) = % MOV + if d=0 : + currentpicture := currentpicture shifted -chem_origin ; + chem_origin := origin ; + else : + chem_pair0 := ((point d-1 of chem_b_path[$]) scaled s) chem_transformed($) ; + currentpicture := currentpicture shifted -chem_pair0 ; + chem_origin := chem_origin shifted -chem_pair0 ; + fi ; enddef ; -vardef chem_dashed_connected (expr n, path_fragment, from_point, to_point, linewidth, linecolor) = - draw for i:=from_point upto to_point: - (path_fragment rotated chem_ang(n,i)) if i < to_point : -- fi - endfor withpen pencircle scaled linewidth withcolor linecolor dashed evenly ; +vardef chem_mark (suffix $) (expr d, s) = % MARK + % scale s is ignored + if d<>0 : + chem_mark_pair[d] := -chem_origin ; + fi enddef ; -vardef chem_draw_dot (expr n, path_fragment, from_point, to_point, linewidth, linecolor) = - for i:=from_point upto to_point: - draw (path_fragment rotated chem_ang(n,i)) withpen pencircle scaled (chem_dot_factor*linewidth) withcolor linecolor ; - endfor ; +vardef chem_marked (expr d) = + if d=0 : + chem_origin + elseif known chem_mark_pair[d] : + chem_mark_pair[d] shifted chem_origin + else : + origin + fi enddef ; -vardef chem_draw_fixed (expr n, path_fragment, linewidth, linecolor) = - draw (path_fragment rotated chem_ang(n,1)) withpen pencircle scaled linewidth withcolor linecolor ; +vardef chem_number@#(suffix $) (expr p) (text t) = chem_label@#($,p,t) enddef ; % NUMBER +vardef chem_label@# (suffix $) (expr p) (text t) = % LABEL + draw chem_text@#(t,chem_do(chem_marked(p))) ; enddef ; -vardef chem_draw_arrow (expr n, path_fragment, from_point, to_point, linewidth, linecolor) = - for i:=from_point upto to_point: - drawarrow (path_fragment rotated chem_ang(n,i)) withpen pencircle scaled linewidth withcolor linecolor ; - endfor ; +vardef chem_move (suffix $) (expr d, s) = % MOVE + chem_pair0 := chem_marked(d) scaled s ; + currentpicture := currentpicture shifted -chem_pair0 ; + chem_origin := chem_origin shifted -chem_pair0 ; enddef ; -vardef chem_draw_vertical (expr n, path_fragment, from_point, to_point, linewidth, linecolor) = - % quite special - for i:=from_point upto to_point: - draw (path_fragment shifted (chem_b_zero[n] rotated chem_ang(n,i))) withpen pencircle scaled linewidth withcolor linecolor ; - endfor ; +vardef chem_diff (suffix $) (expr d, s) = % DIFF + chem_pair0 := (chem_marked(d) shifted -chem_origin) scaled s ; + currentpicture := currentpicture shifted -chem_pair0 ; + chem_origin := chem_origin shifted -chem_pair0 ; enddef ; -picture chem_stack_p[] ; -pair chem_stack_shift[] ; - -vardef chem_save = - chem_stack_n := chem_stack_n + 1 ; - chem_stack_p[chem_stack_n] := currentpicture ; - chem_stack_shift[chem_stack_n] := chem_shift ; - chem_shift := origin ; -% chem_adjacent := 0 ; -% chem_substituent := 0 ; -% chem_rotation := 1 ; - currentpicture := nullpicture ; +vardef chem_line (suffix $) (expr f, t, r, c) = % LINE + draw if f=t : origin else : chem_marked(f) fi -- chem_marked(t) + % no chem_transformed + withpen pencircle scaled r + withcolor c %\MPcolor{c} enddef ; -vardef chem_restore = - if chem_stack_n > 0 : - currentpicture := currentpicture shifted - chem_shift ; - addto chem_stack_p[chem_stack_n] also currentpicture ; - currentpicture := chem_stack_p[chem_stack_n] ; - chem_stack_p[chem_stack_n] := nullpicture ; - chem_shift := chem_stack_shift[chem_stack_n] ; - chem_stack_n := chem_stack_n - 1 ; - fi ; +vardef chem_dash (suffix $) (expr f, t, r, c) = % DASH + draw if f=t : origin else : chem_marked(f) fi -- chem_marked(t) + % no chem_transformed + withpen pencircle scaled r + withcolor c %\MPcolor{c} + dashed evenly ; enddef ; -def chem_init_some(expr n, ratio, start, initialrot, initialmov) = - chem_width [n] := ratio * chem_base_width * chem_setting_scale ; - chem_angle [n] := 360/abs(n) ; - chem_start [n] := start ; - chem_initialrot[n] := initialrot ; - chem_initialmov[n] := initialmov ; - chem_b_zero [n] := (chem_width[n],0) rotated (chem_angle[n]/2) ; - chem_n_zero [n] := (chem_text_min*chem_width[n],0) rotated (chem_angle[n]/2) ; - chem_r_max [n] := chem_radical_max*chem_b_zero[n] ; - chem_r_path [n] := chem_b_zero[n] -- chem_r_max[n] ; - chem_mr_path [n] := chem_r_path [n] rotatedaround(chem_b_zero[n], (180-chem_angle[n])/2) ; - chem_pr_path [n] := chem_r_path [n] rotatedaround(chem_b_zero[n],-(180-chem_angle[n])/2) ; - chem_r_zero [n] := point 1 of chem_r_path [n] ; - chem_mr_zero [n] := point 1 of chem_mr_path[n] ; - chem_pr_zero [n] := point 1 of chem_pr_path[n] ; - chem_crz_zero [n] := point 1 of (chem_r_path[n] enlonged chem_center_offset) ; - chem_au_path [n] := subpath (0.2,0.8) of (chem_r_max[n] -- (chem_r_max[n] rotated chem_angle[n])) ; - chem_ad_path [n] := reverse(chem_au_path[n]) ; - chem_rt_zero [n] := (((chem_radical_max+chem_radical_min)/2)*chem_width[n],0) rotated (chem_angle[n]/2) ; - chem_rtt_zero [n] := chem_rt_zero[n] rotated + 10 ; - chem_rbt_zero [n] := chem_rt_zero[n] rotated - 10 ; - chem_b_path [n] := reverse(chem_b_zero[n] -- (chem_b_zero[n] rotated -chem_angle[n])) ; - chem_bx_path [n] := reverse(chem_b_zero[n] -- (chem_b_zero[n] rotated -chem_angle[n])) ; % ? - chem_sb_path [n] := subpath (0.25,0.75) of chem_b_path[n] ; - chem_s_path [n] := point 0 of chem_b_path[n] -- point 0 of (chem_b_path[n] rotated (2chem_angle[n])) ; - chem_ss_path [n] := subpath (0.25,0.75) of (chem_s_path[n]) ; - chem_pss_path [n] := subpath (0.00,0.75) of (chem_s_path[n]) ; - chem_mss_path [n] := subpath (0.25,1.00) of (chem_s_path[n]) ; - chem_mid_zero [n] := origin shifted (-.25chem_width[n],0) ; - chem_midst_path[n] := chem_mid_zero[n] -- (chem_width[n],0) rotated ( chem_angle[n] + chem_angle[n]/2) ; - chem_midsb_path[n] := chem_mid_zero[n] -- (chem_width[n],0) rotated (-chem_angle[n] - chem_angle[n]/2) ; - chem_midt_path [n] := subpath (0.25,1.00) of chem_midst_path [n] ; - chem_midb_path [n] := subpath (0.25,1.00) of chem_midsb_path [n] ; - chem_msb_path [n] := subpath (0.00,0.75) of chem_b_path[n] ; - chem_psb_path [n] := subpath (0.25,1.00) of chem_b_path[n] ; - chem_dbl_path [n] := chem_sb_path[n] shifted - (0.05[origin,center chem_sb_path[n]]) ; % parallel - chem_dbr_path [n] := chem_sb_path[n] shifted + (0.05[origin,center chem_sb_path[n]]) ; - chem_eb_path [n] := chem_sb_path[n] shifted - (0.25[origin,center chem_sb_path[n]]) ; - chem_sr_path [n] := chem_radical_min*chem_b_zero[n] -- chem_r_max[n] ; - chem_rl_path [n] := chem_r_path[n] paralleled (chem_base_width/20) ; - chem_rr_path [n] := chem_r_path[n] paralleled -(chem_base_width/20) ; - chem_srl_path [n] := chem_sr_path[n] paralleled (chem_base_width/20) ; - chem_srr_path [n] := chem_sr_path[n] paralleled -(chem_base_width/20) ; - chem_br_path [n] := point 1 of chem_sb_path[n] -- - point 0 of chem_sb_path[n] rotatedaround(point 1 of chem_sb_path[n], -4) -- - point 0 of chem_sb_path[n] rotatedaround(point 1 of chem_sb_path[n], 4) -- cycle ; - chem_rb_path [n] := chem_b_zero[n] -- chem_r_max[n] rotated -2 -- chem_r_max[n] -- chem_r_max[n] rotated 2 -- cycle ; - chem_mrb_path [n] := chem_rb_path[n] rotatedaround(chem_b_zero[n], (180-chem_angle[n])/2) ; - chem_prb_path [n] := chem_rb_path[n] rotatedaround(chem_b_zero[n],-(180-chem_angle[n])/2) ; - chem_msr_path [n] := chem_sr_path[n] rotatedaround(chem_b_zero[n], (180-chem_angle[n])/2) ; - chem_psr_path [n] := chem_sr_path[n] rotatedaround(chem_b_zero[n],-(180-chem_angle[n])/2) ; - % not yet ok: -% chem_c_path [n] := subpath (30/45, -30/45) of (fullcircle scaled (1.25*chem_circle_radius*chem_width[n])); -% chem_cc_path [n] := subpath (30/45,8-30/45) of (fullcircle rotated 90 scaled (1.25*chem_circle_radius*chem_width[n])); - chem_c_path [n] := subpath (30/45, -30/45) of (fullcircle scaled (chem_width[n])); - chem_cc_path [n] := subpath (30/45,8-30/45) of (fullcircle rotated 90 scaled (chem_width[n])); -enddef ; - -def chem_init_three = chem_init_some(3,30/52 ,-60,1,2) ; enddef ; % 60 -def chem_init_four = chem_init_some(4,30/42.5, 0,1,0) ; enddef ; % 45 -def chem_init_five = chem_init_some(5,30/35 , 0,1,0) ; enddef ; % 36 -def chem_init_six = chem_init_some(6, 1 , 0,1,0) ; enddef ; % 30 -def chem_init_eight = chem_init_some(8,30/22.5, 0,1,0) ; enddef ; % 22.5 - -% bb R -R R Z -RZ +RZ - -def chem_init_some_front(expr n, ratio, start, initialrot, initialmov) = - chem_init_some(n, ratio, start, initialrot, initialmov) ; - chem_bb_path [n] := chem_b_path[n] rotated -chem_angle[n] -- chem_b_path[n] -- chem_b_path[n] rotated chem_angle[n] -- - (reverse(chem_b_path[n] shortened (chem_base_width/20))) paralleled (chem_base_width/20) -- - cycle ; - chem_r_max [n] := chem_radical_max*chem_b_zero[n] ; - chem_mr_path [n] := origin -- origin shifted (0,-.25chem_base_width) ; - chem_pr_path [n] := origin -- origin shifted (0, .25*chem_base_width) ; - chem_r_path [n] := point 1 of chem_mr_path[n] -- point 1 of chem_pr_path[n] ; - chem_mr_zero [n] := point 1 of chem_mr_path[n] ; - chem_pr_zero [n] := point 1 of chem_pr_path[n] ; -enddef ; - -def chem_init_five_front = chem_init_some_front(-5,30/35,0,2,0) ; enddef ; % 36 -def chem_init_six_front = chem_init_some_front(-6, 1 ,0,2,0) ; enddef ; % 30 - -vardef chem_init_one = - chem_width [1] := .75 * chem_base_width * chem_setting_scale ; - chem_angle [1] := 360/8 ; - chem_start [1] := 0 ; - chem_initialrot[1] := 1 ; - chem_initialmov[1] := 1 ; - chem_b_zero [1] := (1.75*chem_width[1],0) ; - chem_r_min [1] := chem_radical_min*chem_b_zero[1] ; - chem_r_max [1] := chem_radical_max*chem_b_zero[1] ; - chem_r_path [1] := (.5*chem_width[1],0) -- (1.25*chem_width[1],0) ; - chem_r_zero [1] := point 1 of chem_r_path [1] ; - chem_b_path [1] := chem_r_path[1] rotated + (chem_angle[1]) ; % used for move here - chem_b_zero [1] := chem_r_zero[1] ; - chem_crz_zero [1] := chem_r_zero[1] enlonged chem_center_offset ; - chem_e_path [1] := (.5*chem_width[1],-.25*chem_width[1]) -- (.5*chem_width[1],.25*chem_width[1]) ; - chem_sb_path [1] := chem_r_path [1] ; - chem_msb_path [1] := chem_r_path [1] shifted (0,-.1chem_width[1]) ; - chem_psb_path [1] := chem_r_path [1] shifted (0, .1chem_width[1]) ; - chem_ddt_path [1] := subpath(0,.4) of chem_r_path [1] ; - chem_ddb_path [1] := subpath(.6,1) of chem_r_path [1] ; - chem_ldt_path [1] := chem_ddt_path [1] shifted (0,-.1chem_width[1]) ; % parallel - chem_ldb_path [1] := chem_ddb_path [1] shifted (0,-.1chem_width[1]) ; - chem_rdt_path [1] := chem_ddt_path [1] shifted (0, .1chem_width[1]) ; - chem_rdb_path [1] := chem_ddb_path [1] shifted (0, .1chem_width[1]) ; - save pr ; pair pr[] ; - pr0 := point 0 of chem_r_path[1] ; - pr1 := point 1 of chem_r_path[1] ; - chem_bb_path [1] := pr0 -- (pr1 rotatedaround(pr0,-chem_bb_angle)) -- (pr1 rotatedaround(pr0,chem_bb_angle)) -- cycle ; - chem_oe_path [1] := ((-20,0)--(10,0){up}..(20,10)..(30,0)..(40,-10)..(50.0,0)..(60,10)..(70,0)..(80,-10)..{up}(90,0)--(120,0)) - xsized (.75*chem_width[1]) shifted pr0 ; - chem_rt_zero [1] := point .5 of chem_r_path[1] ; - chem_rtt_zero [1] := chem_rt_zero[1] rotated + (chem_angle[1]/2) ; - chem_rbt_zero [1] := chem_rt_zero[1] rotated - (chem_angle[1]/2) ; - % added by Alan Braslau (adapted to use shared variables): - save p ; pair p[] ; - p0 := pr1 rotatedaround(pr0, -chem_bd_angle) ; - p1 := pr1 rotatedaround(pr0, +chem_bd_angle) ; - p2 := p0 shifted - pr1 ; - p3 := p1 shifted - pr1 ; - chem_bd_path [1] := - p0 -- p1 for i=chem_bd_n downto 0 : - -- p2 shifted (i/chem_bd_n)[pr1,pr0] - -- p3 shifted (i/chem_bd_n)[pr1,pr0] - endfor ; - chem_bw_path [1] := - for i=0 upto chem_bw_n - 1 : - ((i) /chem_bw_n)[pr0,pr1] .. ((i+.25)/chem_bw_n)[pr0,pr1] shifted p2 .. - ((i+.50)/chem_bw_n)[pr0,pr1] .. ((i+.75)/chem_bw_n)[pr0,pr1] shifted -p2 .. - endfor pr1 ; +vardef chem_arrow (suffix $) (expr f, t, r, c) = % ARROW + drawarrow if f=t : origin else : chem_marked(f) fi -- chem_marked(t) + % no chem_transformed + withpen pencircle scaled r + withcolor c %\MPcolor{c} enddef ; -def chem_init_all = - chem_init_one ; - chem_init_three ; - chem_init_four ; - chem_init_five ; - chem_init_six ; - chem_init_eight ; - chem_init_five_front ; - chem_init_six_front ; + +vardef chem_rm (suffix $) (expr d, s) = % RM + if (not chem_front[$]) and (d<>0) : + chem_pair0 := ((point d-1 of chem_r_path[$]) scaled s) chem_transformed($) ; + currentpicture := currentpicture shifted -chem_pair0 ; + chem_origin := chem_origin shifted -chem_pair0 ; + fi ; enddef ; -chem_init_all ; +vardef chem_off (suffix $) (expr d, s) = % OFF + if d=0 : + currentpicture := currentpicture shifted -chem_origin ; + chem_origin := origin ; + else : + chem_pair0 := (unitvector(point d-1 of chem_b_path[one])) scaled chem_setting_offset*s ; + % not chem_transformed + currentpicture := currentpicture shifted -chem_pair0 ; + chem_origin := chem_origin shifted -chem_pair0 ; + fi ; +enddef ; diff --git a/Master/texmf-dist/metapost/context/base/mp-core.mpiv b/Master/texmf-dist/metapost/context/base/mp-core.mpiv index 1934e304024..3dba4a004e7 100644 --- a/Master/texmf-dist/metapost/context/base/mp-core.mpiv +++ b/Master/texmf-dist/metapost/context/base/mp-core.mpiv @@ -5,7 +5,7 @@ %D subtitle=background macros, %D author=Hans Hagen, %D date=\currentdate, -%D copyright={PRAGMA / Hans Hagen \& Ton Otten}] +%D copyright={PRAGMA ADE \& \CONTEXT\ Development Team}] %C %C This module is part of the \CONTEXT\ macro||package and is %C therefore copyrighted by \PRAGMA. See mreadme.pdf for diff --git a/Master/texmf-dist/metapost/context/base/mp-crop.mpiv b/Master/texmf-dist/metapost/context/base/mp-crop.mpiv index 6360757e5b0..00bcdcb4454 100644 --- a/Master/texmf-dist/metapost/context/base/mp-crop.mpiv +++ b/Master/texmf-dist/metapost/context/base/mp-crop.mpiv @@ -5,7 +5,7 @@ %D subtitle=Cropmarks, %D author=Hans Hagen, %D date=\currentdate, -%D copyright={PRAGMA / Hans Hagen \& Ton Otten}] +%D copyright={PRAGMA ADE \& \CONTEXT\ Development Team}] %C %C This module is part of the \CONTEXT\ macro||package and is %C therefore copyrighted by \PRAGMA. See mreadme.pdf for @@ -15,20 +15,20 @@ if known context_crop : endinput ; fi ; boolean context_crop ; context_crop := true ; -vardef crop_marks_lines (expr box, length, offset, nx, ny) = - save p ; picture p ; save w, h, x, y ; numeric w, h, x, y ; +vardef crop_marks_lines (expr box, len, offset, nx, ny) = + save p ; picture p ; save w, h, x, y ; numeric w, h, x, y ; p := image ( x := if nx = 0 : 1 else : nx - 1 fi ; y := if ny = 0 : 1 else : ny - 1 fi ; w := bbwidth (box) / x ; h := bbheight(box) / y ; for i=0 upto y : - draw ((llcorner box) -- (llcorner box) shifted (-length,0)) shifted (-offset,i*h) ; - draw ((lrcorner box) -- (lrcorner box) shifted ( length,0)) shifted ( offset,i*h) ; + draw ((llcorner box) -- (llcorner box) shifted (-len,0)) shifted (-offset,i*h) ; + draw ((lrcorner box) -- (lrcorner box) shifted ( len,0)) shifted ( offset,i*h) ; endfor ; for i=0 upto x : - draw ((llcorner box) -- (llcorner box) shifted (0,-length)) shifted (i*w,-offset) ; - draw ((ulcorner box) -- (ulcorner box) shifted (0, length)) shifted (i*w, offset) ; + draw ((llcorner box) -- (llcorner box) shifted (0,-len)) shifted (i*w,-offset) ; + draw ((ulcorner box) -- (ulcorner box) shifted (0, len)) shifted (i*w, offset) ; endfor ; ) ; setbounds p to box ; diff --git a/Master/texmf-dist/metapost/context/base/mp-figs.mpiv b/Master/texmf-dist/metapost/context/base/mp-figs.mpiv index c65808f6d05..aac7c5ad219 100644 --- a/Master/texmf-dist/metapost/context/base/mp-figs.mpiv +++ b/Master/texmf-dist/metapost/context/base/mp-figs.mpiv @@ -5,7 +5,7 @@ %D subtitle=figures, %D author=Hans Hagen, %D date=\currentdate, -%D copyright={PRAGMA / Hans Hagen \& Ton Otten}] +%D copyright={PRAGMA ADE \& \CONTEXT\ Development Team}] %C %C This module is part of the \CONTEXT\ macro||package and is %C therefore copyrighted by \PRAGMA. See licen-en.pdf for diff --git a/Master/texmf-dist/metapost/context/base/mp-form.mpiv b/Master/texmf-dist/metapost/context/base/mp-form.mpiv index d0519b4f24c..b58792e1a01 100644 --- a/Master/texmf-dist/metapost/context/base/mp-form.mpiv +++ b/Master/texmf-dist/metapost/context/base/mp-form.mpiv @@ -5,7 +5,7 @@ %D subtitle=form support, %D author=Hans Hagen, %D date=\currentdate, -%D copyright={PRAGMA / Hans Hagen \& Ton Otten}] +%D copyright={PRAGMA ADE \& \CONTEXT\ Development Team}] %C %C This module is part of the \CONTEXT\ macro||package and is %C therefore copyrighted by \PRAGMA. See licen-en.pdf for diff --git a/Master/texmf-dist/metapost/context/base/mp-func.mpiv b/Master/texmf-dist/metapost/context/base/mp-func.mpiv index 1d289b606b1..58df711f2f3 100644 --- a/Master/texmf-dist/metapost/context/base/mp-func.mpiv +++ b/Master/texmf-dist/metapost/context/base/mp-func.mpiv @@ -5,7 +5,7 @@ %D subtitle=function hacks, %D author=Hans Hagen, %D date=\currentdate, -%D copyright={PRAGMA / Hans Hagen \& Ton Otten}] +%D copyright={PRAGMA ADE \& \CONTEXT\ Development Team}] %C %C This module is part of the \CONTEXT\ macro||package and is %C therefore copyrighted by \PRAGMA. See licen-en.pdf for diff --git a/Master/texmf-dist/metapost/context/base/mp-grap.mpiv b/Master/texmf-dist/metapost/context/base/mp-grap.mpiv new file mode 100644 index 00000000000..6b1f2311f88 --- /dev/null +++ b/Master/texmf-dist/metapost/context/base/mp-grap.mpiv @@ -0,0 +1,526 @@ +%D \module +%D [ file=mp-grap.mpiv, +%D version=2012.10.16, % 2008.09.08 and earlier, +%D title=\CONTEXT\ \METAPOST\ graphics, +%D subtitle=graph packagesupport, +%D author=Hans Hagen \& Alan Braslau, +%D date=\currentdate, +%D copyright={PRAGMA ADE \& \CONTEXT\ Development Team}] +%C +%C This module is part of the \CONTEXT\ macro||package and is +%C therefore copyrighted by \PRAGMA. See licen-en.pdf for +%C details. + +if known context_grap : endinput ; fi + +boolean context_grap ; context_grap := true ; + +% Instead we could include graph here and then clean it up as well as use private +% variables in the grap_ namespace. After all, graph is frozen. + +input graph.mp ; + +vardef roundd(expr x, d) = + if abs d > 4 : + if d > 0 : + x + else : + 0 + fi + elseif d > 0 : + save i ; i = floor x ; + i + round(Ten_to[d]*(x-i))/Ten_to[d] + else : + round(x/Ten_to[-d])*Ten_to[-d] + fi +enddef ; + +Ten_to0 = 1 ; +Ten_to1 = 10 ; +Ten_to2 = 100 ; +Ten_to3 = 1000 ; +Ten_to4 = 10000 ; + +def sFe_base = enddef ; + +if unknown Fe_plus : + picture Fe_plus ; Fe_plus := textext("+") ; % btex + etex ; +fi ; + +vardef format (expr f,x) = dofmt_.Feform_(f,x) enddef ; +vardef Mformat (expr f,x) = dofmt_.Meform (f,x) enddef ; +vardef formatstr (expr f,x) = dofmt_.Feform_(f,x) enddef ; +vardef Mformatstr(expr f,x) = dofmt_.Meform(f,x) enddef ; + +vardef escaped_format(expr s) = + "" for n=1 upto length(s) : & + if ASCII substring (n,n+1) of s = 37 : + "@" + else : + substring (n,n+1) of s + fi + endfor +enddef ; + +vardef dofmt_@#(expr f, x) = + textext("\MPgraphformat{" & escaped_format(f) & "}{" & (if string x : x else: decimal x fi) & "}") + % textext(mfun_format_number(escaped_format(f),x)) +enddef ; + +% note that suffix @# is ignored above... + +vardef strfmt(expr f, x) = + "\MPgraphformat{" & escaped_format(f) & "}{" & (if string x : x else: decimal x fi) & "}" +enddef ; + +% We redefine autogrid from graph.mp adding the possibility of differing X and Y +% formats. Autoform is defined in graph.mp (by default "%g"). + +% graph.mp: string Autoform; Autoform = "%g"; +% graph.mp: +% graph.mp: vardef autogrid(suffix tx, ty) text w = +% graph.mp: Gneedgr_:=false; +% graph.mp: if str tx<>"": for x=auto.x: tx(Autoform,x) w; endfor fi +% graph.mp: if str ty<>"": for y=auto.y: ty(Autoform,y) w; endfor fi +% graph.mp: enddef; + +% string Autoform_X ; Autoform_X := "@.0e" ; +% string Autoform_Y ; Autoform_Y := "@.0e" ; + +vardef autogrid(suffix tx, ty) text w = + Gneedgr_ := false ; + if str tx <> "" : + for x=auto.x : + tx ( + if string Autoform_X : + if Autoform_X <> "" : + Autoform_X + else : + Autoform + fi + else : + Autoform + fi, + x + ) w ; + endfor + fi + if str ty <> "" : + for y=auto.y : + ty ( + if string Autoform_Y : + if Autoform_Y <> "" : + Autoform_Y + else : + Autoform + fi + else : + Autoform + fi, + y + ) w ; + endfor + fi +enddef ; + +% A couple of extensions: + +% Define a function plotsymbol() returning a picture: 10 different shapes, +% unfilled outline, interior filled with different shades of the background. +% This allows overlapping points on a plot to be more distinguishable. + +% grap_symsize := fontsize defaultfont ; % can be redefined +% +% dynamic version: + +vardef grap_symsize = + % fontsize defaultfont + % .8ExHeight + .35BodyFontSize +enddef ; + +path grap_sym[] ; % (internal) symbol path + +grap_sym[0] := (0,0) ; % point +grap_sym[1] := fullcircle ; % circle +grap_sym[2] := (up -- down) scaled .5 ; % vertical bar + +for i = 3 upto 9 : % polygons + grap_sym[i] := + for j = 0 upto i-1 : + (up scaled .5) rotated (360j/i) -- + endfor cycle ; +endfor + +grap_sym[12] := grap_sym[2] rotated +90 ; % horizontal line +grap_sym[22] := grap_sym[2] rotated +45 ; % backslash +grap_sym[32] := grap_sym[2] rotated -45 ; % slash +grap_sym[13] := grap_sym[3] rotated 180 ; % down triangle +grap_sym[23] := grap_sym[3] rotated -90 ; % right triangle +grap_sym[33] := grap_sym[3] rotated +90 ; % left triangle +grap_sym[14] := grap_sym[4] rotated +45 ; % square +grap_sym[15] := grap_sym[5] rotated 180 ; % down pentagon +grap_sym[16] := grap_sym[6] rotated +90 ; % turned hexagon +grap_sym[17] := grap_sym[7] rotated 180 ; +grap_sym[18] := grap_sym[8] rotated +22.5 ; + +numeric l ; + +for j = 5 upto 9 : + l := length(grap_sym[j]) ; + pair p[] ; + for i = 0 upto l : + p[i] = whatever [point i of grap_sym[j], + point (i+2 mod l) of grap_sym[j]] ; + p[i] = whatever [point (i+1 mod l) of grap_sym[j], + point (i+l-1 mod l) of grap_sym[j]] ; + endfor + grap_sym[20+j] := for i = 0 upto l : point i of grap_sym[j]--p[i]--endfor cycle ; +endfor + +path s ; s := grap_sym[4] ; +path q ; q := s scaled .25 ; +numeric l ; l := length(s) ; + +pair p[] ; + +grap_sym[24] := for i = 0 upto l-1 : + hide( + p[i] = whatever [point i of s, point (i+1 mod l) of s] ; + p[i] = whatever [point i of q, point (i-1+l mod l) of q] ; + p[i+l] = whatever [point i of s, point (i+1 mod l) of s] ; + p[i+l] = whatever [point i+1 of q, point (i+2 mod l) of q] ; + ) + point i of q -- p[i] -- p[i+l] -- +endfor cycle ; + +grap_sym[34] := grap_sym[24] rotated 45 ; + +% usage: gdraw p plot plotsymbol(1,red,1) ; % a filled red circle +% usage: gdraw p plot plotsymbol(4,blue,0) ; % a blue square +% usage: gdraw p plot plotsymbol(14,green,0.5) ; % a 50% filled green diamond + +def plotsymbol(expr n,c,f) = % (number,color,color|number) + if known grap_sym[n] : + image( + path p ; p := grap_sym[n] scaled grap_symsize ; + undraw p withpen currentpen scaled 2 ; + if cycle p : fill p withcolor + if color f and known f : + f + elseif numeric f and known f and color c and known c : + f[background,c] + elseif numeric f and known f : + f[background,black] + else : + background + fi ; + fi + draw p if color c and known c : withcolor c fi ; + ) + else : + nullpicture + fi +enddef ; + +% The following extensions are not specific to graph and could be moved to metafun... + +% convert a polygon path to a smooth path (useful, e.g. as a guide to the eye) + +def smoothpath (suffix $) = + if path $ : + (for i=0 upto length $ : + if i>0 : .. fi + (point i of $) + endfor ) + fi +enddef ; + +% return a path of a function func(x) with abcissa running from f to t over n intervals + +def makefunctionpath (expr f, t, n) (text func) = + (for x=f step ((t-f)/n) until t : + if x<>f : .. fi + (x, func) + endfor ) +enddef ; + +% shift a path, point by point +% +% example: +% +% p1 := addnoisetopath(p0,(.1normaldeviate,.1normaldeviate)) ; + +vardef addnoisetopath (suffix p) (text t) = + if path p : + hide(pair p_i) + (for i=0 upto length p : + if i>0 : -- fi + hide(p_i := point i of p; x := xpart p_i; y := ypart p_i)z shifted t + endfor) + fi +enddef ; + +% return a new path of a function func(x) using the same abcissa as an existing path + +vardef functionpath (suffix p) (text t) = + (for i=0 upto length p : + if i>0 : .. fi + (hide(x := xpart(point i of p))x,t) + endfor ) +enddef ; + +% least-squares "fit" to a polynomial +% +% example: +% +% path p[] ; +% numeric a[] ; a0 := 1 ; a1 := .1 ; a2 := .01 ; a3 := .001 ; a4 := 0.0001 ; +% p0 := makefunctionpath(0,5,10,polynomial_function(a,4,x)) ; +% p1 := addnoisetopath(p0,(0,.001normaldeviate)) ; +% gdraw p0 ; +% gdraw p1 plot plotsymbol(1,black,.5) ; +% +% numeric b[] ; +% polynomial_fit(p1, b, 4, 1) ; +% gdraw functionpath(p1,polynomial_function(b,4,x)) ; +% +% numeric c[] ; +% linear_fit(p1, c, 1) ; +% gdraw functionpath(p1,linear_function(c,x)) dashed evenly ; + +% a polynomial function: +% +% y = a0 + a1 * x + a2 * x^2 + ... + a[n] * x^n + +vardef polynomial_function (suffix $) (expr n, x) = + (for j=0 upto n : + $[j]*(x**j) endfor) % no ; +enddef ; + +% find the determinant of a (n+1)*(n+1) matrix; indices run from 0 to n + +vardef det (suffix $) (expr n) = + hide( + numeric determinant ; determinant := 1 ; + save jj ; numeric jj ; + for k=0 upto n : + if $[k][k]=0 : + jj := -1 ; + for j=0 upto n : + if $[k][j]<>0 : + jj := j ; + exitif true ; + fi + endfor + if jj<0 : + determinant := 0 ; + exitif true ; + fi + for j=k upto n : % interchange the columns + temp := $[j][jj] ; + $[j][jj] := $[j][k] ; + $[j][k] := temp ; + endfor + determinant = -determinant ; + fi + exitif determinant=0 ; + determinant := determinant * $[k][k] ; + if k<n : % subtract row k from lower rows to get a diagonal matrix + for j=k+1 upto n: + for i=k+1 upto n: + $[j][i] := $[j][i]-$[j][k]*$[k][i]/$[k][k] ; + endfor + endfor + fi + endfor ; + ) + determinant % no ; +enddef ; + +numeric fit_chi_squared ; + +% least-squares fit of a polynomial $ of order n to a path p (unweighted) +% +% reference: P. R. Bevington, "Data Reduction and Error Analysis for the Physical +% Sciences", McGraw-Hill, New York 1969. + +vardef polynomial_fit (suffix p, $) (expr n) (text t) = + if not path p : + Gerr(p, "Cannot fit--not a path") ; + elseif length p < n : + Gerr(p, "Cannot fit--not enough points") ; + else : + fit_chi_squared := 0 ; + % calculate sums of the data + save sumx, sumy ; numeric sumx[], sumy[] ; + save w ; numeric w ; + for i=0 upto 2n : + sumx[i] := 0 ; + endfor + for i=0 upto n : + sumy[i] := 0 ; + endfor + for i=0 upto length p : + clearxy; z = point i of p ; + w := if length(t) > 0 : t else : 1 fi ; % weight + x1 := w ; + for j=0 upto 2n : + sumx[j] := sumx[j] + x1 ; + x1 := x1 * x ; + endfor + y1 := y * w ; + for j=0 upto n : + sumy[j] := sumy[j] + y1 ; + y1 := y1 * x ; + endfor + fit_chi_squared := fit_chi_squared + y*y*w ; + endfor + % construct matrices and calculate the polynomial coefficients + save m ; numeric m[][] ; + for j=0 upto n : + for k=0 upto n : + m[j][k] := sumx[j+k] ; + endfor + endfor + save delta ; numeric delta ; + delta := det(m,n) ; % this destroys the matrix m[][], which is OK + if delta = 0 : + fit_chi_squared := 0 ; + for j=0 upto n : + $[j] := 0 ; + endfor + else : + for i=0 upto n : + for j=0 upto n : + for k=0 upto n : + m[j][k] := sumx[j+k] ; + endfor + m[j][i] := sumy[j] ; + endfor + $[i] := det(m,n) / delta ; % matrix m[][] gets destroyed... + endfor + for j=0 upto n : + fit_chi_squared := fit_chi_squared - 2sumy[j]*$[j] ; + for k=0 upto n : + fit_chi_squared := fit_chi_squared + $[j]*$[k]*sumx[j+k] ; + endfor + endfor + % normalize by the number of degrees of freedom + fit_chi_squared := fit_chi_squared / (length(p) - n) ; + fi + fi +enddef ; + +% y = a0 + a1 * x +% +% of course a line is just a polynomial of order 1 + +vardef linear_function (suffix $) (expr x) = polynomial_function($,1,x) enddef ; +vardef linear_fit (suffix p, $) (text t) = polynomial_fit(p, $, 1, t) ; enddef ; + +% and a constant is polynomial of order 0 + +vardef constant_function (suffix $) (expr x) = polynomial_function($,0,x) enddef ; +vardef constant_fit (suffix p, $) (text t) = polynomial_fit(p, $, 0, t) ; enddef ; + +% y = a1 * exp(a0*x) +% +% exp and ln defined in metafun + +vardef exponential_function (suffix $) (expr x) = $1*exp($0*x) enddef ; + +% since we take a log, this only works for positive ordinates + +vardef exponential_fit (suffix p, $) (text t) = + save a ; numeric a[] ; + save q ; path q ; % fit to the log of the ordinate + for i=0 upto length p : + if ypart(point i of p)>0 : + augment.q(xpart(point i of p),ln(ypart(point i of p))) ; + fi + endfor + linear_fit(q,a,t) ; + $0 := a1 ; + $1 := exp(a0) ; +enddef ; + +% y = a1 * x**a0 + +vardef power_law_function (suffix $) (expr x) = $1*(x**$0) enddef ; + +% since we take logs, this only works for positive abcissae and ordinates + +vardef power_law_fit (suffix p, $) (text t) = + save a ; numeric a[] ; + save q ; path q ; % fit to the logs of the abcissae and ordinates + for i=0 upto length p : + if (xpart(point i of p)>0) and (ypart(point i of p)>0) : + augment.q(ln(xpart(point i of p)),ln(ypart(point i of p))) ; + fi + endfor + linear_fit(q,a,t) ; + $0 := a1 ; + $1 := exp(a0) ; +enddef ; + +% gaussian: y = a2 * exp(-ln(2)*((x-a0)/a1)^2) +% +% a1 is the hwhm; sigma := a1/sqrt(2ln(2)) or a1/1.17741 + +numeric lntwo ; lntwo := ln(2) ; % brrr, why not inline it + +vardef gaussian_function (suffix $) (expr x) = + if $1 = 0 : + if x = $0 : $2 else : 0 fi + else : + $2 * exp(-lntwo*(((x-$0)/$1)**2)) + fi + if known $3 : + + $3 + fi +enddef ; + +% since we take a log, this only works for positive ordinates + +vardef gaussian_fit (suffix p, $) (text t) = + save a ; numeric a[] ; + save q ; path q ; % fit to the log of the ordinate + for i=0 upto length p : + if ypart(point i of p)>0 : + augment.q(xpart(point i of p), ln(ypart(point i of p))) ; + fi + endfor + polynomial_fit(q,a,2,if t > 0 : ln(t) else : 0 fi) ; + $1 := sqrt(-lntwo/a2) ; + $0 := -.5a1/a2 ; + $2 := exp(a0-.25*a1*a1/a2) ; + $3 := 0 ; % polynomial_fit will NOT work with a non-zero background! +enddef ; + +% lorentzian: y = a2 / (1 + ((x - a0)/a1)^2) + +vardef lorentzian_function (suffix $) (expr x) = + if $1 = 0 : + if x = $0 : $2 else : 0 fi + else : + $2 / (1 + ((x - $0)/$1)**2) + fi + if known $3 : + + $3 + fi +enddef ; + +vardef lorentzian_fit (suffix p, $) (text t) = + save a ; numeric a[] ; + save q ; path q ; % fit to the inverse of the ordinate + for i=0 upto length p : + if ypart(point i of p)<>0 : + augment.q(xpart(point i of p), 1/ypart(point i of p)) ; + fi + endfor + polynomial_fit(q,a,2,if t <> 0 : 1/(t) else : 0 fi) ; + $0 := -.5a1/a2 ; + $2 := 1/(a0-.25a1*a1/a2) ; + $1 := sqrt((a0-.25a1*a1/a2)/a2) ; + $3 := 0 ; % polynomial_fit will NOT work with a non-zero background! +enddef ; diff --git a/Master/texmf-dist/metapost/context/base/mp-grid.mpiv b/Master/texmf-dist/metapost/context/base/mp-grid.mpiv index cc5c2b76eb2..b9243b1b96e 100644 --- a/Master/texmf-dist/metapost/context/base/mp-grid.mpiv +++ b/Master/texmf-dist/metapost/context/base/mp-grid.mpiv @@ -5,7 +5,7 @@ %D subtitle=grid support, %D author=Hans Hagen, %D date=\currentdate, -%D copyright={PRAGMA / Hans Hagen \& Ton Otten}] +%D copyright={PRAGMA ADE \& \CONTEXT\ Development Team}] %C %C This module is part of the \CONTEXT\ macro||package and is %C therefore copyrighted by \PRAGMA. See licen-en.pdf for diff --git a/Master/texmf-dist/metapost/context/base/mp-grph.mpiv b/Master/texmf-dist/metapost/context/base/mp-grph.mpiv index a8868033bbe..30c49e6e04a 100644 --- a/Master/texmf-dist/metapost/context/base/mp-grph.mpiv +++ b/Master/texmf-dist/metapost/context/base/mp-grph.mpiv @@ -5,7 +5,7 @@ %D subtitle=graphic text support, %D author=Hans Hagen, %D date=\currentdate, -%D copyright={PRAGMA / Hans Hagen \& Ton Otten}] +%D copyright={PRAGMA ADE \& \CONTEXT\ Development Team}] %C %C This module is part of the \CONTEXT\ macro||package and is %C therefore copyrighted by \PRAGMA. See licen-en.pdf for diff --git a/Master/texmf-dist/metapost/context/base/mp-mlib.mpiv b/Master/texmf-dist/metapost/context/base/mp-mlib.mpiv index 71985cef836..9a20429241e 100644 --- a/Master/texmf-dist/metapost/context/base/mp-mlib.mpiv +++ b/Master/texmf-dist/metapost/context/base/mp-mlib.mpiv @@ -5,7 +5,7 @@ %D subtitle=plugins, %D author=Hans Hagen, %D date=\currentdate, -%D copyright={PRAGMA / Hans Hagen \& Ton Otten}] +%D copyright={PRAGMA ADE \& \CONTEXT\ Development Team}] %C %C This module is part of the \CONTEXT\ macro||package and is %C therefore copyrighted by \PRAGMA. See licen-en.pdf for @@ -99,7 +99,20 @@ newinternal textextoffset ; textextoffset := 0 ; numeric mfun_tt_w[], mfun_tt_h[], mfun_tt_d[] ; % we can consider using colors (less hash space) numeric mfun_tt_n ; mfun_tt_n := 0 ; picture mfun_tt_p ; mfun_tt_p := nullpicture ; -boolean mfun_trial_run ; mfun_trial_run := false ; + +if unknown mfun_trial_run : + boolean mfun_trial_run ; + mfun_trial_run := false ; +else : + % already defined before the format is loaded +fi ; + +if unknown mfun_first_run : + boolean mfun_first_run ; + mfun_first_run := true ; +else : + % already defined before the format is loaded +fi ; def mfun_reset_tex_texts = mfun_tt_n := 0 ; @@ -110,8 +123,8 @@ def mfun_flush_tex_texts = addto currentpicture also mfun_tt_p enddef ; -extra_endfig := "mfun_flush_tex_texts;" & extra_endfig; -extra_beginfig := extra_beginfig & "mfun_reset_tex_texts;"; +extra_endfig := "mfun_flush_tex_texts ;" & extra_endfig ; +extra_beginfig := extra_beginfig & "mfun_reset_tex_texts ;" ; % We collect and flush them all, as we can also have temporary textexts % that gets never really flushed but are used for calculations. So, we @@ -255,7 +268,7 @@ vardef thetextext@#(expr p,z) = fi enddef ; -vardef textext@#(expr p) = % no draw hers +vardef textext@#(expr p) = % no draw here thetextext@#(p,origin) enddef ; @@ -565,7 +578,10 @@ def bitmapimage(expr xresolution, yresolution, data) = ) enddef ; -% TODO: +% Experimental: +% +% property p ; p = properties(withcolor (1,1,0,0)) ; +% fill fullcircle scaled 20cm withproperties p ; let property = picture ; @@ -573,24 +589,33 @@ vardef properties(text t) = image(draw unitcircle t) enddef ; -def withproperties expr p = - if colormodel p = 3 : - withcolor greypart p - elseif colormodel p = 5 : - withcolor (redpart p,greenpart p,bluepart p) - elseif colormodel p = 7 : - withcolor (cyanpart p,magentapart p,yellowpart p,blackpart p) - fi - % todo, when available in mp: - % - % withprescript prescript p - % withpostscript postscript p - % - % todo, penpart -enddef ; +if metapostversion < 1.770 : -% property p ; p = properties(withcolor (1,1,0,1)) ; -% fill fullcircle scaled 20cm withproperties p ; + def withproperties expr p = + if colormodel p = 3 : + withcolor greypart p + elseif colormodel p = 5 : + withcolor (redpart p,greenpart p,bluepart p) + elseif colormodel p = 7 : + withcolor (cyanpart p,magentapart p,yellowpart p,blackpart p) + fi + enddef ; + +else : + + def withproperties expr p = + if colormodel p = 3 : + withcolor greypart p + elseif colormodel p = 5 : + withcolor (redpart p,greenpart p,bluepart p) + elseif colormodel p = 7 : + withcolor (cyanpart p,magentapart p,yellowpart p,blackpart p) + fi + withprescript prescript p + withpostscript postscript p + enddef ; + +fi ; % Experimental: @@ -614,3 +639,26 @@ primarydef t asgroup s = % s = isolated|knockout wrappedpicture endgroup enddef ; + +% Also experimental + +string mfun_auto_align[] ; + +mfun_auto_align[0] := "rt" ; +mfun_auto_align[1] := "urt" ; +mfun_auto_align[2] := "top" ; +mfun_auto_align[3] := "ulft" ; +mfun_auto_align[4] := "lft" ; +mfun_auto_align[5] := "llft" ; +mfun_auto_align[6] := "bot" ; +mfun_auto_align[7] := "lrt" ; +mfun_auto_align[8] := "rt" ; + +def autoalign(expr n) = + scantokens mfun_auto_align[round((n mod 360)/45)] +enddef ; + +% draw textext.autoalign(60) ("\strut oeps 1") ; +% draw textext.autoalign(160)("\strut oeps 2") ; +% draw textext.autoalign(260)("\strut oeps 3") ; +% draw textext.autoalign(360)("\strut oeps 4") ; diff --git a/Master/texmf-dist/metapost/context/base/mp-page.mpiv b/Master/texmf-dist/metapost/context/base/mp-page.mpiv index 96f617257f5..9c538d42a65 100644 --- a/Master/texmf-dist/metapost/context/base/mp-page.mpiv +++ b/Master/texmf-dist/metapost/context/base/mp-page.mpiv @@ -5,7 +5,7 @@ %D subtitle=page enhancements, %D author=Hans Hagen, %D date=\currentdate, -%D copyright={PRAGMA / Hans Hagen \& Ton Otten}] +%D copyright={PRAGMA ADE \& \CONTEXT\ Development Team}] %C %C This module is part of the \CONTEXT\ macro||package and is %C therefore copyrighted by \PRAGMA. See mreadme.pdf for @@ -106,20 +106,30 @@ OuterEdgeWidth := 0pt ; InnerEdgeDistance := 0pt ; OuterEdgeDistance := 0pt ; -path Area [][] ; pair Location [][] ; path Field [][] ; path Page ; -numeric HorPos ; numeric Hstep [] ; numeric Hsize [] ; -numeric VerPos ; numeric Vstep [] ; numeric Vsize [] ; - -for VerPos=Top step 10 until Bottom: - for HorPos=LeftEdge step 1 until RightEdge: - Area[HorPos][VerPos] := origin--cycle ; - Area[VerPos][HorPos] := Area[HorPos][VerPos] ; - Location[HorPos][VerPos] := origin ; - Location[VerPos][HorPos] := Location[HorPos][VerPos] ; - Field[HorPos][VerPos] := origin--cycle ; - Field[VerPos][HorPos] := Field[HorPos][VerPos] ; - endfor ; -endfor ; +% path Area[][] ; +% pair Location[][] ; +% path Field[][] ; + +% numeric Hstep[] ; +% numeric Hsize[] ; +% numeric Vstep[] ; +% numeric Vsize[] ; + +path Page ; + +numeric HorPos ; +numeric VerPos ; + +% for VerPos=Top step 10 until Bottom: +% for HorPos=LeftEdge step 1 until RightEdge: +% Area[HorPos][VerPos] := origin--cycle ; +% Area[VerPos][HorPos] := Area[HorPos][VerPos] ; +% Location[HorPos][VerPos] := origin ; +% Location[VerPos][HorPos] := Location[HorPos][VerPos] ; +% Field[HorPos][VerPos] := origin--cycle ; +% Field[VerPos][HorPos] := Field[HorPos][VerPos] ; +% endfor ; +% endfor ; % def LoadPageState = % scantokens "input mp-state.tmp" ; @@ -160,10 +170,94 @@ def SwapPageState = fi ; enddef ; -def SetPageAreas = +% def SetPageAreas = +% +% numeric Vsize[], Hsize[], Vstep[], Hstep[] ; +% +% Vsize[Top] = TopHeight ; +% Vsize[TopSeparator] = TopDistance ; +% Vsize[Header] = HeaderHeight ; +% Vsize[HeaderSeparator] = HeaderDistance ; +% Vsize[Text] = TextHeight ; +% Vsize[FooterSeparator] = FooterDistance ; +% Vsize[Footer] = FooterHeight ; +% Vsize[BottomSeparator] = BottomDistance ; +% Vsize[Bottom] = BottomHeight ; +% +% Vstep[Top] = Vstep[TopSeparator] +Vsize[TopSeparator] ; +% Vstep[TopSeparator] = PaperHeight-TopSpace ; +% Vstep[Header] = Vstep[TopSeparator] -Vsize[Header] ; +% Vstep[HeaderSeparator] = Vstep[Header] -Vsize[HeaderSeparator] ; +% Vstep[Text] = Vstep[HeaderSeparator]-Vsize[Text] ; +% Vstep[FooterSeparator] = Vstep[Text] -Vsize[FooterSeparator] ; +% Vstep[Footer] = Vstep[FooterSeparator]-Vsize[Footer] ; +% Vstep[BottomSeparator] = Vstep[Footer] -Vsize[BottomSeparator] ; +% Vstep[Bottom] = Vstep[BottomSeparator]-Vsize[Bottom] ; +% +% Hsize[LeftEdge] = LeftEdgeWidth ; +% Hsize[LeftEdgeSeparator] = LeftEdgeDistance ; +% Hsize[LeftMargin] = LeftMarginWidth ; +% Hsize[LeftMarginSeparator] = LeftMarginDistance ; +% Hsize[Text] = MakeupWidth ; +% Hsize[RightMarginSeparator] = RightMarginDistance ; +% Hsize[RightMargin] = RightMarginWidth ; +% Hsize[RightEdgeSeparator] = RightEdgeDistance ; +% Hsize[RightEdge] = RightEdgeWidth ; +% +% Hstep[LeftEdge] = Hstep[LeftEdgeSeparator] -Hsize[LeftEdge] ; +% Hstep[LeftEdgeSeparator] = Hstep[LeftMargin] -Hsize[LeftEdgeSeparator] ; +% Hstep[LeftMargin] = Hstep[LeftMarginSeparator] -Hsize[LeftMargin] ; +% Hstep[LeftMarginSeparator] = Hstep[Text] -Hsize[LeftMarginSeparator] ; +% Hstep[Text] = BackSpace ; +% Hstep[RightMarginSeparator] = Hstep[Text] +Hsize[Text] ; +% Hstep[RightMargin] = Hstep[RightMarginSeparator]+Hsize[RightMarginSeparator] ; +% Hstep[RightEdgeSeparator] = Hstep[RightMargin] +Hsize[RightMargin] ; +% Hstep[RightEdge] = Hstep[RightEdgeSeparator] +Hsize[RightEdgeSeparator] ; +% +% for VerPos=Top step 10 until Bottom: +% for HorPos=LeftEdge step 1 until RightEdge: +% Area[HorPos][VerPos] := unitsquare xscaled Hsize[HorPos] yscaled Vsize[VerPos] ; +% Area[VerPos][HorPos] := Area[HorPos][VerPos] ; +% Location[HorPos][VerPos] := (Hstep[HorPos],Vstep[VerPos]) ; +% Location[VerPos][HorPos] := Location[HorPos][VerPos] ; +% Field[HorPos][VerPos] := Area[HorPos][VerPos] shifted Location[HorPos][VerPos] ; +% Field[VerPos][HorPos] := Field[HorPos][VerPos] ; +% endfor ; +% endfor ; +% +% Page := unitsquare xscaled PaperWidth yscaled PaperHeight ; +% +% enddef ; +% +% def BoundPageAreas = +% % pickup pencircle scaled 0pt ; +% bboxmargin := 0 ; setbounds currentpicture to Page ; +% enddef ; +% +% def StartPage = +% begingroup ; +% if PageStateAvailable : +% LoadPageState ; +% SwapPageState ; +% fi ; +% SetPageAreas ; +% BoundPageAreas ; +% enddef ; +% +% def StopPage = +% BoundPageAreas ; +% endgroup ; +% enddef ; - numeric Vsize[], Hsize[], Vstep[], Hstep[] ; +% Because metapost > 1.50 has dynamic memory management and is less +% efficient than before we now delay calculations ... (on a document +% with 150 pages the time spent in mp was close to 5 seconds which was +% only due to initialising the page related areas, something that was +% hardly noticeable before. At least now we're back to half a second +% for such a case. +def SetPageVsize = + numeric Vsize[] ; Vsize[Top] = TopHeight ; Vsize[TopSeparator] = TopDistance ; Vsize[Header] = HeaderHeight ; @@ -173,17 +267,10 @@ def SetPageAreas = Vsize[Footer] = FooterHeight ; Vsize[BottomSeparator] = BottomDistance ; Vsize[Bottom] = BottomHeight ; +enddef ; - Vstep[Top] = Vstep[TopSeparator] +Vsize[TopSeparator] ; - Vstep[TopSeparator] = PaperHeight-TopSpace ; - Vstep[Header] = Vstep[TopSeparator] -Vsize[Header] ; - Vstep[HeaderSeparator] = Vstep[Header] -Vsize[HeaderSeparator] ; - Vstep[Text] = Vstep[HeaderSeparator]-Vsize[Text] ; - Vstep[FooterSeparator] = Vstep[Text] -Vsize[FooterSeparator] ; - Vstep[Footer] = Vstep[FooterSeparator]-Vsize[Footer] ; - Vstep[BottomSeparator] = Vstep[Footer] -Vsize[BottomSeparator] ; - Vstep[Bottom] = Vstep[BottomSeparator]-Vsize[Bottom] ; - +def SetPageHsize = + numeric Hsize[] ; Hsize[LeftEdge] = LeftEdgeWidth ; Hsize[LeftEdgeSeparator] = LeftEdgeDistance ; Hsize[LeftMargin] = LeftMarginWidth ; @@ -193,7 +280,23 @@ def SetPageAreas = Hsize[RightMargin] = RightMarginWidth ; Hsize[RightEdgeSeparator] = RightEdgeDistance ; Hsize[RightEdge] = RightEdgeWidth ; +enddef ; + +def SetPageVstep = + numeric Vstep[] ; + Vstep[Top] = Vstep[TopSeparator] +Vsize[TopSeparator] ; + Vstep[TopSeparator] = PaperHeight-TopSpace ; + Vstep[Header] = Vstep[TopSeparator] -Vsize[Header] ; + Vstep[HeaderSeparator] = Vstep[Header] -Vsize[HeaderSeparator] ; + Vstep[Text] = Vstep[HeaderSeparator]-Vsize[Text] ; + Vstep[FooterSeparator] = Vstep[Text] -Vsize[FooterSeparator] ; + Vstep[Footer] = Vstep[FooterSeparator]-Vsize[Footer] ; + Vstep[BottomSeparator] = Vstep[Footer] -Vsize[BottomSeparator] ; + Vstep[Bottom] = Vstep[BottomSeparator]-Vsize[Bottom] ; +enddef ; +def SetPageHstep = + numeric Hstep[] ; Hstep[LeftEdge] = Hstep[LeftEdgeSeparator] -Hsize[LeftEdge] ; Hstep[LeftEdgeSeparator] = Hstep[LeftMargin] -Hsize[LeftEdgeSeparator] ; Hstep[LeftMargin] = Hstep[LeftMarginSeparator] -Hsize[LeftMargin] ; @@ -203,22 +306,67 @@ def SetPageAreas = Hstep[RightMargin] = Hstep[RightMarginSeparator]+Hsize[RightMarginSeparator] ; Hstep[RightEdgeSeparator] = Hstep[RightMargin] +Hsize[RightMargin] ; Hstep[RightEdge] = Hstep[RightEdgeSeparator] +Hsize[RightEdgeSeparator] ; +enddef ; +def SetPageArea = + path Area[][] ; for VerPos=Top step 10 until Bottom: for HorPos=LeftEdge step 1 until RightEdge: - Area[HorPos][VerPos] := unitsquare xscaled Hsize[HorPos] yscaled Vsize[VerPos] ; - Area[VerPos][HorPos] := Area[HorPos][VerPos] ; - Location[HorPos][VerPos] := (Hstep[HorPos],Vstep[VerPos]) ; - Location[VerPos][HorPos] := Location[HorPos][VerPos] ; - Field[HorPos][VerPos] := Area[HorPos][VerPos] shifted Location[HorPos][VerPos] ; - Field[VerPos][HorPos] := Field[HorPos][VerPos] ; + Area[HorPos][VerPos] := unitsquare xscaled Hsize[HorPos] yscaled Vsize[VerPos] ; + Area[VerPos][HorPos] := Area[HorPos][VerPos] ; endfor ; endfor ; +enddef ; +def SetPageLocation = + pair Location[][] ; + for VerPos=Top step 10 until Bottom: + for HorPos=LeftEdge step 1 until RightEdge: + Location[HorPos][VerPos] := (Hstep[HorPos],Vstep[VerPos]) ; + Location[VerPos][HorPos] := Location[HorPos][VerPos] ; + endfor ; + endfor ; +enddef ; + +def SetPageField = + path Field[][] ; + for VerPos=Top step 10 until Bottom: + for HorPos=LeftEdge step 1 until RightEdge: + Field[HorPos][VerPos] := unitsquare xscaled Hsize[HorPos] yscaled Vsize[VerPos] shifted (Hstep[HorPos],Vstep[VerPos]) ; + Field[VerPos][HorPos] := Field[HorPos][VerPos] ; + endfor ; + endfor ; +enddef ; + +def SetPagePage = + path Page ; Page := unitsquare xscaled PaperWidth yscaled PaperHeight ; +enddef ; +def mfun_page_Area = hide(SetPageArea ;) Area enddef ; +def mfun_page_Location = hide(SetPageLocation ;) Location enddef ; +def mfun_page_Field = hide(SetPageField ;) Field enddef ; +def mfun_page_Vsize = hide(SetPageVsize ;) Vsize enddef ; +def mfun_page_Hsize = hide(SetPageHsize ;) Hsize enddef ; +def mfun_page_Vstep = hide(SetPageVstep ;) Vstep enddef ; +def mfun_page_Hstep = hide(SetPageHstep ;) Hstep enddef ; +def mfun_page_Page = hide(SetPagePage ;) Page enddef ; + +def SetPageVariables = + let Area = mfun_page_Area ; + let Location = mfun_page_Location ; + let Field = mfun_page_Field ; + let Vsize = mfun_page_Vsize ; + let Hsize = mfun_page_Hsize ; + let Vstep = mfun_page_Vstep ; + let Hstep = mfun_page_Hstep ; + let Page = mfun_page_Page ; enddef ; +SetPageVariables ; + +let SetPageAreas = SetPageVariables ; % compatiblity + def BoundPageAreas = % pickup pencircle scaled 0pt ; bboxmargin := 0 ; setbounds currentpicture to Page ; @@ -226,11 +374,13 @@ enddef ; def StartPage = begingroup ; - if PageStateAvailable : - LoadPageState ; - SwapPageState ; + if mfun_first_run : + if PageStateAvailable : + LoadPageState ; + SwapPageState ; + fi ; + SetPageVariables ; fi ; - SetPageAreas ; BoundPageAreas ; enddef ; @@ -272,15 +422,27 @@ def SetCoverAreas = enddef ; +% def StartCover = +% begingroup ; +% if PageStateAvailable : +% LoadPageState ; +% % SwapPageState ; +% fi ; +% SetPageAreas ; +% SetCoverAreas ; +% BoundCoverAreas ; +% enddef ; def StartCover = begingroup ; - if PageStateAvailable : - LoadPageState ; - % SwapPageState ; + if mfun_first_run : + if PageStateAvailable : + LoadPageState ; + % SwapPageState ; + fi ; + SetPageVariables ; % was SetPageAreas ; + SetCoverAreas ; fi ; - SetPageAreas ; - SetCoverAreas ; BoundCoverAreas ; enddef ; diff --git a/Master/texmf-dist/metapost/context/base/mp-shap.mpiv b/Master/texmf-dist/metapost/context/base/mp-shap.mpiv index b62e636d56e..7136565108d 100644 --- a/Master/texmf-dist/metapost/context/base/mp-shap.mpiv +++ b/Master/texmf-dist/metapost/context/base/mp-shap.mpiv @@ -5,7 +5,7 @@ %D subtitle=shapes, %D author=Hans Hagen, %D date=\currentdate, -%D copyright={PRAGMA / Hans Hagen \& Ton Otten}] +%D copyright={PRAGMA ADE \& \CONTEXT\ Development Team}] %C %C This module is part of the \CONTEXT\ macro||package and is %C therefore copyrighted by \PRAGMA. See licen-en.pdf for diff --git a/Master/texmf-dist/metapost/context/base/mp-step.mpiv b/Master/texmf-dist/metapost/context/base/mp-step.mpiv index 654ef443d5a..f7a7ba5debb 100644 --- a/Master/texmf-dist/metapost/context/base/mp-step.mpiv +++ b/Master/texmf-dist/metapost/context/base/mp-step.mpiv @@ -5,7 +5,7 @@ %D subtitle=steps, %D author=Hans Hagen, %D date=\currentdate, -%D copyright={PRAGMA / Hans Hagen \& Ton Otten}] +%D copyright={PRAGMA ADE \& \CONTEXT\ Development Team}] %C %C This module is part of the \CONTEXT\ macro||package and is %C therefore copyrighted by \PRAGMA. See licen-en.pdf for diff --git a/Master/texmf-dist/metapost/context/base/mp-text.mpiv b/Master/texmf-dist/metapost/context/base/mp-text.mpiv index d5630f68ef2..b68e8412aef 100644 --- a/Master/texmf-dist/metapost/context/base/mp-text.mpiv +++ b/Master/texmf-dist/metapost/context/base/mp-text.mpiv @@ -5,7 +5,7 @@ %D subtitle=text support, %D author=Hans Hagen, %D date=\currentdate, -%D copyright={PRAGMA / Hans Hagen \& Ton Otten}] +%D copyright={PRAGMA ADE \& \CONTEXT\ Development Team}] %C %C This module is part of the \CONTEXT\ macro||package and is %C therefore copyrighted by \PRAGMA. See licen-en.pdf for diff --git a/Master/texmf-dist/metapost/context/base/mp-tool.mpiv b/Master/texmf-dist/metapost/context/base/mp-tool.mpiv index 764863b65ce..5b53dcdef91 100644 --- a/Master/texmf-dist/metapost/context/base/mp-tool.mpiv +++ b/Master/texmf-dist/metapost/context/base/mp-tool.mpiv @@ -5,12 +5,14 @@ %D subtitle=auxiliary macros, %D author=Hans Hagen, %D date=\currentdate, -%D copyright={PRAGMA / Hans Hagen \& Ton Otten}] +%D copyright={PRAGMA ADE \& \CONTEXT\ Development Team}] %C %C This module is part of the \CONTEXT\ macro||package and is %C therefore copyrighted by \PRAGMA. See mreadme.pdf for %C details. +% def loadfile(expr name) = scantokens("input " & name & ";") enddef ; + if known context_tool : endinput ; fi ; boolean context_tool ; context_tool := true ; @@ -26,33 +28,7 @@ let @## = @# ; if not known mpversion : string mpversion ; mpversion := "0.641" ; fi ; -% vardef mpversiongt(expr s) = -% scantokens (mpversion & " > " & if numeric s : decimal s else : s fi) -% enddef ; -% vardef mpversionlt(expr s) = -% scantokens (mpversion & " < " & if numeric s : decimal s else : s fi) -% enddef ; -% vardef mpversioneq(expr s) = -% scantokens (mpversion & " = " & if numeric s : decimal s else : s fi) -% enddef ; - -%D More interesting: -%D -%D \starttyping -%D fill fullcircle scaled 4cm withcolor if mpversiongt("0.6") : red else : green fi ; -%D fill fullcircle scaled 2cm withcolor if mpversionlt(0.6) : blue else : white fi ; -%D fill fullcircle scaled 1cm withcolor if mpversioncmp(0.6,">=") : yellow else : black fi ; -%D \stoptyping - -% no longer needed as we load runtime - -vardef mpversioncmp(expr s, c) = - scantokens (mpversion & c & if numeric s : decimal s else : s fi) -enddef ; - -vardef mpversionlt (expr s) = mpversioncmp(s, "<") enddef ; -vardef mpversioneq (expr s) = mpversioncmp(s, "=") enddef ; -vardef mpversiongt (expr s) = mpversioncmp(s, ">") enddef ; +newinternal metapostversion ; metapostversion := scantokens(mpversion) ; %D We always want \EPS\ conforming output, so we say: @@ -2181,3 +2157,168 @@ vardef mcomponent expr p = if cmykcolor p : magentapart p elseif rgbcolor p : 1 vardef ycomponent expr p = if cmykcolor p : yellowpart p elseif rgbcolor p : 1 - bluepart p else : p fi enddef ; vardef bcomponent expr p = if cmykcolor p : blackpart p elseif rgbcolor p : 0 else : p fi enddef ; +% draw image (...) ... ; % prescripts prepended to first, postscripts appended to last +% draw decorated (...) ... ; % prescripts prepended to each, postscripts appended to each +% draw redecorated (...) ... ; % prescripts assigned to each, postscripts assigned to each +% draw undecorated (...) ... ; % following properties are ignored, existing properties are kept +% +% draw decorated ( +% draw fullcircle scaled 20cm withpen pencircle scaled 20mm withcolor red withtransparency (1,.40) ; +% draw fullcircle scaled 15cm withpen pencircle scaled 15mm withcolor green withtransparency (1,.30) ; +% draw fullcircle scaled 10cm withpen pencircle scaled 10mm withcolor blue withtransparency (1,.20) ; +% ) +% withcolor blue +% withtransparency (1,.125) % selectively applied +% withpen pencircle scaled 10mm +% ; + +% vardef image (text imagedata) = % already defined +% save currentpicture ; +% picture currentpicture ; +% currentpicture := nullpicture ; +% imagedata ; +% currentpicture +% enddef ; + +vardef undecorated (text imagedata) text decoration = + save currentpicture ; + picture currentpicture ; + currentpicture := nullpicture ; + imagedata ; + currentpicture +enddef ; + + +if metapostversion < 1.770 : + + vardef decorated (text imagedata) text decoration = + save mfun_decorated_path, currentpicture ; + picture mfun_decorated_path, currentpicture ; + currentpicture := nullpicture ; + imagedata ; + mfun_decorated_path := currentpicture ; + currentpicture := nullpicture ; + for i within mfun_decorated_path : + addto currentpicture + if stroked i : + doublepath pathpart i + dashed dashpart i + withpen penpart i + withcolor colorpart i + decoration + elseif filled i : + contour pathpart i + withpen penpart i + withcolor colorpart i + decoration + elseif textual i : + also i + withcolor colorpart i + decoration + else : + also i + fi + ; + endfor ; + currentpicture + enddef ; + +else: + + vardef decorated (text imagedata) text decoration = + save mfun_decorated_path, currentpicture ; + picture mfun_decorated_path, currentpicture ; + currentpicture := nullpicture ; + imagedata ; + mfun_decorated_path := currentpicture ; + currentpicture := nullpicture ; + for i within mfun_decorated_path : + addto currentpicture + if stroked i : + doublepath pathpart i + dashed dashpart i + withpen penpart i + withcolor colorpart i + withprescript prescriptpart i + withpostscript postscriptpart i + decoration + elseif filled i : + contour pathpart i + withpen penpart i + withcolor colorpart i + withprescript prescriptpart i + withpostscript postscriptpart i + decoration + elseif textual i : + also i + withcolor colorpart i + withprescript prescriptpart i + withpostscript postscriptpart i + decoration + else : + also i + fi + ; + endfor ; + currentpicture + enddef ; + +fi ; + +vardef redecorated (text imagedata) text decoration = + save mfun_decorated_path, currentpicture ; + picture mfun_decorated_path, currentpicture ; + currentpicture := nullpicture ; + imagedata ; + mfun_decorated_path := currentpicture ; + currentpicture := nullpicture ; + for i within mfun_decorated_path : + addto currentpicture + if stroked i : + doublepath pathpart i + dashed dashpart i + withpen penpart i + decoration + elseif filled i : + contour pathpart i + withpen penpart i + decoration + elseif textual i : + also i + decoration + else : + also i + fi + ; + endfor ; + currentpicture +enddef ; + +% path mfun_bleed_box ; + +% primarydef p bleeded d = +% image ( +% mfun_bleed_box := boundingbox p ; +% if pair d : +% draw p xysized (bbwidth(p)+2*xpart d,bbheight(p)+2*ypart d) shifted -d ; +% else : +% draw p xysized (bbwidth(p)+2d,bbheight(p)+2d) shifted (-d,-d) ; +% fi ; +% setbounds currentpicture to mfun_bleed_box ; +% ) +% enddef ; + +%D Dimensions have bever been an issue as traditional MP can't make that large +%D pictures, but with double mode we need a catch: + +newinternal maxdimensions ; maxdimensions := 14000 ; + +def mfun_apply_max_dimensions = % not a generic helper, we want to protect this one + if bbwidth currentpicture > maxdimensions : + currentpicture := currentpicture if bbheight currentpicture > bbwidth currentpicture : ysized else : xsized fi maxdimensions ; + elseif bbheight currentpicture > maxdimensions : + currentpicture := currentpicture ysized maxdimensions ; + fi ; +enddef; + +extra_endfig := extra_endfig & "mfun_apply_max_dimensions ;" ; |