diff options
Diffstat (limited to 'metapost/context/base/mpiv/mp-mlib.mpiv')
-rw-r--r-- | metapost/context/base/mpiv/mp-mlib.mpiv | 1450 |
1 files changed, 1450 insertions, 0 deletions
diff --git a/metapost/context/base/mpiv/mp-mlib.mpiv b/metapost/context/base/mpiv/mp-mlib.mpiv new file mode 100644 index 000000000..2c84d01c2 --- /dev/null +++ b/metapost/context/base/mpiv/mp-mlib.mpiv @@ -0,0 +1,1450 @@ +%D \module +%D [ file=mp-mlib.mpiv, +%D version=2008.03.21, +%D title=\CONTEXT\ \METAPOST\ graphics, +%D subtitle=plugins, +%D author=Hans Hagen, +%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 unknown mplib : endinput ; fi ; +if known context_mlib : endinput ; fi ; + +boolean context_mlib ; context_mlib := true ; + +%D Color and transparency +%D +%D Separable: + +newinternal normaltransparent ; normaltransparent := 1 ; +newinternal multiplytransparent ; multiplytransparent := 2 ; +newinternal screentransparent ; screentransparent := 3 ; +newinternal overlaytransparent ; overlaytransparent := 4 ; +newinternal softlighttransparent ; softlighttransparent := 5 ; +newinternal hardlighttransparent ; hardlighttransparent := 6 ; +newinternal colordodgetransparent ; colordodgetransparent := 7 ; +newinternal colorburntransparent ; colorburntransparent := 8 ; +newinternal darkentransparent ; darkentransparent := 9 ; +newinternal lightentransparent ; lightentransparent := 10 ; +newinternal differencetransparent ; differencetransparent := 11 ; +newinternal exclusiontransparent ; exclusiontransparent := 12 ; + +%D Nonseparable: + +newinternal huetransparent ; huetransparent := 13 ; +newinternal saturationtransparent ; saturationtransparent := 14 ; +newinternal colortransparent ; colortransparent := 15 ; +newinternal luminositytransparent ; luminositytransparent := 16 ; + +vardef transparency_alternative_to_number(expr name) = + if string name : + if expandafter known scantokens(name & "transparent") : + scantokens(name & "transparent") + else : + 0 + fi + elseif name < 17 : + name + else : + 0 + fi +enddef ; + +def namedcolor (expr n) = + 1 + withprescript "sp_type=named" + withprescript "sp_name=" & n +enddef ; + +% def spotcolor(expr n, v) = +% 1 +% withprescript "sp_type=spot" +% withprescript "sp_name=" & n +% withprescript "sp_value=" & (if numeric v : decimal v else : v fi) +% enddef ; +% +% def multitonecolor(expr name, fractions, components, value) = +% 1 +% withprescript "sp_type=multitone" +% withprescript "sp_name=" & name +% withprescript "sp_fractions=" & decimal fractions +% withprescript "sp_components=" & components +% withprescript "sp_value=" & value +% enddef ; + +def spotcolor(expr n, v) = + 1 + withprescript "sp_type=spot" + withprescript "sp_name=" & n + withprescript "sp_value=" & colordecimals v +enddef ; + +def multitonecolor(expr name)(text t) = + 1 + withprescript "sp_type=multitone" + withprescript "sp_name=" & name + withprescript "sp_value=" & colordecimalslist(t) +enddef ; + +def transparent(expr a, t)(text c) = % use withtransparency instead + 1 % this permits withcolor x intoshade y + withprescript "tr_alternative=" & decimal transparency_alternative_to_number(a) + withprescript "tr_transparency=" & decimal t + withcolor c +enddef ; + +% def withtransparency(expr a, t) = +% withprescript "tr_alternative=" & decimal transparency_alternative_to_number(a) +% withprescript "tr_transparency=" & decimal t +% enddef ; + +let transparency = pair ; + +% def withtransparency expr t = +% withprescript "tr_alternative=" & decimal transparency_alternative_to_number(xpart t) +% withprescript "tr_transparency=" & decimal ypart t +% enddef ; +% +% withtransparency (1,.5) +% withtransparency ("normal",.5) + +def withtransparency (expr t) (text rest) = + if pair t : + withprescript "tr_alternative=" & decimal transparency_alternative_to_number(xpart t) + withprescript "tr_transparency=" & decimal ypart t + else : + mfun_with_transparency (transparency_alternative_to_number(t)) + fi rest +enddef ; + +def mfun_with_transparency (expr a) expr t = + withprescript "tr_alternative=" & decimal a + withprescript "tr_transparency=" & decimal t +enddef ; + +def cmyk(expr c, m, y, k) = % provided for downward compability + (c,m,y,k) +enddef ; + +% Texts (todo: better strut ratio, now .7 hardcoded, should be passed) + +newinternal textextoffset ; textextoffset := 0 ; + +%%%%%%% mfun_tt_w[], mfun_tt_h[], mfun_tt_d[] ; % we can consider using colors (less hash space) +color mfun_tt_b ; +numeric mfun_tt_n ; mfun_tt_n := 0 ; +picture mfun_tt_p ; mfun_tt_p := nullpicture ; +picture mfun_tt_o ; mfun_tt_o := nullpicture ; +picture mfun_tt_c ; mfun_tt_c := nullpicture ; + +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 ; + mfun_tt_p := nullpicture ; + mfun_tt_o := nullpicture ; % redundant + mfun_tt_c := nullpicture ; % redundant +enddef ; + +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 ;" ; + +% 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 +% flush twice: once in location in order to pick up e.g. color properties, +% and once at the end because we need to flush missing ones. + +% see mp-keep.mpiv for older code + +% vardef rawtextext(expr s) = % todo: avoid currentpicture +% if s = "" : +% nullpicture +% else : +% mfun_tt_n := mfun_tt_n + 1 ; +% mfun_tt_c := nullpicture ; +% if mfun_trial_run : +% mfun_tt_o := nullpicture ; +% addto mfun_tt_o doublepath origin _op_ ; % save drawoptions +% addto mfun_tt_c doublepath unitsquare +% withprescript "tx_number=" & decimal mfun_tt_n +% withprescript "tx_stage=trial" +% withprescript "tx_color=" & colordecimals colorpart mfun_tt_o +% withpostscript s ; +% addto mfun_tt_p also mfun_tt_c ; +% elseif known mfun_tt_d[mfun_tt_n] : +% addto mfun_tt_c doublepath unitsquare +% xscaled mfun_tt_w[mfun_tt_n] +% yscaled (mfun_tt_h[mfun_tt_n] + mfun_tt_d[mfun_tt_n]) +% shifted (0,-mfun_tt_d[mfun_tt_n]) +% withprescript "tx_number=" & decimal mfun_tt_n +% withprescript "tx_stage=final" ; +% else : +% addto mfun_tt_c doublepath unitsquare ; % unitpicture +% fi ; +% mfun_tt_c +% fi +% enddef ; + +boolean mfun_onetime_textext ; mfun_onetime_textext := false ; + +vardef rawtextext(expr s) = % todo: avoid currentpicture + if s = "" : + mfun_onetime_textext := false ; + nullpicture + else : + mfun_tt_n := mfun_tt_n + 1 ; + mfun_tt_c := nullpicture ; + if mfun_trial_run : + mfun_tt_o := nullpicture ; + addto mfun_tt_o doublepath origin _op_ ; % save drawoptions + addto mfun_tt_c doublepath unitsquare + withprescript "tx_number=" & decimal mfun_tt_n + withprescript "tx_stage=trial" + withprescript "tx_color=" & colordecimals colorpart mfun_tt_o + withpostscript s ; + if not mfun_onetime_textext : + addto mfun_tt_p also mfun_tt_c + withprescript "tx_global=yes" ; + fi ; + else : + mfun_tt_b := lua.mp.tt_dimensions(mfun_tt_n) ; + addto mfun_tt_c doublepath unitsquare + xscaled redpart mfun_tt_b + yscaled (greenpart mfun_tt_b + bluepart mfun_tt_b) + shifted (0,- bluepart mfun_tt_b) + withprescript "tx_number=" & decimal mfun_tt_n + withprescript "tx_stage=final" ; + fi ; + mfun_onetime_textext := false ; + mfun_tt_c + fi +enddef ; + +% More text + +defaultfont := "Mono" ; +defaultscale := 1 ; + +extra_beginfig := extra_beginfig & "defaultscale:=1;" ; + +vardef fontsize expr name = + save size ; numeric size ; + size := bbwidth(textext("\MPfontsizehskip{" & name & "}")) ; + if size = 0 : + 12pt + else : + size + fi +enddef ; + +pair mfun_laboff ; mfun_laboff := (0,0) ; +pair mfun_laboff.lft ; mfun_laboff.lft := (-1,0) ; +pair mfun_laboff.rt ; mfun_laboff.rt := (1,0) ; +pair mfun_laboff.bot ; mfun_laboff.bot := (0,-1) ; +pair mfun_laboff.top ; mfun_laboff.top := (0,1) ; +pair mfun_laboff.ulft ; mfun_laboff.ulft := (-.7,.7) ; +pair mfun_laboff.urt ; mfun_laboff.urt := (.7,.7) ; +pair mfun_laboff.llft ; mfun_laboff.llft := -(.7,.7) ; +pair mfun_laboff.lrt ; mfun_laboff.lrt := (.7,-.7) ; + +pair mfun_laboff.d ; mfun_laboff.d := mfun_laboff ; +pair mfun_laboff.dlft ; mfun_laboff.dlft := mfun_laboff.lft ; +pair mfun_laboff.drt ; mfun_laboff.drt := mfun_laboff.rt ; +pair mfun_laboff.origin ; mfun_laboff.origin := origin ; +pair mfun_laboff.raw ; mfun_laboff.raw := origin ; + +pair mfun_laboff.l ; mfun_laboff.l := mfun_laboff.lft ; +pair mfun_laboff.r ; mfun_laboff.r := mfun_laboff.rt ; +pair mfun_laboff.b ; mfun_laboff.b := mfun_laboff.bot ; +pair mfun_laboff.t ; mfun_laboff.t := mfun_laboff.top ; +pair mfun_laboff.l_t ; mfun_laboff.l_t := mfun_laboff.ulft ; +pair mfun_laboff.r_t ; mfun_laboff.r_t := mfun_laboff.urt ; +pair mfun_laboff.l_b ; mfun_laboff.l_b := mfun_laboff.llft ; +pair mfun_laboff.r_b ; mfun_laboff.r_b := mfun_laboff.lrt ; +pair mfun_laboff.t_l ; mfun_laboff.t_l := mfun_laboff.ulft ; +pair mfun_laboff.t_r ; mfun_laboff.t_r := mfun_laboff.urt ; +pair mfun_laboff.b_l ; mfun_laboff.b_l := mfun_laboff.llft ; +pair mfun_laboff.b_r ; mfun_laboff.b_r := mfun_laboff.lrt ; + +mfun_labxf := 0.5 ; +mfun_labxf.lft := mfun_labxf.l := 1 ; +mfun_labxf.rt := mfun_labxf.r := 0 ; +mfun_labxf.bot := mfun_labxf.b := 0.5 ; +mfun_labxf.top := mfun_labxf.t := 0.5 ; +mfun_labxf.ulft := mfun_labxf.l_t := mfun_labxf.t_l := 1 ; +mfun_labxf.urt := mfun_labxf.r_t := mfun_labxf.t_r := 0 ; +mfun_labxf.llft := mfun_labxf.l_b := mfun_labxf.b_l := 1 ; +mfun_labxf.lrt := mfun_labxf.r_b := mfun_labxf.b_r := 0 ; + +mfun_labxf.d := mfun_labxf ; +mfun_labxf.dlft := mfun_labxf.lft ; +mfun_labxf.drt := mfun_labxf.rt ; +mfun_labxf.origin := 0 ; +mfun_labxf.raw := 0 ; + +mfun_labyf := 0.5 ; +mfun_labyf.lft := mfun_labyf.l := 0.5 ; +mfun_labyf.rt := mfun_labyf.r := 0.5 ; +mfun_labyf.bot := mfun_labyf.b := 1 ; +mfun_labyf.top := mfun_labyf.t := 0 ; +mfun_labyf.ulft := mfun_labyf.l_t := mfun_labyf.t_l := 0 ; +mfun_labyf.urt := mfun_labyf.r_t := mfun_labyf.t_r := 0 ; +mfun_labyf.llft := mfun_labyf.l_b := mfun_labyf.b_l := 1 ; +mfun_labyf.lrt := mfun_labyf.r_b := mfun_labyf.b_r := 1 ; + +mfun_labyf.d := mfun_labyf ; +mfun_labyf.dlft := mfun_labyf.lft ; +mfun_labyf.drt := mfun_labyf.rt ; +mfun_labyf.origin := 0 ; +mfun_labyf.raw := 0 ; + +mfun_labtype := 0 ; +mfun_labtype.lft := mfun_labtype.l := 1 ; +mfun_labtype.rt := mfun_labtype.r := 2 ; +mfun_labtype.bot := mfun_labtype.b := 3 ; +mfun_labtype.top := mfun_labtype.t := 4 ; +mfun_labtype.ulft := mfun_labtype.l_t := mfun_labtype.t_l := 5 ; +mfun_labtype.urt := mfun_labtype.r_t := mfun_labtype.t_r := 6 ; +mfun_labtype.llft := mfun_labtype.l_b := mfun_labtype.b_l := 7 ; +mfun_labtype.lrt := mfun_labtype.r_b := mfun_labtype.b_r := 8 ; +mfun_labtype.d := 10 ; +mfun_labtype.dlft := 11 ; +mfun_labtype.drt := 12 ; +mfun_labtype.origin := 0 ; +mfun_labtype.raw := 0 ; + +% installlabel.foo ( 0, 1, 1, (.5,-1) ) ; + +vardef installlabel@# (expr type, x, y, offset) = + numeric labtype@# ; labtype@# := type ; + pair laboff @# ; laboff @# := offset ; + numeric labxf @# ; labxf @# := x ; + numeric labyf @# ; labyf @# := y ; +enddef ; + +% we save the plain variant + +vardef plain_thelabel@#(expr p,z) = + if string p : + plain_thelabel@#(rawtextext("\definedfont[" & defaultfont & "]" & p) scaled defaultscale,z) + else : + p shifted (z + labeloffset*laboff@# - (labxf@#*lrcorner p + labyf@#*ulcorner p + (1-labxf@#-labyf@#)*llcorner p)) + fi +enddef; + +def plain_label = % takes two arguments, contrary to textext that takes one + normaldraw plain_thelabel +enddef ; + +let mfun_label = label ; +let mfun_thelabel = thelabel ; + +def useplainlabels = % somehow let doesn't work for all code + def label = plain_label enddef ; + def thelabel = plain_thelabel enddef ; +enddef ; + +def usemetafunlabels = + let label = mfun_label ; + let thelabel = mfun_thelabel ; +enddef ; + +vardef dotlabel@#(expr s,z) text t_ = + label@#(s,z) t_ ; + interim linecap := rounded ; + normaldraw z withpen pencircle scaled dotlabeldiam t_ ; +enddef ; + +plain_compatibility_data := plain_compatibility_data & "save label, thelabel ;" & "useplainlabels ;" ; + +% next comes own own: + +vardef thetextext@#(expr p,z) = + % interim labeloffset := textextoffset ; + if string p : + thetextext@#(rawtextext(p),z) + elseif numeric p : + thetextext@#(rawtextext(decimal p),z) + else : + p + if (mfun_labtype@# >= 10) : + shifted (0,ypart center p) + fi + shifted (z + textextoffset*mfun_laboff@# - (mfun_labxf@#*lrcorner p + mfun_labyf@#*ulcorner p + (1-mfun_labxf@#-mfun_labyf@#)*llcorner p)) + fi +enddef ; + +vardef textext@#(expr p) = % no draw here + thetextext@#(p,origin) +enddef ; + +vardef onetimetextext@#(expr p) = % no draw here + mfun_onetime_textext := true ; + thetextext@#(p,origin) +enddef ; + +vardef thelabel@#(expr p,z) = + if string p : + thelabel@#(rawtextext("\definedfont[" & defaultfont & "]" & p) scaled defaultscale,z) + else : + p shifted (z + labeloffset*mfun_laboff@# - (mfun_labxf@#*lrcorner p + mfun_labyf@#*ulcorner p + (1-mfun_labxf@#-mfun_labyf@#)*llcorner p)) + fi +enddef; + +def label = % takes two arguments, contrary to textext that takes one + normaldraw thelabel +enddef ; + +vardef anchored@#(expr p, z) = % beware: no "+ mfun_laboff@#" here (never!) + p + if (mfun_labtype@# >= 10) : + shifted (0,ypart center p) + fi + shifted (z + (mfun_labxf@#*lrcorner p + mfun_labyf@#*ulcorner p + (1-mfun_labxf@#-mfun_labyf@#)*llcorner p)) +enddef ; + +let normalinfont = infont ; + +primarydef s infont name = % nasty hack + if name = "" : + textext(s) + else : + textext("\definedfont[" & name & "]" & s) + fi +enddef ; + +% Helper + +string mfun_prescript_separator ; mfun_prescript_separator := char(13) ; + +% Shades + +% for while we had this: + +newinternal shadefactor ; shadefactor := 1 ; % currently obsolete +pair shadeoffset ; shadeoffset := origin ; % currently obsolete +boolean trace_shades ; trace_shades := false ; % still there + +% def withlinearshading (expr a, b) = +% withprescript "sh_type=linear" +% withprescript "sh_domain=0 1" +% withprescript "sh_factor=" & decimal shadefactor +% withprescript "sh_center_a=" & ddecimal (a shifted shadeoffset) +% withprescript "sh_center_b=" & ddecimal (b shifted shadeoffset) +% enddef ; +% +% def withcircularshading (expr a, b, ra, rb) = +% withprescript "sh_type=circular" +% withprescript "sh_domain=0 1" +% withprescript "sh_factor=" & decimal shadefactor +% withprescript "sh_center_a=" & ddecimal (a shifted shadeoffset) +% withprescript "sh_center_b=" & ddecimal (b shifted shadeoffset) +% withprescript "sh_radius_a=" & decimal ra +% withprescript "sh_radius_b=" & decimal rb +% enddef ; +% +% def withshading (expr how)(text rest) = +% if how = "linear" : +% withlinearshading(rest) +% elseif how = "circular" : +% withcircularshading(rest) +% else : +% % nothing +% fi +% enddef ; +% +% def withfromshadecolor expr t = +% withprescript "sh_color=into" +% withprescript "sh_color_a=" & colordecimals t +% enddef ; + +% def withtoshadecolor expr t = +% withprescript "sh_color=into" +% withprescript "sh_color_b=" & colordecimals t +% enddef ; + +% but this is nicer + +% fill fullcircle scaled 10cm +% withshademethod "circular" +% withshadevector (5cm,1cm) +% withshadecenter (.1,.5) +% withshadedomain (.2,.6) +% withshadefactor 1.2 +% withshadecolors (red,green) +% ; + +path mfun_shade_path ; +numeric mfun_shade_step ; mfun_shade_step := 0 ; + +def withshadestep = + hide(mfun_shade_step := mfun_shade_step + 1 ;) + mfun_withshadestep +enddef ; + +def mfun_withshadestep (text t) = + withprescript "sh_step=" & decimal mfun_shade_step + t +enddef ; + +primarydef p withshademethod m = + hide( + mfun_shade_path := p ; + mfun_shade_step := 1 ; + ) + p + withprescript "sh_domain=0 1" + withprescript "sh_color=into" + withprescript "sh_color_a=" & colordecimals white + withprescript "sh_color_b=" & colordecimals black + if m = "linear" : + withprescript "sh_type=linear" + withprescript "sh_factor=1" + withprescript "sh_center_a=" & ddecimal llcorner p + withprescript "sh_center_b=" & ddecimal urcorner p + else : + withprescript "sh_type=circular" + withprescript "sh_factor=1.2" + withprescript "sh_center_a=" & ddecimal center p + withprescript "sh_center_b=" & ddecimal center p + withprescript "sh_radius_a=" & decimal 0 + withprescript "sh_radius_b=" & decimal ( max ( + (xpart center p - xpart llcorner p) ++ (ypart center p - ypart llcorner p), + (xpart center p - xpart ulcorner p) ++ (ypart ulcorner p - ypart center p), + (xpart lrcorner p - xpart center p) ++ (ypart center p - ypart lrcorner p), + (xpart urcorner p - xpart center p) ++ (ypart urcorner p - ypart center p) + ) ) + fi +enddef ; + +def withshadevector expr a = + withprescript "sh_center_a=" & ddecimal (point xpart a of mfun_shade_path) + withprescript "sh_center_b=" & ddecimal (point ypart a of mfun_shade_path) +enddef ; + +def withshadecenter expr a = + withprescript "sh_center_a=" & ddecimal ( + center mfun_shade_path shifted ( + xpart a * bbwidth (mfun_shade_path)/2, + ypart a * bbheight(mfun_shade_path)/2 + ) + ) +enddef ; + +def withshadedomain expr d = + withprescript "sh_domain=" & ddecimal d +enddef ; + +def withshadefactor expr f = + withprescript "sh_factor=" & decimal f +enddef ; + +% def withshadebound (expr a) = +% if mfun_shade_step > 0 : +% withprescript "sh_bound_" & decimal mfun_shade_step & "=" & decimal a +% fi +% enddef ; + +def withshadefraction expr a = + if mfun_shade_step > 0 : + withprescript "sh_fraction_" & decimal mfun_shade_step & "=" & decimal a + fi +enddef ; + +def withshadecolors (expr a, b) = + if mfun_shade_step > 0 : + withprescript "sh_color=into" + withprescript "sh_color_a_" & decimal mfun_shade_step & "=" & colordecimals a + withprescript "sh_color_b_" & decimal mfun_shade_step & "=" & colordecimals b + else : + withprescript "sh_color=into" + withprescript "sh_color_a=" & colordecimals a + withprescript "sh_color_b=" & colordecimals b + fi +enddef ; + +primarydef a shadedinto b = % withcolor red shadedinto green + 1 % does not work with transparency + withprescript "sh_color=into" + withprescript "sh_color_a=" & colordecimals a + withprescript "sh_color_b=" & colordecimals b +enddef ; + +primarydef p withshade sc = + p withprescript mfun_defined_cs_pre[sc] +enddef ; + +def defineshade suffix s = + mfun_defineshade(str s) +enddef ; + +def mfun_defineshade (expr s) text t = + expandafter def scantokens s = t enddef ; +enddef ; + +def shaded text s = + s +enddef ; + +% Old macros: + +def withcircularshade (expr a, b, ra, rb, ca, cb) = + withprescript "sh_type=circular" + withprescript "sh_domain=0 1" + withprescript "sh_factor=1" + withprescript "sh_color_a=" & colordecimals ca + withprescript "sh_color_b=" & colordecimals cb + withprescript "sh_center_a=" & ddecimal a % (a shifted shadeoffset) + withprescript "sh_center_b=" & ddecimal b % (b shifted shadeoffset) + withprescript "sh_radius_a=" & decimal ra + withprescript "sh_radius_b=" & decimal rb +enddef ; + +def withlinearshade (expr a, b, ca, cb) = + withprescript "sh_type=linear" + withprescript "sh_domain=0 1" + withprescript "sh_factor=1" + withprescript "sh_color_a=" & colordecimals ca + withprescript "sh_color_b=" & colordecimals cb + withprescript "sh_center_a=" & ddecimal a % (a shifted shadeoffset) + withprescript "sh_center_b=" & ddecimal b % (b shifted shadeoffset) +enddef ; + +% replaced (obsolete): + +def set_linear_vector (suffix a,b)(expr p,n) = + if (n=1) : a := llcorner p ; b := urcorner p ; + elseif (n=2) : a := lrcorner p ; b := ulcorner p ; + elseif (n=3) : a := urcorner p ; b := llcorner p ; + elseif (n=4) : a := ulcorner p ; b := lrcorner p ; + elseif (n=5) : a := .5[ulcorner p,llcorner p] ; b := .5[urcorner p,lrcorner p] ; + elseif (n=6) : a := .5[llcorner p,lrcorner p] ; b := .5[ulcorner p,urcorner p] ; + elseif (n=7) : a := .5[lrcorner p,urcorner p] ; b := .5[llcorner p,ulcorner p] ; + elseif (n=8) : a := .5[urcorner p,ulcorner p] ; b := .5[lrcorner p,llcorner p] ; + else : a := .5[ulcorner p,llcorner p] ; b := .5[urcorner p,lrcorner p] ; + fi ; +enddef ; + +def set_circular_vector (suffix ab,r)(expr p,n) = + if (n=1) : ab := llcorner p ; + elseif (n=2) : ab := lrcorner p ; + elseif (n=3) : ab := urcorner p ; + elseif (n=4) : ab := ulcorner p ; + else : ab := center p ; r := .5r ; + fi ; +enddef ; + +def circular_shade (expr p, n, ca, cb) = + begingroup ; + save ab, r ; pair ab ; numeric r ; + r := (xpart lrcorner p - xpart llcorner p) ++ (ypart urcorner p - ypart lrcorner p) ; + set_circular_vector(ab,r)(p,n) ; + fill p withcircularshade(ab,ab,0,r,ca,cb) ; + if trace_shades : + drawarrow ab -- ab shifted (0,r) withpen pencircle scaled 1pt withcolor .5white ; + fi ; + endgroup ; +enddef ; + +def linear_shade (expr p, n, ca, cb) = + begingroup ; + save a, b ; pair a, b ; + set_linear_vector(a,b)(p,n) ; + fill p withlinearshade(a,b,ca,cb) ; + if trace_shades : + drawarrow a -- b withpen pencircle scaled 1pt withcolor .5white ; + fi ; + endgroup ; +enddef ; + +string mfun_defined_cs_pre[] ; numeric mfun_defined_cs ; mfun_defined_cs := 0 ; + +vardef define_circular_shade (expr a, b, ra, rb, ca, cb) = + mfun_defined_cs := mfun_defined_cs + 1 ; + mfun_defined_cs_pre[mfun_defined_cs] := "sh_type=circular" + & mfun_prescript_separator & "sh_domain=0 1" + & mfun_prescript_separator & "sh_factor=1" + & mfun_prescript_separator & "sh_color_a=" & colordecimals ca + & mfun_prescript_separator & "sh_color_b=" & colordecimals cb + & mfun_prescript_separator & "sh_center_a=" & ddecimal a % (a shifted shadeoffset) + & mfun_prescript_separator & "sh_center_b=" & ddecimal b % (b shifted shadeoffset) + & mfun_prescript_separator & "sh_radius_a=" & decimal ra + & mfun_prescript_separator & "sh_radius_b=" & decimal rb + ; + mfun_defined_cs +enddef ; + +vardef define_linear_shade (expr a, b, ca, cb) = + mfun_defined_cs := mfun_defined_cs + 1 ; + mfun_defined_cs_pre[mfun_defined_cs] := "sh_type=linear" + & mfun_prescript_separator & "sh_domain=0 1" + & mfun_prescript_separator & "sh_factor=1" + & mfun_prescript_separator & "sh_color_a=" & colordecimals ca + & mfun_prescript_separator & "sh_color_b=" & colordecimals cb + & mfun_prescript_separator & "sh_center_a=" & ddecimal a % (a shifted shadeoffset) + & mfun_prescript_separator & "sh_center_b=" & ddecimal b % (b shifted shadeoffset) + ; + mfun_defined_cs +enddef ; + +% I lost the example code that uses this: +% +% vardef define_sampled_linear_shade(expr a,b,n)(text t) = +% mfun_defined_cs := mfun_defined_cs + 1 ; +% mfun_defined_cs_pre[mfun_defined_cs] := "ssh_type=linear" +% & mfun_prescript_separator & "ssh_center_a=" & ddecimal (a shifted shadeoffset) +% & mfun_prescript_separator & "ssh_center_b=" & ddecimal (b shifted shadeoffset) +% & mfun_prescript_separator & "ssh_nofcolors=" & decimal n +% & mfun_prescript_separator & "ssh_domain=" & domstr +% & mfun_prescript_separator & "ssh_extend=" & extstr +% & mfun_prescript_separator & "ssh_colors=" & colstr +% & mfun_prescript_separator & "ssh_bounds=" & bndstr +% & mfun_prescript_separator & "ssh_ranges=" & ranstr +% ; +% mfun_defined_cs +% enddef ; +% +% vardef define_sampled_circular_shade(expr a,b,ra,rb,n)(text t) = +% mfun_defined_cs := mfun_defined_cs + 1 ; +% mfun_defined_cs_pre[mfun_defined_cs] := "ssh_type=circular" +% & mfun_prescript_separator & "ssh_center_a=" & ddecimal (a shifted shadeoffset) +% & mfun_prescript_separator & "ssh_radius_a=" & decimal ra +% & mfun_prescript_separator & "ssh_center_b=" & ddecimal (b shifted shadeoffset) +% & mfun_prescript_separator & "ssh_radius_b=" & decimal rb +% & mfun_prescript_separator & "ssh_nofcolors=" & decimal n +% & mfun_prescript_separator & "ssh_domain=" & domstr +% & mfun_prescript_separator & "ssh_extend=" & extstr +% & mfun_prescript_separator & "ssh_colors=" & colstr +% & mfun_prescript_separator & "ssh_bounds=" & bndstr +% & mfun_prescript_separator & "ssh_ranges=" & ranstr +% ; +% mfun_defined_cs +% enddef ; + +% vardef predefined_linear_shade (expr p, n, ca, cb) = +% save a, b, sh ; pair a, b ; +% set_linear_vector(a,b)(p,n) ; +% define_linear_shade (a,b,ca,cb) +% enddef ; +% +% vardef predefined_circular_shade (expr p, n, ca, cb) = +% save ab, r ; pair ab ; numeric r ; +% r := (xpart lrcorner p - xpart llcorner p) ++ (ypart urcorner p - ypart lrcorner p) ; +% set_circular_vector(ab,r)(p,n) ; +% define_circular_shade(ab,ab,0,r,ca,cb) +% enddef ; + +% Layers + +def onlayer primary name = + withprescript "la_name=" & name +enddef ; + +% Figures + +% def externalfigure primary filename = +% doexternalfigure (filename) +% enddef ; +% +% def doexternalfigure (expr filename) text transformation = +% if true : % a bit incompatible esp scaled 1cm now scaled the natural size +% draw rawtextext("\externalfigure[" & filename & "]") transformation ; +% else : +% draw unitsquare transformation withprescript "fg_name=" & filename ; +% fi ; +% enddef ; + +def withmask primary filename = + withprescript "fg_mask=" & filename +enddef ; + +def externalfigure primary filename = + if false : + rawtextext("\externalfigure[" & filename & "]") + else : + image ( + addto currentpicture doublepath unitsquare + withprescript "fg_name=" & filename ; + ) +% unitsquare +% withpen pencircle scaled 0 +% withprescript "fg_name=" & filename + fi +enddef ; + +def figure primary filename = + rawtextext("\externalfigure[" & filename & "]") +enddef ; + +% Positions + +def register (expr tag, width, height, offset) = +% draw image ( + addto currentpicture doublepath unitsquare xscaled width yscaled height shifted offset + withprescript "ps_label=" & tag ; +% ) ; % no transformations +enddef ; + +% outlines (todo: pass around less arguments) + +numeric currentoutlinetext ; currentoutlinetext := 0 ; + +vardef mfun_do_outline_text_flush (expr kind, n, x, y) (text t) = + if kind = "f" : + mfun_do_outline_text_f (n, x, y) (t) + elseif kind = "d" : + mfun_do_outline_text_d (n, x, y) (t) + elseif kind = "b" : + mfun_do_outline_text_b (n, x, y) (t) + elseif kind = "r" : + mfun_do_outline_text_r (n, x, y) (t) + elseif kind = "p" : + mfun_do_outline_text_p (n, x, y) (t) + else : + mfun_do_outline_text_n (n, x, y) (t) + fi ; +enddef ; + +numeric mfun_do_outline_n ; mfun_do_outline_n := 0 ; + +vardef mfun_do_outline_text_f (expr n, x, y) (text t) = + mfun_do_outline_n := 0 ; + for i=t : + mfun_do_outline_n := mfun_do_outline_n + 1 ; + if mfun_do_outline_n = n : + fill i shifted(x,y) mfun_do_outline_options_f + else : + nofill i shifted(x,y) + fi ; + endfor ; +enddef ; + +vardef mfun_do_outline_text_d (expr n, x, y) (text t) = + for i=t : + draw i shifted(x,y) mfun_do_outline_options_d ; + endfor ; +enddef ; + +vardef mfun_do_outline_text_p (expr n, x, y) (text t) = + for i=t : + draw i shifted(x,y) ; + endfor ; +enddef ; + +vardef mfun_do_outline_text_b (expr n, x, y) (text t) = + mfun_do_outline_n := 0 ; + for i=t : + mfun_do_outline_n := mfun_do_outline_n + 1 ; + if mfun_do_outline_n = n : + fill i shifted(x,y) mfun_do_outline_options_f + else : + nofill i shifted(x,y) + fi ; + endfor ; + for i=t : + draw i shifted(x,y) mfun_do_outline_options_d ; + endfor ; +enddef ; + +vardef mfun_do_outline_text_r (expr n, x, y) (text t) = + mfun_do_outline_n := 0 ; + for i=t : + draw i shifted(x,y) mfun_do_outline_options_d ; + endfor ; + for i=t : + mfun_do_outline_n := mfun_do_outline_n + 1 ; + if mfun_do_outline_n = n : + fill i shifted(x,y) mfun_do_outline_options_f + else : + nofill i shifted(x,y) + fi ; + endfor ; +enddef ; + +vardef mfun_do_outline_text_n (expr n, x, y) (text t) = + mfun_do_outline_n := 0 ; + for i=t : + mfun_do_outline_n := mfun_do_outline_n + 1 ; + if mfun_do_outline_n = n : fill else : nofill fi i shifted(x,y) ; + endfor ; +enddef ; + +vardef mfun_do_outline_text_set_f (text f) text r = + def mfun_do_outline_options_f = f enddef ; + def mfun_do_outline_options_r = r enddef ; +enddef ; + +vardef mfun_do_outline_text_set_d (text d) text r = + def mfun_do_outline_options_d = d enddef ; + def mfun_do_outline_options_r = r enddef ; +enddef ; + +vardef mfun_do_outline_text_set_b (text f) (text d) text r = + def mfun_do_outline_options_f = f enddef ; + def mfun_do_outline_options_d = d enddef ; + def mfun_do_outline_options_r = r enddef ; +enddef ; + +vardef mfun_do_outline_text_set_r (text d) (text f) text r = + def mfun_do_outline_options_d = d enddef ; + def mfun_do_outline_options_f = f enddef ; + def mfun_do_outline_options_r = r enddef ; +enddef ; + +vardef mfun_do_outline_text_set_n text r = + def mfun_do_outline_options_r = r enddef ; +enddef ; + +vardef mfun_do_outline_text_set_p = +enddef ; + +def mfun_do_outline_options_d = enddef ; +def mfun_do_outline_options_f = enddef ; +def mfun_do_outline_options_r = enddef ; + +vardef outlinetext@# (expr t) text rest = + save kind ; string kind ; kind := str @# ; + currentoutlinetext := currentoutlinetext + 1 ; + image ( normaldraw image ( + if mfun_trial_run : + % lua.mp.report("set outline text",currentoutlinetext); + normaldraw unitsquare + withprescript "ot_stage=trial" + withprescript "ot_index=" & decimal currentoutlinetext + withprescript "ot_kind=" & kind + withpostscript t ; + else : + % lua.mp.report("get outline text",currentoutlinetext); + if kind = "f" : + mfun_do_outline_text_set_f rest ; + elseif kind = "d" : + mfun_do_outline_text_set_d rest ; + elseif kind = "b" : + mfun_do_outline_text_set_b rest ; + elseif kind = "r" : + mfun_do_outline_text_set_r rest ; + elseif kind = "p" : + mfun_do_outline_text_set_p ; + else : + mfun_do_outline_text_set_n rest ; + fi ; + lua.mp.get_outline_text(currentoutlinetext) ; + fi ; + ) mfun_do_outline_options_r ; ) +enddef ; + +% A few helpers: + +numeric mfun_c_b_llx, mfun_c_b_h, mfun_c_b_w, mfun_c_b_l ; + +vardef checkedbounds(expr llx,lly,urx,ury) = + mfun_c_b_llx := min(xpart llcorner currentpicture,llx) ; + mfun_c_b_urx := max(xpart urcorner currentpicture,urx) ; + mfun_c_b_lly := min(ypart llcorner currentpicture,lly) ; + mfun_c_b_ury := max(ypart urcorner currentpicture,ury) ; + (mfun_c_b_llx,mfun_c_b_lly) -- + (mfun_c_b_urx,mfun_c_b_lly) -- + (mfun_c_b_urx,mfun_c_b_ury) -- + (mfun_c_b_llx,mfun_c_b_ury) -- cycle +enddef ; + +vardef checkbounds(expr llx,lly,urx,ury) = + setbounds currentpicture to checkedbounds(llx,lly,urx,ury) ; +enddef ; + +vardef strut(expr ht,dp) = + setbounds currentpicture to checkedbounds(0,0,ht,dp) ; +enddef ; + +vardef rule(expr wd,ht,dp) = + image (fill (0,-dp)--(wd,-dp)--(wd,ht)--(0,ht)--cycle) +enddef ; + + +% Housekeeping + +extra_beginfig := extra_beginfig & "currentgraphictext := 0 ; " ; +extra_beginfig := extra_beginfig & "currentoutlinetext := 0 ; " ; +extra_endfig := extra_endfig & "finishsavingdata ; " ; +extra_endfig := extra_endfig & "mfun_reset_tex_texts ; " ; + +% Bonus + +vardef verbatim(expr s) = + ditto & "\detokenize{" & s & "}" & ditto +enddef ; + +% New + +def bitmapimage(expr xresolution, yresolution, data) = + image ( + addto currentpicture doublepath unitsquare + withprescript "bm_xresolution=" & decimal xresolution + withprescript "bm_yresolution=" & decimal yresolution + withpostscript data ; + ) +enddef ; + +% Experimental: +% +% property p ; p = properties(withcolor (1,1,0,0)) ; +% fill fullcircle scaled 20cm withproperties p ; + +let property = picture ; + +vardef properties(text t) = + image(draw unitcircle t) +enddef ; + +if metapostversion < 1.770 : + + 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 prescriptpart p + withpostscript postscriptpart p + enddef ; + +fi ; + +% Experimental: + +primarydef t asgroup s = % s = isolated|knockout + begingroup + save grouppicture, wrappedpicture, groupbounds ; + picture grouppicture, wrappedpicture ; path groupbounds ; + grouppicture := if picture t : t else : image(draw t) fi ; + groupbounds := boundingbox grouppicture ; + wrappedpicture:= nullpicture ; + addto wrappedpicture contour groupbounds + withprescript "gr_state=start" + withprescript "gr_type=" & s + withprescript "gr_llx=" & decimal xpart llcorner groupbounds + withprescript "gr_lly=" & decimal ypart llcorner groupbounds + withprescript "gr_urx=" & decimal xpart urcorner groupbounds + withprescript "gr_ury=" & decimal ypart urcorner groupbounds ; + addto wrappedpicture also grouppicture ; + addto wrappedpicture contour groupbounds + withprescript "gr_state=stop" ; + wrappedpicture + endgroup +enddef ; + +% Also experimental ... needs to be made better ... so it can change! + +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") ; + +% new +% +% passvariable("version","1.0") ; +% passvariable("number",123) ; +% passvariable("string","whatever") ; +% passvariable("point",(1,2)) ; +% passvariable("triplet",(1,2,3)) ; +% passvariable("quad",(1,2,3,4)) ; +% passvariable("boolean",false) ; +% passvariable("path",fullcircle scaled 1cm) ; + +% we could use the new lua interface but there is not that much gain i.e. +% we still need to serialize + +vardef mfun_point_to_string(expr p,i) = + decimal xpart (point i of p) & " " & + decimal ypart (point i of p) & " " & + decimal xpart (precontrol i of p) & " " & + decimal ypart (precontrol i of p) & " " & + decimal xpart (postcontrol i of p) & " " & + decimal ypart (postcontrol i of p) +enddef ; + +vardef mfun_transform_to_string(expr t) = + decimal xxpart t & " " & % rx + decimal xypart t & " " & % sx + decimal yxpart t & " " & % sy + decimal yypart t & " " & % ry + decimal xpart t & " " & % tx + decimal ypart t % ty +enddef ; + +vardef mfun_numeric_to_string(expr n) = + decimal n +enddef ; + +vardef mfun_pair_to_string(expr p) = + decimal xpart p & " " & + decimal ypart p +enddef ; + +vardef mfun_rgbcolor_to_string(expr c) = + decimal redpart c & " " & + decimal greenpart c & " " & + decimal bluepart c +enddef ; + +vardef mfun_cmykcolor_to_string(expr c) = + decimal cyanpart c & " " & + decimal magentapart c & " " & + decimal yellowpart c & " " & + decimal blackpart c +enddef ; + +vardef mfun_greycolor_to_string(expr n) = + decimal n +enddef ; + +vardef mfun_path_to_string(expr p) = + mfun_point_to_string(p,0) for i=1 upto length(p) : & " " & mfun_point_to_string(p,i) endfor +enddef ; + +vardef mfun_boolean_to_string(expr b) = + if b : "true" else : "false" fi +enddef ; + +% def passvariable(expr key, value) = +% special +% if numeric value : "1:" & key & "=" & mfun_numeric_to_string(value) +% elseif pair value : "4:" & key & "=" & mfun_pair_to_string(value) +% elseif rgbcolor value : "5:" & key & "=" & mfun_rgbcolor_to_string(value) +% elseif cmykcolor value : "6:" & key & "=" & mfun_cmykcolor_to_string(value) +% elseif boolean value : "3:" & key & "=" & mfun_boolean_to_string(value) +% elseif path value : "7:" & key & "=" & mfun_path_to_string(value) +% elseif transform value : "8:" & key & "=" & mfun_transform_to_string(value) +% else : "2:" & key & "=" & value +% fi ; +% enddef ; + +vardef tostring(expr value) = + if numeric value : mfun_numeric_to_string(value) + elseif pair value : mfun_pair_to_string(value) + elseif rgbcolor value : mfun_rgbcolor_to_string(value) + elseif cmykcolor value : mfun_cmykcolor_to_string(value) + elseif greycolor value : mfun_greycolor_to_string(value) + elseif boolean value : mfun_boolean_to_string(value) + elseif path value : mfun_path_to_string(value) + elseif transform value : mfun_transform_to_string(value) + else : value + fi +enddef ; + +vardef mfun_tagged_string(expr value) = + if numeric value : "1:" & mfun_numeric_to_string(value) + elseif pair value : "4:" & mfun_pair_to_string(value) + elseif rgbcolor value : "5:" & mfun_rgbcolor_to_string(value) + elseif cmykcolor value : "6:" & mfun_cmykcolor_to_string(value) + elseif boolean value : "3:" & mfun_boolean_to_string(value) + elseif path value : "7:" & mfun_path_to_string(value) + elseif transform value : "8:" & mfun_transform_to_string(value) + else : "2:" & value + fi +enddef ; + +% amore flexible variant for passing data to context + +vardef mfun_point_to_lua(expr p,i) = + "{" & + decimal xpart (point i of p) & "," & + decimal ypart (point i of p) & "," & + decimal xpart (precontrol i of p) & "," & + decimal ypart (precontrol i of p) & "," & + decimal xpart (postcontrol i of p) & "," & + decimal ypart (postcontrol i of p) + & "}" +enddef ; + +vardef mfun_transform_to_lua(expr t) = + "{" & + decimal xxpart t & "," & % rx + decimal xypart t & "," & % sx + decimal yxpart t & "," & % sy + decimal yypart t & "," & % ry + decimal xpart t & "," & % tx + decimal ypart t % ty + & "}" +enddef ; + +vardef mfun_numeric_to_lua(expr n) = + decimal n +enddef ; + +vardef mfun_pair_to_lua(expr p) = + "{" & + decimal xpart p & "," & + decimal ypart p + & "}" +enddef ; + +vardef mfun_rgbcolor_to_lua(expr c) = + "{" & + decimal redpart c & "," & + decimal greenpart c & "," & + decimal bluepart c + & "}" +enddef ; + +vardef mfun_cmykcolor_to_lua(expr c) = + "{" & + decimal cyanpart c & "," & + decimal magentapart c & "," & + decimal yellowpart c & "," & + decimal blackpart c + & "}" +enddef ; + +vardef mfun_path_to_lua(expr p) = + "{" & + mfun_point_to_lua(p,0) for i=1 upto length(p) : & "," & mfun_point_to_lua(p,i) endfor + & "}" +enddef ; + +vardef mfun_boolean_to_lua(expr b) = + if b : "true" else : "false" fi +enddef ; + +vardef mfun_string_to_lua(expr s) = + "[==[" & s & "]==]" +enddef ; + +def mfun_to_lua(expr key)(expr value)(text t) = + special "metapost.variables['" & key & "']=" & t(value) ; +enddef ; + +def mfun_array_to_lua(expr key)(suffix value)(expr first, last, stp)(text t) = + special + "metapost.variables['" & key & "']={" + for i=first step stp until last : + & "[" & decimal i & "]=" & t(value[i]) & "," + endfor + & "}" ; +enddef ; + +def passvariable(expr key, value) = + if numeric value : mfun_to_lua(key,value,mfun_numeric_to_lua) + elseif pair value : mfun_to_lua(key,value,mfun_pair_to_lua) + elseif string value : mfun_to_lua(key,value,mfun_string_to_lua) + elseif boolean value : mfun_to_lua(key,value,mfun_boolean_to_lua) + elseif path value : mfun_to_lua(key,value,mfun_path_to_lua) + elseif rgbcolor value : mfun_to_lua(key,value,mfun_rgbcolor_to_lua) + elseif cmykcolor value : mfun_to_lua(key,value,mfun_cmykcolor_to_lua) + elseif transform value : mfun_to_lua(key,value,mfun_transform_to_lua) + fi ; +enddef ; + +def passarrayvariable(expr key)(suffix values)(expr first, last, stp) = + if numeric values[first] : mfun_array_to_lua(key,values,first,last,stp,mfun_numeric_to_lua) + elseif pair values[first] : mfun_array_to_lua(key,values,first,last,stp,mfun_pair_to_lua) + elseif string values[first] : mfun_array_to_lua(key,values,first,last,stp,mfun_string_to_lua) + elseif boolean values[first] : mfun_array_to_lua(key,values,first,last,stp,mfun_boolean_to_lua) + elseif path values[first] : mfun_array_to_lua(key,values,first,last,stp,mfun_path_to_lua) + elseif rgbcolor values[first] : mfun_array_to_lua(key,values,first,last,stp,mfun_rgbcolor_to_lua) + elseif cmykcolor values[first] : mfun_array_to_lua(key,values,first,last,stp,mfun_cmykcolor_to_lua) + elseif transform values[first] : mfun_array_to_lua(key,values,first,last,stp,mfun_transform_to_lua) + fi ; +enddef ; + +def startpassingvariable(expr k) = + begingroup ; + save stoppassingvariable, startarray, stoparray, starthash, stophash, index, key, value, slot, entry ; + let stoppassingvariable = mfun_stop_lua_variable ; + let startarray = mfun_start_lua_array ; + let stoparray = mfun_stop_lua_array ; + let starthash = mfun_start_lua_hash ; + let stophash = mfun_stop_lua_hash ; + let index = mfun_lua_index ; + let key = mfun_lua_key ; + let value = mfun_lua_value ; + let slot = mfun_lua_slot ; + let entry = mfun_lua_entry ; + save s ; string s ; + s := "metapost.variables['" & k & "']=" +enddef ; + +def mfun_stop_lua_variable = + ; + special substring(0,length(s)-1) of s ; + endgroup ; +enddef ; + +% currently there is no difference between array and hash + +def mfun_start_lua_array = + & "{" +enddef ; + +def mfun_stop_lua_array = + & "}," +enddef ; + +def mfun_start_lua_hash = + & "{" +enddef ; + +def mfun_stop_lua_hash = + & "}," +enddef ; + +def mfun_lua_key(expr k) = + & "['" & k & "']=" +enddef ; + +def mfun_lua_index(expr k) = + & "[" & decimal k & "]=" +enddef ; + +def mfun_lua_value(expr v) = + if numeric v : & mfun_numeric_to_lua(v) & "," + elseif pair v : & mfun_pair_to_lua(v) & "," + elseif string v : & mfun_string_to_lua(v) & "," + elseif boolean v : & mfun_boolean_to_lua(v) & "," + elseif path v : & mfun_path_to_lua(v) & "," + elseif rgbcolor v : & mfun_rgbcolor_to_lua(v) & "," + elseif cmykcolor v : & mfun_cmykcolor_to_lua(v) & "," + elseif transform v : & mfun_transform_to_lua(v) & "," + fi +enddef ; + +def mfun_lua_entry(expr k, v) = + mfun_lua_key(k) + mfun_lua_value(v) +enddef ; + +def mfun_lua_slot(expr k, v) = + mfun_lua_index(k) + mfun_lua_value(v) +enddef ; + +% moved here from mp-grap.mpiv + +% vardef escaped_format(expr s) = +% "" for n=0 upto length(s) : & +% if ASCII substring (n,n+1) of s = 37 : +% "@" +% else : +% substring (n,n+1) of s +% fi +% endfor +% enddef ; + +numeric mfun_esc_b ; % begin +numeric mfun_esc_l ; % length +string mfun_esc_s ; % character + +mfun_esc_s := "%" ; % or: char(37) + +% this one is the fastest when we have a match + +% vardef escaped_format(expr s) = +% "" for n=0 upto length(s)-1 : & +% % if ASCII substring (n,n+1) of s = 37 : +% if substring (n,n+1) of s = mfun_esc_s : +% "@" +% else : +% substring (n,n+1) of s +% fi +% endfor +% enddef ; + +% this one wins when we have no match + +vardef escaped_format(expr s) = + mfun_esc_b := 0 ; + mfun_esc_l := length(s) ; + for n=0 upto mfun_esc_l-1 : + % if ASCII substring (n,n+1) of s = 37 : + if substring (n,n+1) of s = mfun_esc_s : + if mfun_esc_b = 0 : + "" + fi + if n >= mfun_esc_b : + & (substring (mfun_esc_b,n) of s) + exitif numeric begingroup mfun_esc_b := n+1 endgroup ; % hide + fi + & "@" + fi + endfor + if mfun_esc_b = 0 : + s + % elseif mfun_esc_b > 0 : + elseif mfun_esc_b < mfun_esc_l : + & (substring (mfun_esc_b,mfun_esc_l) of s) + fi +enddef ; + +vardef strfmt(expr f, x) = "\MPgraphformat{" & escaped_format(f) & "}{" & mfun_tagged_string(x) & "}" enddef ; +vardef varfmt(expr f, x) = "\MPformatted{" & escaped_format(f) & "}{" & mfun_tagged_string(x) & "}" enddef ; + +vardef format (expr f, x) = textext(strfmt(f, x)) enddef ; +vardef formatted(expr f, x) = textext(varfmt(f, x)) enddef ; + +% could be this (something to discuss with alan as it involves graph): +% +% vardef format (expr f,x) = lua.mp.graphformat(f,mfun_tagged_string(x) enddef ; +% vardef formatted(expr f,x) = lua.mp.format (f, x) enddef ; +% +% def strfmt = format enddef ; % old +% def varfmt = formatted enddef ; % old + +% new + +def eofill text t = fill t withpostscript "evenodd" enddef ; +def nofill text t = fill t withpostscript "collect" enddef ; +%%% eoclip text t = clip t withpostscript "evenodd" enddef ; % no postscripts yet + +% def withrule expr r = +% if (t = "even-odd") or (t = "evenodd") : withpostscript "evenodd" fi +% enddef ; |