mp-mlib.mpiv /size: 56 Kb    last modification: 2021-10-28 13:50
1%D \module
2%D   [       file=mp-mlib.mpiv,
3%D        version=2008.03.21,
4%D          title=\CONTEXT\ \METAPOST\ graphics,
5%D       subtitle=plugins,
6%D         author=Hans Hagen,
7%D           date=\currentdate,
8%D      copyright={PRAGMA ADE \& \CONTEXT\ Development Team}]
9%C
10%C This module is part of the \CONTEXT\ macro||package and is
11%C therefore copyrighted by \PRAGMA. See licen-en.pdf for
12%C details.
13
14if unknown mplib        : endinput ; fi ;
15if known   context_mlib : endinput ; fi ;
16
17boolean context_mlib ; context_mlib := true ;
18
19% numeric LUATEXFUNCTIONALITY ; LUATEXFUNCTIONALITY := runscript("mp.print(LUATEXFUNCTIONALITY or (status and status.development_id) or 6346)") ;
20
21%D Objects:
22
23vardef isobject expr p =
24    if picture p :
25      % lua.mp.isobject(prescriptpart p)
26        runscript("mp.isobject(" & prescriptpart p & ")")
27    else :
28        false
29    fi
30enddef ;
31
32%D Color and transparency
33%D
34%D Separable:
35
36newinternal normaltransparent     ; normaltransparent     :=  1 ;
37newinternal multiplytransparent   ; multiplytransparent   :=  2 ;
38newinternal screentransparent     ; screentransparent     :=  3 ;
39newinternal overlaytransparent    ; overlaytransparent    :=  4 ;
40newinternal softlighttransparent  ; softlighttransparent  :=  5 ;
41newinternal hardlighttransparent  ; hardlighttransparent  :=  6 ;
42newinternal colordodgetransparent ; colordodgetransparent :=  7 ;
43newinternal colorburntransparent  ; colorburntransparent  :=  8 ;
44newinternal darkentransparent     ; darkentransparent     :=  9 ;
45newinternal lightentransparent    ; lightentransparent    := 10 ;
46newinternal differencetransparent ; differencetransparent := 11 ;
47newinternal exclusiontransparent  ; exclusiontransparent  := 12 ;
48
49%D Nonseparable:
50
51newinternal huetransparent        ; huetransparent        := 13 ;
52newinternal saturationtransparent ; saturationtransparent := 14 ;
53newinternal colortransparent      ; colortransparent      := 15 ;
54newinternal luminositytransparent ; luminositytransparent := 16 ;
55
56vardef transparency_alternative_to_number(expr name) =
57    if string name :
58        if expandafter known scantokens(name & "transparent") :
59            scantokens(name & "transparent")
60        else :
61            0
62        fi
63    elseif name < 17 :
64        name
65    else :
66        0
67    fi
68enddef ;
69
70def namedcolor expr n =
71    (1)
72    withprescript "sp_type=named"
73    withprescript "sp_name=" & n
74enddef ;
75
76% def mfun_spotcolor(expr n, v) =
77%     1
78%     withprescript "sp_type=xspot"
79%     withprescript "sp_name="  & n
80%     withprescript "sp_value=" & (if numeric v : decimal v else : v fi)
81% enddef ;
82
83% def mfun_multispotcolor(expr name, fractions, components, value) =
84%     1
85%     withprescript "sp_type=multispot"
86%     withprescript "sp_name="       & name
87%     withprescript "sp_fractions="  & decimal fractions
88%     withprescript "sp_components=" & components
89%     withprescript "sp_value="      & value
90% enddef ;
91
92def spotcolor(expr name, v) =
93    (1)
94    withprescript "sp_type=spot"
95    withprescript "sp_name=" & name
96    withprescript "sp_value=" & colordecimals v
97enddef ;
98
99% In this case a mixed color will be calculated:
100
101def multitonecolor(expr name)(text t) =
102    (1)
103    withprescript "sp_type=multitone"
104    withprescript "sp_name=" & name
105    withprescript "sp_value=" & colordecimalslist(t)
106enddef ;
107
108def transparent(expr a, t)(text c) = % use withtransparency instead
109    (1) % this permits withcolor x intoshade y
110    withprescript "tr_alternative=" & decimal transparency_alternative_to_number(a)
111    withprescript "tr_transparency=" & decimal t
112    withcolor c
113enddef ;
114
115def withtransparency(expr a, t) =
116    withprescript "tr_alternative="  & decimal transparency_alternative_to_number(a)
117    withprescript "tr_transparency=" & decimal t
118enddef ;
119
120% no, not compatible ... maybe only mpiv .. maybe withopacity
121
122% let opacity = pair ;
123
124% def withtransparency expr t =
125%     withprescript "tr_alternative="  & decimal transparency_alternative_to_number(xpart t)
126%     withprescript "tr_transparency=" & decimal ypart t
127% enddef ;
128%
129% withtransparency (1,.5)
130% withtransparency ("normal",.5)
131%
132% withopacity      (1,.5)
133% withopacity      (normaltransparency,.5)
134% withopacity      .5
135
136def withopacity expr t =
137    if pair t :
138        withprescript "tr_alternative="  & decimal transparency_alternative_to_number(xpart t)
139        withprescript "tr_transparency=" & decimal ypart t
140    else :
141        mfun_with_opacity (transparency_alternative_to_number(t))
142    fi
143enddef ;
144
145def mfun_with_opacity (expr a) expr t =
146    withprescript "tr_alternative="  & decimal a
147    withprescript "tr_transparency=" & decimal t
148enddef ;
149
150% Provided for downward compability:
151
152def cmyk(expr c, m, y, k) =
153    (c,m,y,k)
154enddef ;
155
156% Texts (todo: better strut ratio, now .7 hardcoded, should be passed)
157
158newinternal textextoffset ; textextoffset := 0 ;
159
160%%%%%%% mfun_tt_w[], mfun_tt_h[], mfun_tt_d[] ; % we can consider using colors (less hash space)
161color   mfun_tt_b ;
162numeric mfun_tt_n ; mfun_tt_n := 0 ;
163picture mfun_tt_p ; mfun_tt_p := nullpicture ;
164picture mfun_tt_o ; mfun_tt_o := nullpicture ;
165picture mfun_tt_c ; mfun_tt_c := nullpicture ;
166
167if unknown mfun_trial_run :
168    boolean mfun_trial_run ;
169    mfun_trial_run := false ;
170else :
171    % already defined before the format is loaded
172fi ;
173
174def mfun_reset_tex_texts =
175    mfun_tt_n := 0 ;
176    mfun_tt_p := nullpicture ;
177    mfun_tt_o := nullpicture ; % redundant
178    mfun_tt_c := nullpicture ; % redundant
179enddef ;
180
181def mfun_flush_tex_texts =
182    addto currentpicture also mfun_tt_p
183enddef ;
184
185extra_endfig   := "mfun_flush_tex_texts ;" & extra_endfig ;
186extra_beginfig := extra_beginfig & "mfun_reset_tex_texts ;" ;
187
188% We collect and flush them all, as we can also have temporary textexts
189% that gets never really flushed but are used for calculations. So, we
190% flush twice: once in location in order to pick up e.g. color properties,
191% and once at the end because we need to flush missing ones.
192
193boolean mfun_onetime_textext ; mfun_onetime_textext := false ;
194numeric mfun_global_textext ; mfun_global_textext := 0 ;
195
196def keepcached =
197    hide(mfun_global_textext := mfun_global_textext + 1;)
198    withprescript ("tx_cache=" & decimal mfun_global_textext)
199enddef ;
200
201def notcached =
202    withprescript "tx_cache=no"
203enddef ;
204
205% todo: onetime
206
207rgbcolor mfun_tt_r ;
208
209newinternal inicatcoderegime ; inicatcoderegime := runscript("return catcodes.numbers.ctxcatcodes") ;
210newinternal texcatcoderegime ; texcatcoderegime := runscript("return catcodes.numbers.texcatcodes") ;
211newinternal luacatcoderegime ; luacatcoderegime := runscript("return catcodes.numbers.luacatcodes") ;
212newinternal notcatcoderegime ; notcatcoderegime := runscript("return catcodes.numbers.notcatcodes") ;
213newinternal vrbcatcoderegime ; vrbcatcoderegime := runscript("return catcodes.numbers.vrbcatcodes") ;
214newinternal prtcatcoderegime ; prtcatcoderegime := runscript("return catcodes.numbers.prtcatcodes") ;
215newinternal ctxcatcoderegime ; ctxcatcoderegime := runscript("return catcodes.numbers.ctxcatcodes") ;
216newinternal txtcatcoderegime ; txtcatcoderegime := runscript("return catcodes.numbers.txtcatcodes") ;
217
218newinternal catcoderegime    ; catcoderegime    := ctxcatcoderegime ;
219
220vardef rawtextext(expr s) =
221    if s = "" :
222        nullpicture
223    else :
224        mfun_tt_n := mfun_tt_n + 1 ;
225        mfun_tt_c := nullpicture ;
226        mfun_tt_o := nullpicture ;
227        addto mfun_tt_o doublepath origin _op_ ; % save drawoptions
228        mfun_tt_r := lua.mp.mf_some_text(mfun_tt_n,s,catcoderegime) ;
229        addto mfun_tt_c doublepath unitsquare
230            xscaled wdpart mfun_tt_r
231            yscaled (htpart mfun_tt_r + dppart mfun_tt_r)
232            shifted (0,-dppart mfun_tt_r)
233            withprescript "mf_object=text"
234            withprescript "tx_index=" & decimal mfun_tt_n
235            withprescript "tx_color=" & colordecimals colorpart mfun_tt_o
236        ;
237        mfun_tt_c
238    fi
239enddef ;
240
241vardef rawmadetext =
242    mfun_tt_n := mfun_tt_n + 1 ;
243    mfun_tt_c := nullpicture ;
244    mfun_tt_o := nullpicture ;
245    addto mfun_tt_o doublepath origin _op_ ; % save drawoptions
246    mfun_tt_r := lua.mp.mf_made_text(mfun_tt_n) ;
247    addto mfun_tt_c doublepath unitsquare
248        xscaled wdpart mfun_tt_r
249        yscaled (htpart mfun_tt_r + dppart mfun_tt_r)
250        shifted (0,-dppart mfun_tt_r)
251        withprescript "mf_object=text"
252        withprescript "tx_index=" & decimal mfun_tt_n
253        withprescript "tx_color=" & colordecimals colorpart mfun_tt_o
254    ;
255    mfun_tt_c
256enddef ;
257
258vardef validtexbox(expr category, name) =
259    if category == "" :
260        false
261    elseif string name :
262        name <> ""
263    elseif numeric name :
264        name > 0
265    else :
266        true
267    fi
268enddef ;
269
270vardef rawtexbox(expr category, name) =
271    mfun_tt_c := nullpicture ;
272    if validtexbox(category,name) :
273        mfun_tt_b := lua.mp.mf_tb_dimensions(category, name) ;
274        addto mfun_tt_c doublepath unitsquare
275            xscaled wdpart mfun_tt_b
276            yscaled (htpart mfun_tt_b + dppart mfun_tt_b)
277            shifted (0,- dppart mfun_tt_b)
278            withprescript "mf_object=box"
279            withprescript "bx_category=" & if numeric category : decimal fi category
280            withprescript "bx_name=" & if numeric name : decimal fi name ;
281    fi
282    mfun_tt_c
283enddef ;
284
285% More text
286
287defaultfont  := "Mono" ;
288defaultscale := 1 ;
289
290extra_beginfig := extra_beginfig & "defaultscale:=1;" ;
291
292vardef fontsize expr name =
293    save size ; numeric size ;
294    size := bbwidth(textext("\MPfontsizehskip{" & name & "}")) ;
295    if size = 0 :
296        12pt
297    else :
298        size
299    fi
300enddef ;
301
302pair mfun_laboff        ; mfun_laboff        := origin   ;
303pair mfun_laboff.lft    ; mfun_laboff.lft    := (-1,0)   ;
304pair mfun_laboff.rt     ; mfun_laboff.rt     := (1,0)    ;
305pair mfun_laboff.bot    ; mfun_laboff.bot    := (0,-1)   ;
306pair mfun_laboff.top    ; mfun_laboff.top    := (0,1)    ;
307pair mfun_laboff.ulft   ; mfun_laboff.ulft   := (-.7,.7) ;
308pair mfun_laboff.urt    ; mfun_laboff.urt    := (.7,.7)  ;
309pair mfun_laboff.llft   ; mfun_laboff.llft   := -(.7,.7) ;
310pair mfun_laboff.lrt    ; mfun_laboff.lrt    := (.7,-.7) ;
311
312pair mfun_laboff.d      ; mfun_laboff.d      := mfun_laboff     ;
313pair mfun_laboff.dlft   ; mfun_laboff.dlft   := mfun_laboff.lft ;
314pair mfun_laboff.drt    ; mfun_laboff.drt    := mfun_laboff.rt  ;
315pair mfun_laboff.origin ; mfun_laboff.origin := mfun_laboff     ;
316pair mfun_laboff.raw    ; mfun_laboff.raw    := mfun_laboff     ;
317
318pair mfun_laboff.l      ; mfun_laboff.l      := mfun_laboff.lft  ;
319pair mfun_laboff.r      ; mfun_laboff.r      := mfun_laboff.rt   ;
320pair mfun_laboff.b      ; mfun_laboff.b      := mfun_laboff.bot  ;
321pair mfun_laboff.t      ; mfun_laboff.t      := mfun_laboff.top  ;
322pair mfun_laboff.l_t    ; mfun_laboff.l_t    := mfun_laboff.ulft ;
323pair mfun_laboff.r_t    ; mfun_laboff.r_t    := mfun_laboff.urt  ;
324pair mfun_laboff.l_b    ; mfun_laboff.l_b    := mfun_laboff.llft ;
325pair mfun_laboff.r_b    ; mfun_laboff.r_b    := mfun_laboff.lrt  ;
326pair mfun_laboff.t_l    ; mfun_laboff.t_l    := mfun_laboff.ulft ;
327pair mfun_laboff.t_r    ; mfun_laboff.t_r    := mfun_laboff.urt  ;
328pair mfun_laboff.b_l    ; mfun_laboff.b_l    := mfun_laboff.llft ;
329pair mfun_laboff.b_r    ; mfun_laboff.b_r    := mfun_laboff.lrt  ;
330
331mfun_labxf                                              := 0.5 ;
332mfun_labxf.lft      := mfun_labxf.l                     := 1   ;
333mfun_labxf.rt       := mfun_labxf.r                     := 0   ;
334mfun_labxf.bot      := mfun_labxf.b                     := 0.5 ;
335mfun_labxf.top      := mfun_labxf.t                     := 0.5 ;
336mfun_labxf.ulft     := mfun_labxf.l_t := mfun_labxf.t_l := 1   ;
337mfun_labxf.urt      := mfun_labxf.r_t := mfun_labxf.t_r := 0   ;
338mfun_labxf.llft     := mfun_labxf.l_b := mfun_labxf.b_l := 1   ;
339mfun_labxf.lrt      := mfun_labxf.r_b := mfun_labxf.b_r := 0   ;
340
341mfun_labxf.d        := mfun_labxf     ;
342mfun_labxf.dlft     := mfun_labxf.lft ;
343mfun_labxf.drt      := mfun_labxf.rt  ;
344mfun_labxf.origin   := 0              ;
345mfun_labxf.raw      := 0              ;
346
347mfun_labyf                                              := 0.5 ;
348mfun_labyf.lft      := mfun_labyf.l                     := 0.5 ;
349mfun_labyf.rt       := mfun_labyf.r                     := 0.5 ;
350mfun_labyf.bot      := mfun_labyf.b                     := 1   ;
351mfun_labyf.top      := mfun_labyf.t                     := 0   ;
352mfun_labyf.ulft     := mfun_labyf.l_t := mfun_labyf.t_l := 0   ;
353mfun_labyf.urt      := mfun_labyf.r_t := mfun_labyf.t_r := 0   ;
354mfun_labyf.llft     := mfun_labyf.l_b := mfun_labyf.b_l := 1   ;
355mfun_labyf.lrt      := mfun_labyf.r_b := mfun_labyf.b_r := 1   ;
356
357mfun_labyf.d        := mfun_labyf     ;
358mfun_labyf.dlft     := mfun_labyf.lft ;
359mfun_labyf.drt      := mfun_labyf.rt  ;
360mfun_labyf.origin   := 0              ;
361mfun_labyf.raw      := 0              ;
362
363mfun_labtype                                                 :=  0 ;
364mfun_labtype.lft    := mfun_labtype.l                        :=  1 ;
365mfun_labtype.rt     := mfun_labtype.r                        :=  2 ;
366mfun_labtype.bot    := mfun_labtype.b                        :=  3 ;
367mfun_labtype.top    := mfun_labtype.t                        :=  4 ;
368mfun_labtype.ulft   := mfun_labtype.l_t :=  mfun_labtype.t_l :=  5 ;
369mfun_labtype.urt    := mfun_labtype.r_t :=  mfun_labtype.t_r :=  6 ;
370mfun_labtype.llft   := mfun_labtype.l_b :=  mfun_labtype.b_l :=  7 ;
371mfun_labtype.lrt    := mfun_labtype.r_b :=  mfun_labtype.b_r :=  8 ;
372mfun_labtype.d                                               := 10 ;
373mfun_labtype.dlft                                            := 11 ;
374mfun_labtype.drt                                             := 12 ;
375mfun_labtype.origin                                          :=  0 ;
376mfun_labtype.raw                                             :=  0 ;
377
378vardef installlabel@# (expr type, x, y, offset) =
379    numeric mfun_labtype@# ; mfun_labtype@# := type ;
380    pair    mfun_laboff @# ; mfun_laboff @# := offset ;
381    numeric mfun_labxf  @# ; mfun_labxf  @# := x ;
382    numeric mfun_labyf  @# ; mfun_labyf  @# := y ;
383enddef ;
384
385installlabel.center (0, 0.5, 0.5, (0,0)) ;
386installlabel.c      (0, 0.5, 0.5, (0,0)) ;
387
388installlabel.hcenter(0, 0.5, 0.5, (1,0)) ;
389installlabel.h      (0, 0.5, 0.5, (1,0)) ;
390
391installlabel.vcenter(0, 0.5, 0.5, (0,1)) ;
392installlabel.v      (0, 0.5, 0.5, (0,1)) ;
393
394vardef mfun_labshift@#(expr p) =
395    (mfun_labxf@#*lrcorner p +
396     mfun_labyf@#*ulcorner p +
397     (1-mfun_labxf@#-mfun_labyf@#)*llcorner p)
398enddef ;
399
400vardef mfun_picshift@#(expr p) =
401    (mfun_labxf@#*ulcorner p +
402     mfun_labyf@#*lrcorner p +
403     (1-mfun_labxf@#-mfun_labyf@#)*urcorner p)
404enddef ;
405
406% we save the plain variant
407
408vardef plain_thelabel@#(expr p,z) =
409    if string p :
410        plain_thelabel@#(rawtextext("\definedfont[" & defaultfont & "]" & p) scaled defaultscale,z)
411    else :
412        p shifted (z + labeloffset*laboff@# - mfun_labshift@#(p))
413    fi
414enddef;
415
416def plain_label = % takes two arguments, contrary to textext that takes one
417    normaldraw plain_thelabel
418enddef ;
419
420let mfun_label    = label ;
421let mfun_thelabel = thelabel ;
422
423def useplainlabels = % somehow let doesn't work for all code
424    def label    = plain_label    enddef ;
425    def thelabel = plain_thelabel enddef ;
426enddef ;
427
428def usemetafunlabels =
429    let label    = mfun_label ;
430    let thelabel = mfun_thelabel ;
431enddef ;
432
433vardef dotlabel@#(expr s,z) text t_ =
434    label@#(s,z) t_ ;
435    interim linecap := rounded ;
436    normaldraw z withpen pencircle scaled dotlabeldiam t_ ;
437enddef ;
438
439plain_compatibility_data := plain_compatibility_data & "save label, thelabel ;" & "useplainlabels ;" ;
440
441% vardef thetextext@#(expr p,z) =
442%   % interim labeloffset := textextoffset ;
443%     if string p :
444%         thetextext@#(rawtextext(p),z)
445%     elseif numeric p :
446%         thetextext@#(rawtextext(decimal p),z)
447%     else :
448%         p
449%             if (mfun_labtype@# >= 10) :
450%                 shifted (0,ypart center p)
451%             fi
452%             shifted (z + textextoffset*mfun_laboff@# - mfun_labshift@#(p))
453%     fi
454% enddef ;
455
456newinternal anchortextexts ; anchortextexts := 0 ; % disabled by default
457
458vardef thetextext@#(expr p,z) =
459  % interim labeloffset := textextoffset ;
460    if string p :
461        thetextext@#(rawtextext(p),z)
462    elseif numeric p :
463        thetextext@#(rawtextext(decimal p),z)
464    elseif pair p :
465        thetextext@#(rawtextext(ddecimal p),z)
466    else :
467        if anchortextexts > 0 :
468            image(draw p withprescript "tx_anchor=" & ddecimal z)
469        else :
470            p
471        fi
472        if (mfun_labtype@# >= 10) :
473            shifted (0,ypart center p)
474        fi
475        shifted (z + textextoffset*mfun_laboff@# - mfun_labshift@#(p))
476    fi
477enddef ;
478
479vardef textext@#(expr p) = % no draw here
480    thetextext@#(p,origin)
481enddef ;
482
483vardef onetimetextext@#(expr p) = % no draw here
484    mfun_onetime_textext := true ;
485    thetextext@#(p,origin)
486enddef ;
487
488% formatted text
489
490pair mfun_tt_z ;
491
492vardef rawfmttext(text t) =
493    mfun_tt_n := mfun_tt_n + 1 ;
494    mfun_tt_c := nullpicture ;
495    mfun_tt_o := nullpicture ;
496    addto mfun_tt_o doublepath origin _op_ ; % save drawoptions
497    mfun_tt_r := lua.mp.mf_formatted_text(mfun_tt_n,t) ;
498    addto mfun_tt_c doublepath unitsquare
499        xscaled wdpart mfun_tt_r
500        yscaled (htpart mfun_tt_r + dppart mfun_tt_r)
501        shifted (0,-dppart mfun_tt_r)
502        withprescript "mf_object=text"
503        withprescript "tx_index=" & decimal mfun_tt_n
504        withprescript "tx_color=" & colordecimals colorpart mfun_tt_o
505    ;
506    for s = t :
507        if pair s : mfun_tt_z := s ; fi
508    endfor ;
509    mfun_tt_c
510enddef ;
511
512vardef thefmttext@#(text t) =
513    mfun_tt_z := origin ; % initialization
514    save p ; picture p ; p := rawfmttext(t) ;
515    if anchortextexts > 0 :
516        image(draw p withprescript "tx_anchor=" & ddecimal mfun_tt_z)
517    else :
518        p
519    fi
520        if (mfun_labtype@# >= 10) :
521            shifted (0,ypart center p)
522        fi
523        shifted (mfun_tt_z + textextoffset*mfun_laboff@# - mfun_labshift@#(p))
524enddef ;
525
526vardef fmttext@#(text t) = % no draw here
527    thefmttext@#(t,origin)
528enddef ;
529
530% or just: def fmttext = thefmttext enddef ;
531
532vardef onetimefmttext@#(text t) = % no draw here
533    mfun_onetime_textext := true ;
534    thefmttext@#(t,origin)
535enddef ;
536
537% so much for formatted text
538
539vardef thetexbox@#(expr category, name, z) =
540    save p ; picture p ; p := rawtexbox(category,name) ;
541    p
542        if (mfun_labtype@# >= 10) :
543            shifted (0,ypart center p)
544        fi
545        shifted (z + textextoffset*mfun_laboff@# - mfun_labshift@#(p))
546enddef ;
547
548vardef texbox@#(expr category, name) = % no draw here
549    thetexbox@#(category,name,origin)
550enddef ;
551
552% vardef thelabel@#(expr p,z) =
553%     if string p :
554%         thelabel@#(rawtextext("\definedfont[" & defaultfont & "]" & p) scaled defaultscale,z)
555%     else :
556%         p shifted (z + labeloffset*mfun_laboff@# - (mfun_labxf@#*lrcorner p + mfun_labyf@#*ulcorner p + (1-mfun_labxf@#-mfun_labyf@#)*llcorner p))
557%     fi
558% enddef;
559
560vardef theoffset@#(expr z) =
561    if pair z :
562        z
563    elseif path z :
564        if mfun_laboff@# = origin :
565            center z
566        else :
567            ((center z)-- mfun_picshift@#(z)) intersectionpoint (z if not cycle z: --cycle fi)
568        fi
569    else : % picture
570        mfun_picshift@#(z)
571    fi
572enddef;
573
574vardef thelabel@#(expr p,z) =
575    if string p :
576        thelabel@#(rawtextext("\definedfont[" & defaultfont & "]" & p) scaled defaultscale,z)
577    elseif numeric p :
578        thelabel@#(decimal p,z)
579    elseif pair p :
580        thelabel@#("(" & decimal(xpart p) & "," & decimal(ypart p) & ")",z)
581    else :
582        p shifted (theoffset@#(z) + labeloffset*mfun_laboff@# - mfun_labshift@#(p))
583    fi
584enddef;
585
586def label = % takes two arguments, contrary to textext that takes one
587    normaldraw thelabel
588enddef ;
589
590vardef anchored@#(expr p, z) = % beware: no "+ mfun_laboff@#" here (never!)
591    p
592        if (mfun_labtype@# >= 10) :
593            shifted (0,ypart center p)
594        fi
595        shifted (z + mfun_labshift@#(p))
596enddef ;
597
598let normalinfont = infont ;
599
600primarydef s infont name = % nasty hack
601    if name = "" :
602        textext(s)
603    else :
604        textext("\definedfont[" & name & "]" & s)
605    fi
606enddef ;
607
608% Helper
609
610string mfun_prescript_separator ; mfun_prescript_separator := char(13) ;
611
612% Shades
613
614% for while we had this:
615
616newinternal shadefactor  ; shadefactor  := 1 ;      % currently obsolete
617pair        shadeoffset  ; shadeoffset  := origin ; % currently obsolete
618boolean     trace_shades ; trace_shades := false ;  % still there
619
620% def withlinearshading (expr a, b) =
621%     withprescript "sh_type=linear"
622%     withprescript "sh_domain=0 1"
623%     withprescript "sh_factor="   & decimal shadefactor
624%     withprescript "sh_center_a=" & ddecimal (a shifted shadeoffset)
625%     withprescript "sh_center_b=" & ddecimal (b shifted shadeoffset)
626% enddef ;
627%
628% def withcircularshading (expr a, b, ra, rb) =
629%     withprescript "sh_type=circular"
630%     withprescript "sh_domain=0 1"
631%     withprescript "sh_factor="   & decimal shadefactor
632%     withprescript "sh_center_a=" & ddecimal (a shifted shadeoffset)
633%     withprescript "sh_center_b=" & ddecimal (b shifted shadeoffset)
634%     withprescript "sh_radius_a=" & decimal ra
635%     withprescript "sh_radius_b=" & decimal rb
636% enddef ;
637%
638% def withshading (expr how)(text rest) =
639%     if how = "linear" :
640%         withlinearshading(rest)
641%     elseif how = "circular" :
642%         withcircularshading(rest)
643%     else :
644%         % nothing
645%     fi
646% enddef ;
647%
648% def withfromshadecolor expr t =
649%     withprescript "sh_color=into"
650%     withprescript "sh_color_a=" & colordecimals t
651% enddef ;
652
653% def withtoshadecolor expr t =
654%     withprescript "sh_color=into"
655%     withprescript "sh_color_b=" & colordecimals t
656% enddef ;
657
658% but this is nicer
659
660% fill fullcircle scaled 10cm
661%     withshademethod "circular"
662%     withshadevector (5cm,1cm)
663%     withshadecenter (.1,.5)
664%     withshadedomain (.2,.6)
665%     withshadefactor 1.2
666%     withshadecolors (red,green)
667% ;
668
669path    mfun_shade_path ;
670numeric mfun_shade_step ; mfun_shade_step := 0 ;
671
672def withshadestep =
673    hide(mfun_shade_step := mfun_shade_step + 1 ;)
674    mfun_withshadestep
675enddef ;
676
677def mfun_withshadestep (text t) =
678    withprescript "sh_step=" & decimal mfun_shade_step
679    t
680enddef ;
681
682numeric mfun_shade_fx, mfun_shade_fy ;
683numeric mfun_shade_lx, mfun_shade_ly ;
684numeric mfun_shade_nx, mfun_shade_ny ;
685numeric mfun_shade_dx, mfun_shade_dy ;
686numeric mfun_shade_tx, mfun_shade_ty ;
687
688% first
689
690def mfun_with_shade_method_analyze(expr p) =
691    mfun_shade_path := p ;
692    mfun_shade_step := 1 ;
693    mfun_shade_fx   := xpart point 0 of p ;
694    mfun_shade_fy   := ypart point 0 of p ;
695    mfun_shade_lx   := mfun_shade_fx ;
696    mfun_shade_ly   := mfun_shade_fy ;
697    mfun_shade_nx   := 0 ;
698    mfun_shade_ny   := 0 ;
699    mfun_shade_dx   := abs(mfun_shade_fx - mfun_shade_lx) ;
700    mfun_shade_dy   := abs(mfun_shade_fy - mfun_shade_ly) ;
701    for i=1 upto length(p) :
702        mfun_shade_tx := abs(mfun_shade_fx - xpart point i of p) ;
703        mfun_shade_ty := abs(mfun_shade_fy - ypart point i of p) ;
704        if mfun_shade_tx > mfun_shade_dx :
705            mfun_shade_nx := i + 1 ;
706            mfun_shade_lx := xpart point i of p ;
707            mfun_shade_dx := mfun_shade_tx ;
708        fi ;
709        if mfun_shade_ty > mfun_shade_dy :
710            mfun_shade_ny := i + 1 ;
711            mfun_shade_ly := ypart point i of p ;
712            mfun_shade_dy := mfun_shade_ty ;
713        fi ;
714    endfor ;
715enddef ;
716
717vardef mfun_max_radius(expr p) =
718    max (
719        (xpart center   p - xpart llcorner p) ++ (ypart center   p - ypart llcorner p),
720        (xpart center   p - xpart ulcorner p) ++ (ypart ulcorner p - ypart center   p),
721        (xpart lrcorner p - xpart center   p) ++ (ypart center   p - ypart lrcorner p),
722        (xpart urcorner p - xpart center   p) ++ (ypart urcorner p - ypart center   p)
723    )
724enddef ;
725
726vardef mfun_min_radius(expr p) =
727    min (
728        (xpart center   p - xpart llcorner p) ++ (ypart center   p - ypart llcorner p),
729        (xpart center   p - xpart ulcorner p) ++ (ypart ulcorner p - ypart center   p),
730        (xpart lrcorner p - xpart center   p) ++ (ypart center   p - ypart lrcorner p),
731        (xpart urcorner p - xpart center   p) ++ (ypart urcorner p - ypart center   p)
732    )
733enddef ;
734
735primarydef p withshademethod m =
736    hide(mfun_with_shade_method_analyze(p))
737    p
738    withprescript "sh_domain=0 1"
739    withprescript "sh_transform=yes"
740    withprescript "sh_color=into"
741    withprescript "sh_color_a=" & colordecimals white
742    withprescript "sh_color_b=" & colordecimals black
743    withprescript "sh_first=" & ddecimal point 0 of p % used for support scaling
744    withprescript "sh_set_x=" & ddecimal (mfun_shade_nx,mfun_shade_lx) %
745    withprescript "sh_set_y=" & ddecimal (mfun_shade_ny,mfun_shade_ly) %
746    if m = "linear" :
747        withprescript "sh_type=linear"
748        withprescript "sh_factor=1"
749        withprescript "sh_center_a=" & ddecimal llcorner p
750        withprescript "sh_center_b=" & ddecimal urcorner p
751    else :
752        withprescript "sh_type=circular"
753        withprescript "sh_factor=1.2"
754        withprescript "sh_center_a=" & ddecimal center p
755        withprescript "sh_center_b=" & ddecimal center p
756        withprescript "sh_radius_a=" & decimal 0
757        withprescript "sh_radius_b=" & decimal mfun_max_radius(p)
758    fi
759enddef ;
760
761def withshaderadius expr a =
762    withprescript "sh_radius_a=" & decimal (xpart a)
763    withprescript "sh_radius_b=" & decimal (ypart a)
764enddef ;
765
766def withshadeorigin expr a =
767    withprescript "sh_center_a=" & ddecimal a
768    withprescript "sh_center_b=" & ddecimal a
769enddef ;
770
771def withshadevector expr a =
772    withprescript "sh_center_a=" & ddecimal (point xpart a of mfun_shade_path)
773    withprescript "sh_center_b=" & ddecimal (point ypart a of mfun_shade_path)
774enddef ;
775
776def withshadedirection expr a =
777    withprescript "sh_center_a=" & ddecimal (point xpart a of boundingbox(mfun_shade_path))
778    withprescript "sh_center_b=" & ddecimal (point ypart a of boundingbox(mfun_shade_path))
779enddef ;
780
781def withshadetransform expr a = % yes | no
782    withprescript "sh_transform=" & a
783enddef ;
784
785pair shadedup    ; shadedup    := (0.5,2.5) ;
786pair shadeddown  ; shadeddown  := (2.5,0.5) ;
787pair shadedleft  ; shadedleft  := (1.5,3.5) ;
788pair shadedright ; shadedright := (3.5,1.5) ;
789
790def withshadecenter expr a =
791    withprescript "sh_center_a=" & ddecimal (
792        center mfun_shade_path shifted (
793            xpart a * bbwidth (mfun_shade_path)/2,
794            ypart a * bbheight(mfun_shade_path)/2
795        )
796    )
797enddef ;
798
799def withshadedomain expr d =
800    withprescript "sh_domain=" & ddecimal d
801enddef ;
802
803def withshadefactor expr f =
804    withprescript "sh_factor=" & decimal f
805enddef ;
806
807% def withshadebound (expr a) =
808%     if mfun_shade_step > 0 :
809%         withprescript "sh_bound_" & decimal mfun_shade_step & "=" & decimal a
810%     fi
811% enddef ;
812
813def withshadefraction expr a =
814    if mfun_shade_step > 0 :
815        withprescript "sh_fraction_" & decimal mfun_shade_step & "=" & decimal a
816    fi
817enddef ;
818
819def withshadecolors (expr a, b) =
820    if mfun_shade_step > 0 :
821        withprescript "sh_color=into"
822        withprescript "sh_color_a_" & decimal mfun_shade_step & "=" & colordecimals a
823        withprescript "sh_color_b_" & decimal mfun_shade_step & "=" & colordecimals b
824    else :
825        withprescript "sh_color=into"
826        withprescript "sh_color_a=" & colordecimals a
827        withprescript "sh_color_b=" & colordecimals b
828    fi
829enddef ;
830
831primarydef a shadedinto b = % withcolor red shadedinto green
832    1 % does not work with transparency
833    withprescript "sh_color=into"
834    withprescript "sh_color_a=" & colordecimals a
835    withprescript "sh_color_b=" & colordecimals b
836enddef ;
837
838primarydef p withshade sc =
839    p withprescript mfun_defined_cs_pre[sc]
840enddef ;
841
842def defineshade suffix s =
843    mfun_defineshade(str s)
844enddef ;
845
846def mfun_defineshade (expr s) text t =
847    expandafter def scantokens s = t enddef ;
848enddef ;
849
850def shaded text s =
851    s
852enddef ;
853
854% For me.
855
856primarydef p shownshadevector v =
857    image (
858        drawarrow (point xpart v of p) -- (point ypart v of p) ;
859        fill fullcircle scaled 2 shifted point xpart v of p ;
860        setbounds currentpicture to center currentpicture -- cycle ;
861    )
862enddef ;
863
864primarydef p shownshadedirection v =
865    image (
866        drawarrow (point xpart v of boundingbox p) -- (point ypart v of boundingbox p) ;
867        fill fullcircle scaled 2 shifted (point xpart v of boundingbox p) ;
868        setbounds currentpicture to center currentpicture -- cycle ;
869    )
870enddef ;
871
872primarydef p shownshadecenter v =
873    image (
874        fill fullcircle scaled 2
875            shifted center p shifted (
876            xpart v * bbwidth (p)/2,
877            ypart v * bbheight(p)/2
878        ) ;
879        setbounds currentpicture to center currentpicture -- cycle ;
880    )
881enddef ;
882
883primarydef p shownshadeorigin v =
884    image (
885        fill fullcircle scaled 2 shifted v ;
886        setbounds currentpicture to center currentpicture -- cycle ;
887    )
888enddef ;
889
890% Old macros:
891
892def withcircularshade (expr a, b, ra, rb, ca, cb) =
893    withprescript "sh_type=circular"
894    withprescript "sh_transform=yes"
895    withprescript "sh_domain=0 1"
896    withprescript "sh_factor=1"
897    withprescript "sh_color_a="  & colordecimals ca
898    withprescript "sh_color_b="  & colordecimals cb
899    withprescript "sh_center_a=" & ddecimal a % (a shifted shadeoffset)
900    withprescript "sh_center_b=" & ddecimal b % (b shifted shadeoffset)
901    withprescript "sh_radius_a=" & decimal ra
902    withprescript "sh_radius_b=" & decimal rb
903enddef ;
904
905def withlinearshade (expr a, b, ca, cb) =
906    withprescript "sh_type=linear"
907    withprescript "sh_transform=yes"
908    withprescript "sh_domain=0 1"
909    withprescript "sh_factor=1"
910    withprescript "sh_color_a="  & colordecimals ca
911    withprescript "sh_color_b="  & colordecimals cb
912    withprescript "sh_center_a=" & ddecimal a % (a shifted shadeoffset)
913    withprescript "sh_center_b=" & ddecimal b % (b shifted shadeoffset)
914enddef ;
915
916% replaced (obsolete):
917
918def set_linear_vector (suffix a,b)(expr p,n) =
919    if     (n=1) : a := llcorner p ; b := urcorner p ;
920    elseif (n=2) : a := lrcorner p ; b := ulcorner p ;
921    elseif (n=3) : a := urcorner p ; b := llcorner p ;
922    elseif (n=4) : a := ulcorner p ; b := lrcorner p ;
923    elseif (n=5) : a := .5[ulcorner p,llcorner p] ; b := .5[urcorner p,lrcorner p] ;
924    elseif (n=6) : a := .5[llcorner p,lrcorner p] ; b := .5[ulcorner p,urcorner p] ;
925    elseif (n=7) : a := .5[lrcorner p,urcorner p] ; b := .5[llcorner p,ulcorner p] ;
926    elseif (n=8) : a := .5[urcorner p,ulcorner p] ; b := .5[lrcorner p,llcorner p] ;
927    else         : a := .5[ulcorner p,llcorner p] ; b := .5[urcorner p,lrcorner p] ;
928    fi ;
929enddef ;
930
931def set_circular_vector (suffix ab,r)(expr p,n) =
932    if     (n=1) : ab := llcorner p ;
933    elseif (n=2) : ab := lrcorner p ;
934    elseif (n=3) : ab := urcorner p ;
935    elseif (n=4) : ab := ulcorner p ;
936    else         : ab := center   p ; r := .5r ;
937    fi ;
938enddef ;
939
940def circular_shade (expr p, n, ca, cb) =
941    begingroup ;
942        save ab, r ; pair ab ; numeric r ;
943        r := (xpart lrcorner p - xpart llcorner p) ++ (ypart urcorner p - ypart lrcorner p) ;
944        set_circular_vector(ab,r)(p,n) ;
945        fill p withcircularshade(ab,ab,0,r,ca,cb) ;
946        if trace_shades :
947            drawarrow ab -- ab shifted (0,r) withpen pencircle scaled 1pt withcolor .5white ;
948        fi ;
949    endgroup ;
950enddef ;
951
952def linear_shade (expr p, n, ca, cb) =
953    begingroup ;
954        save a, b ; pair a, b ;
955        set_linear_vector(a,b)(p,n) ;
956        fill p withlinearshade(a,b,ca,cb) ;
957        if trace_shades :
958            drawarrow a -- b withpen pencircle scaled 1pt withcolor .5white ;
959        fi ;
960    endgroup ;
961enddef ;
962
963string mfun_defined_cs_pre[] ; numeric mfun_defined_cs ; mfun_defined_cs := 0 ;
964
965vardef define_circular_shade (expr a, b, ra, rb, ca, cb) =
966    mfun_defined_cs := mfun_defined_cs + 1 ;
967    mfun_defined_cs_pre[mfun_defined_cs] := "sh_type=circular"
968    & mfun_prescript_separator & "sh_domain=0 1"
969    & mfun_prescript_separator & "sh_factor=1"
970    & mfun_prescript_separator & "sh_color_a="  & colordecimals ca
971    & mfun_prescript_separator & "sh_color_b="  & colordecimals cb
972    & mfun_prescript_separator & "sh_center_a=" & ddecimal a % (a shifted shadeoffset)
973    & mfun_prescript_separator & "sh_center_b=" & ddecimal b % (b shifted shadeoffset)
974    & mfun_prescript_separator & "sh_radius_a=" & decimal ra
975    & mfun_prescript_separator & "sh_radius_b=" & decimal rb
976    ;
977    mfun_defined_cs
978enddef ;
979
980vardef define_linear_shade (expr a, b, ca, cb) =
981    mfun_defined_cs := mfun_defined_cs + 1 ;
982    mfun_defined_cs_pre[mfun_defined_cs] := "sh_type=linear"
983    & mfun_prescript_separator & "sh_domain=0 1"
984    & mfun_prescript_separator & "sh_factor=1"
985    & mfun_prescript_separator & "sh_color_a=" & colordecimals ca
986    & mfun_prescript_separator & "sh_color_b=" & colordecimals cb
987    & mfun_prescript_separator & "sh_center_a=" & ddecimal a % (a shifted shadeoffset)
988    & mfun_prescript_separator & "sh_center_b=" & ddecimal b % (b shifted shadeoffset)
989    ;
990    mfun_defined_cs
991enddef ;
992
993% I lost the example code that uses this:
994%
995% vardef define_sampled_linear_shade(expr a,b,n)(text t) =
996%     mfun_defined_cs := mfun_defined_cs + 1 ;
997%     mfun_defined_cs_pre[mfun_defined_cs] := "ssh_type=linear"
998%     & mfun_prescript_separator & "ssh_center_a=" & ddecimal (a shifted shadeoffset)
999%     & mfun_prescript_separator & "ssh_center_b=" & ddecimal (b shifted shadeoffset)
1000%     & mfun_prescript_separator & "ssh_nofcolors=" & decimal n
1001%     & mfun_prescript_separator & "ssh_domain=" & domstr
1002%     & mfun_prescript_separator & "ssh_extend=" & extstr
1003%     & mfun_prescript_separator & "ssh_colors=" & colstr
1004%     & mfun_prescript_separator & "ssh_bounds=" & bndstr
1005%     & mfun_prescript_separator & "ssh_ranges=" & ranstr
1006%     ;
1007%     mfun_defined_cs
1008% enddef ;
1009%
1010% vardef define_sampled_circular_shade(expr a,b,ra,rb,n)(text t) =
1011%     mfun_defined_cs := mfun_defined_cs + 1 ;
1012%     mfun_defined_cs_pre[mfun_defined_cs] := "ssh_type=circular"
1013%     & mfun_prescript_separator & "ssh_center_a=" & ddecimal (a shifted shadeoffset)
1014%     & mfun_prescript_separator & "ssh_radius_a=" & decimal ra
1015%     & mfun_prescript_separator & "ssh_center_b=" & ddecimal (b shifted shadeoffset)
1016%     & mfun_prescript_separator & "ssh_radius_b=" & decimal rb
1017%     & mfun_prescript_separator & "ssh_nofcolors=" & decimal n
1018%     & mfun_prescript_separator & "ssh_domain=" & domstr
1019%     & mfun_prescript_separator & "ssh_extend=" & extstr
1020%     & mfun_prescript_separator & "ssh_colors=" & colstr
1021%     & mfun_prescript_separator & "ssh_bounds=" & bndstr
1022%     & mfun_prescript_separator & "ssh_ranges=" & ranstr
1023%     ;
1024%     mfun_defined_cs
1025% enddef ;
1026
1027% vardef predefined_linear_shade (expr p, n, ca, cb) =
1028%     save a, b, sh ; pair a, b ;
1029%     set_linear_vector(a,b)(p,n) ;
1030%     define_linear_shade (a,b,ca,cb)
1031% enddef ;
1032%
1033% vardef predefined_circular_shade (expr p, n, ca, cb) =
1034%     save ab, r ; pair ab ; numeric r ;
1035%     r := (xpart lrcorner p - xpart llcorner p) ++ (ypart urcorner p - ypart lrcorner p) ;
1036%     set_circular_vector(ab,r)(p,n) ;
1037%     define_circular_shade(ab,ab,0,r,ca,cb)
1038% enddef ;
1039
1040% Layers
1041
1042def onlayer primary name =
1043    withprescript "la_name=" & name
1044enddef ;
1045
1046% Figures
1047
1048% def externalfigure primary filename =
1049%     doexternalfigure (filename)
1050% enddef ;
1051%
1052% def doexternalfigure (expr filename) text transformation =
1053%     if true : % a bit incompatible esp scaled 1cm now scaled the natural size
1054%         draw rawtextext("\externalfigure[" & filename & "]") transformation ;
1055%     else :
1056%         draw unitsquare transformation withprescript "fg_name=" & filename ;
1057%     fi ;
1058% enddef ;
1059
1060def withmask primary filename =
1061    withprescript "fg_mask=" & filename
1062enddef ;
1063
1064vardef externalfigure primary filename =
1065    mfun_tt_c := nullpicture ;
1066    mfun_tt_r := lua.mp.mf_external_figure(filename) ;
1067    addto mfun_tt_c doublepath unitsquare
1068        xscaled wdpart mfun_tt_r
1069        yscaled htpart mfun_tt_r
1070        withprescript "mf_object=figure"
1071        withprescript "fg_name=" & filename ;
1072    ;
1073    mfun_tt_c
1074enddef ;
1075
1076def figure primary filename =
1077    rawtextext("\externalfigure[" & filename & "]")
1078enddef ;
1079
1080% Positions
1081
1082def register (expr tag, width, height, offset) =
1083%     draw image (
1084        addto currentpicture doublepath unitsquare xscaled width yscaled height shifted offset
1085            withprescript "ps_label=" & tag ;
1086%     ) ; % no transformations
1087enddef ;
1088
1089% outlines (todo: pass around less arguments)
1090
1091numeric currentoutlinetext ; currentoutlinetext := 0 ;
1092
1093vardef mfun_do_outline_text_flush (expr kind, n, x, y, c) (text t) =
1094    if kind = "f" :
1095        mfun_do_outline_text_f (n, x, y, c) (t)
1096    elseif kind = "d" :
1097        mfun_do_outline_text_d (n, x, y, c) (t)
1098    elseif kind = "b" :
1099        mfun_do_outline_text_b (n, x, y, c) (t)
1100    elseif kind = "r" :
1101        mfun_do_outline_text_r (n, x, y, c) (t)
1102    elseif kind = "p" :
1103        mfun_do_outline_text_p (n, x, y, c) (t)
1104    elseif kind = "u" :
1105        mfun_do_outline_text_u (n, x, y, c) (t)
1106    else :
1107        mfun_do_outline_text_n (n, x, y, c) (t)
1108    fi ;
1109enddef ;
1110
1111vardef mfun_do_outline_rule_flush (expr kind, x, y, w, h) =
1112    mfun_do_outline_text_flush (kind, 1, x, y, "") (fullsquare xyscaled(w,h))
1113enddef ;
1114
1115numeric mfun_do_outline_n ; mfun_do_outline_n := 0 ;
1116
1117vardef mfun_do_outline_text_f (expr n, x, y, c) (text t) =
1118    mfun_do_outline_n := 0 ;
1119    for i=t :
1120        mfun_do_outline_n := mfun_do_outline_n + 1 ;
1121        if mfun_do_outline_n = n : fill else : nofill fi (i shifted(x,y)) mfun_do_outline_options_f withpen pencircle scaled 0 withprescript c ;
1122    endfor ;
1123enddef ;
1124
1125vardef mfun_do_outline_text_u (expr n, x, y, c) (text t) =
1126    mfun_do_outline_n := 0 ;
1127    for i=t :
1128        mfun_do_outline_n := mfun_do_outline_n + 1 ;
1129        if mfun_do_outline_n = n : fillup else : nofill fi (i shifted(x,y)) mfun_do_outline_options_f withprescript c ;
1130    endfor ;
1131enddef ;
1132
1133vardef mfun_do_outline_text_d (expr n, x, y, c) (text t) =
1134    for i=t :
1135        draw i shifted(x,y) mfun_do_outline_options_d ;
1136    endfor ;
1137enddef ;
1138
1139vardef mfun_do_outline_text_p (expr n, x, y, c) (text t) =
1140    for i=t :
1141        draw i shifted(x,y) withprescript c ;
1142    endfor ;
1143enddef ;
1144
1145vardef mfun_do_outline_text_b (expr n, x, y, c) (text t) =
1146    mfun_do_outline_n := 0 ;
1147    for i=t :
1148        mfun_do_outline_n := mfun_do_outline_n + 1 ;
1149        if mfun_do_outline_n = n : fill else : nofill fi (i shifted(x,y)) mfun_do_outline_options_f ;
1150    endfor ;
1151    for i=t :
1152        draw i shifted(x,y) mfun_do_outline_options_d ;
1153    endfor ;
1154enddef ;
1155
1156vardef mfun_do_outline_text_r (expr n, x, y, c) (text t) =
1157    mfun_do_outline_n := 0 ;
1158    for i=t :
1159        draw i shifted(x,y) mfun_do_outline_options_d ;
1160    endfor ;
1161    for i=t :
1162        mfun_do_outline_n := mfun_do_outline_n + 1 ;
1163        if mfun_do_outline_n = n : fill else : nofill fi (i shifted(x,y)) mfun_do_outline_options_f;
1164    endfor ;
1165enddef ;
1166
1167vardef mfun_do_outline_text_n (expr n, x, y, c) (text t) =
1168    mfun_do_outline_n := 0 ;
1169    for i=t :
1170        mfun_do_outline_n := mfun_do_outline_n + 1 ;
1171        if mfun_do_outline_n = n : fill else : nofill fi (i shifted(x,y)) ;
1172    endfor ;
1173enddef ;
1174
1175vardef mfun_do_outline_text_set_f (text f) text r =
1176    def mfun_do_outline_options_f = f enddef ;
1177    def mfun_do_outline_options_r = r enddef ;
1178enddef ;
1179
1180vardef mfun_do_outline_text_set_u (text f) text r =
1181    def mfun_do_outline_options_f = f enddef ;
1182enddef ;
1183
1184vardef mfun_do_outline_text_set_d (text d) text r =
1185    def mfun_do_outline_options_d = d enddef ;
1186    def mfun_do_outline_options_r = r enddef ;
1187enddef ;
1188
1189vardef mfun_do_outline_text_set_b (text f) (text d) text r =
1190    def mfun_do_outline_options_f = f enddef ;
1191    def mfun_do_outline_options_d = d enddef ;
1192    def mfun_do_outline_options_r = r enddef ;
1193enddef ;
1194
1195vardef mfun_do_outline_text_set_r (text d) (text f) text r =
1196    def mfun_do_outline_options_d = d enddef ;
1197    def mfun_do_outline_options_f = f enddef ;
1198    def mfun_do_outline_options_r = r enddef ;
1199enddef ;
1200
1201vardef mfun_do_outline_text_set_n text r =
1202    def mfun_do_outline_options_r = r enddef ;
1203enddef ;
1204
1205vardef mfun_do_outline_text_set_p =
1206enddef ;
1207
1208def mfun_do_outline_options_d = enddef ;
1209def mfun_do_outline_options_f = enddef ;
1210def mfun_do_outline_options_r = enddef ;
1211
1212def outlinetexttopath(text o, p, n) =
1213    scantokens("numeric " & str n &   ";") ;
1214    scantokens("path "    & str p & "[];") ;
1215    n := 0 ;
1216    for i within o : p[incr(n)] := pathpart i ; endfor ;
1217enddef ;
1218
1219def filloutlinetext(expr o) =
1220    draw image (
1221        save n, m ; numeric n, m ; n := m := 0 ;
1222        for i within o :
1223            n := n + 1 ;
1224        endfor ;
1225        for i within o :
1226            m := m + 1 ;
1227            if n = m :
1228                eofill
1229            else :
1230                nofill
1231            fi pathpart i ;
1232        endfor ;
1233    )
1234enddef ;
1235
1236def drawoutlinetext(expr o) =
1237    draw image (
1238        % nicer for properties
1239        for i within o :
1240            draw pathpart i ;
1241        endfor ;
1242    )
1243enddef ;
1244
1245vardef outlinetext@# (expr t) text rest =
1246    save kind ; string kind ; kind := str @# ;
1247    currentoutlinetext := currentoutlinetext + 1 ;
1248    def mfun_do_outline_options_d = enddef ;
1249    def mfun_do_outline_options_f = enddef ;
1250    def mfun_do_outline_options_r = enddef ;
1251    image ( normaldraw image (
1252      % lua.mp.report("set outline text",currentoutlinetext);
1253        lua.mp.mf_outline_text(currentoutlinetext,t,kind) ;
1254      % lua.mp.report("get outline text",currentoutlinetext);
1255        if kind = "f" :
1256            mfun_do_outline_text_set_f rest ;
1257        elseif kind = "d" :
1258            mfun_do_outline_text_set_d rest ;
1259        elseif kind = "b" :
1260            mfun_do_outline_text_set_b rest ;
1261        elseif kind = "u" :
1262            mfun_do_outline_text_set_f rest ;
1263        elseif kind = "r" :
1264            mfun_do_outline_text_set_r rest ;
1265        elseif kind = "p" :
1266            mfun_do_outline_text_set_p ;
1267        else :
1268            mfun_do_outline_text_set_n rest ;
1269        fi ;
1270        lua.mp.mf_get_outline_text(currentoutlinetext) ;
1271    ) mfun_do_outline_options_r ; )
1272enddef ;
1273
1274% A few helpers:
1275
1276numeric mfun_c_b_llx, mfun_c_b_h, mfun_c_b_w, mfun_c_b_l ;
1277
1278vardef checkedbounds(expr llx,lly,urx,ury) =
1279    mfun_c_b_llx := min(xpart llcorner currentpicture,llx) ;
1280    mfun_c_b_urx := max(xpart urcorner currentpicture,urx) ;
1281    mfun_c_b_lly := min(ypart llcorner currentpicture,lly) ;
1282    mfun_c_b_ury := max(ypart urcorner currentpicture,ury) ;
1283    (mfun_c_b_llx,mfun_c_b_lly) --
1284    (mfun_c_b_urx,mfun_c_b_lly) --
1285    (mfun_c_b_urx,mfun_c_b_ury) --
1286    (mfun_c_b_llx,mfun_c_b_ury) -- cycle
1287enddef ;
1288
1289vardef checkbounds(expr llx,lly,urx,ury) =
1290    setbounds currentpicture to checkedbounds(llx,lly,urx,ury) ;
1291enddef ;
1292
1293vardef strut(expr ht,dp) =
1294    setbounds currentpicture to checkedbounds(0,0,ht,dp) ;
1295enddef ;
1296
1297vardef rule(expr wd,ht,dp) =
1298    image (fill (0,-dp)--(wd,-dp)--(wd,ht)--(0,ht)--cycle)
1299enddef ;
1300
1301% Housekeeping
1302
1303extra_beginfig := extra_beginfig & "currentgraphictext := 0 ; " ;
1304extra_beginfig := extra_beginfig & "currentoutlinetext := 0 ; " ;
1305extra_endfig   := extra_endfig   & "finishsavingdata ; " ;
1306extra_endfig   := extra_endfig   & "mfun_reset_tex_texts ; " ;
1307
1308% Bonus
1309
1310vardef verbatim(expr s) =
1311    ditto & "\detokenize{" & s & "}" & ditto
1312enddef ;
1313
1314% New
1315
1316def bitmapimage(expr xresolution, yresolution, data) =
1317    image (
1318        addto currentpicture doublepath unitsquare
1319            withprescript  "bm_xresolution=" & decimal xresolution
1320            withprescript  "bm_yresolution=" & decimal yresolution
1321            withpostscript data ;
1322    )
1323enddef ;
1324
1325% Experimental:
1326%
1327% property p ; p = properties(withcolor (1,1,0,0)) ;
1328% fill fullcircle scaled 20cm withproperties p ;
1329
1330let property = picture ;
1331
1332vardef properties(text t) =
1333    image(draw unitcircle t)
1334enddef ;
1335
1336def withproperties expr p =
1337    if colormodel p = graycolormodel :
1338        withcolor greypart p
1339    elseif colormodel p = rgbcolor :
1340        withcolor (redpart p,greenpart p,bluepart p)
1341    elseif colormodel p = cmykcolormodel :
1342        withcolor (cyanpart p,magentapart p,yellowpart p,blackpart p)
1343    fi
1344    withpen penpart p
1345    if length (dashpart p) > 0 :
1346        dashed dashpart p
1347    fi
1348    withprescript prescriptpart p
1349    withpostscript postscriptpart p
1350enddef ;
1351
1352% Experimental:
1353
1354primarydef t asgroup s = % s = isolated|knockout
1355    begingroup
1356    save grouppicture, wrappedpicture, groupbounds ;
1357    picture grouppicture, wrappedpicture ; path groupbounds ;
1358    grouppicture := if picture t : t else : image(draw t) fi ;
1359    groupbounds := boundingbox grouppicture ;
1360    wrappedpicture:= nullpicture ;
1361    addto wrappedpicture contour groupbounds
1362        withprescript "gr_state=start"
1363        withprescript "gr_type=" & s ;
1364    addto wrappedpicture also grouppicture ;
1365    addto wrappedpicture contour groupbounds
1366        withprescript "gr_state=stop" ;
1367    wrappedpicture
1368    endgroup
1369enddef ;
1370
1371% Also experimental ... needs to be made better ... so it can change!
1372
1373string mfun_auto_align[] ;
1374
1375mfun_auto_align[0] := "rt" ;
1376mfun_auto_align[1] := "urt" ;
1377mfun_auto_align[2] := "top" ;
1378mfun_auto_align[3] := "ulft" ;
1379mfun_auto_align[4] := "lft" ;
1380mfun_auto_align[5] := "llft" ;
1381mfun_auto_align[6] := "bot" ;
1382mfun_auto_align[7] := "lrt" ;
1383mfun_auto_align[8] := "rt" ;
1384
1385def autoalign(expr n) =
1386    scantokens mfun_auto_align[round((n mod 360)/45)]
1387enddef ;
1388
1389% draw textext.autoalign(60) ("\strut oeps 1") ;
1390% draw textext.autoalign(160)("\strut oeps 2") ;
1391% draw textext.autoalign(260)("\strut oeps 3") ;
1392% draw textext.autoalign(360)("\strut oeps 4") ;
1393
1394% new
1395%
1396% passvariable("version","1.0") ;
1397% passvariable("number",123) ;
1398% passvariable("string","whatever") ;
1399% passvariable("point",(1,2)) ;
1400% passvariable("triplet",(1,2,3)) ;
1401% passvariable("quad",(1,2,3,4)) ;
1402% passvariable("boolean",false) ;
1403% passvariable("path",fullcircle scaled 1cm) ;
1404
1405% we could use the new lua interface but there is not that much gain i.e.
1406% we still need to serialize
1407
1408vardef mfun_point_to_string(expr p,i) =
1409    decimal xpart (point       i of p) & " " &
1410    decimal ypart (point       i of p) & " " &
1411    decimal xpart (precontrol  i of p) & " " &
1412    decimal ypart (precontrol  i of p) & " " &
1413    decimal xpart (postcontrol i of p) & " " &
1414    decimal ypart (postcontrol i of p)
1415enddef ;
1416
1417vardef mfun_transform_to_string(expr t) =
1418    decimal xxpart t & " " &   % rx
1419    decimal xypart t & " " &   % sx
1420    decimal yxpart t & " " &   % sy
1421    decimal yypart t & " " &   % ry
1422    decimal xpart  t & " " &   % tx
1423    decimal ypart  t           % ty
1424enddef ;
1425
1426vardef mfun_numeric_to_string(expr n) =
1427    decimal n
1428enddef ;
1429
1430vardef mfun_pair_to_string(expr p) =
1431    decimal xpart p & " " &
1432    decimal ypart p
1433enddef ;
1434
1435vardef mfun_rgbcolor_to_string(expr c) =
1436    decimal redpart   c & " " &
1437    decimal greenpart c & " " &
1438    decimal bluepart  c
1439enddef ;
1440
1441vardef mfun_cmykcolor_to_string(expr c) =
1442    decimal cyanpart    c & " " &
1443    decimal magentapart c & " " &
1444    decimal yellowpart  c & " " &
1445    decimal blackpart   c
1446enddef ;
1447
1448vardef mfun_pair_to_table(expr p) =
1449    "{" & decimal xpart p &
1450    "," & decimal ypart p &
1451    "}"
1452enddef ;
1453
1454vardef mfun_point_to_table(expr p,i) =
1455    "{" & decimal xpart (point       i of p) &
1456    "," & decimal ypart (point       i of p) &
1457    "," & decimal xpart (precontrol  i of p) &
1458    "," & decimal ypart (precontrol  i of p) &
1459    "," & decimal xpart (postcontrol i of p) &
1460    "," & decimal ypart (postcontrol i of p) &
1461    "}"
1462enddef ;
1463
1464vardef mfun_path_to_table(expr p) =
1465    "{" & mfun_point_to_table(p,0) for i=1 upto length(p) : & "," & mfun_point_to_table(p,i) endfor & "}"
1466enddef ;
1467
1468vardef mfun_rgb_to_table(expr c) =
1469    "{" & decimal redpart   c &
1470    "," & decimal greenpart c &
1471    "," & decimal bluepart  c &
1472    "}"
1473enddef ;
1474
1475vardef mfun_cmyk_to_table(expr c) =
1476    "{" & decimal cyanpart    c &
1477    "," & decimal magentapart c &
1478    "," & decimal yellowpart  c &
1479    "," & decimal blackpart   c &
1480    "}"
1481enddef ;
1482
1483vardef mfun_grey_to_string(expr n) =
1484    decimal n
1485enddef ;
1486
1487vardef mfun_path_to_string(expr p) =
1488    mfun_point_to_string(p,0) for i=1 upto length(p) : & " " & mfun_point_to_string(p,i) endfor
1489enddef ;
1490
1491vardef mfun_boolean_to_string(expr b) =
1492    if b : "true" else : "false" fi
1493enddef ;
1494
1495vardef tostring primary v =
1496    if     numeric   v : mfun_numeric_to_string(v)
1497    elseif pair      v : mfun_pair_to_string(v)
1498    elseif rgbcolor  v : mfun_rgbcolor_to_string(v)
1499    elseif cmykcolor v : mfun_cmykcolor_to_string(v)
1500    elseif greycolor v : mfun_greycolor_to_string(v)
1501    elseif boolean   v : mfun_boolean_to_string(v)
1502    elseif path      v : mfun_path_to_string(v)
1503    elseif transform v : mfun_transform_to_string(v)
1504    else               : v
1505    fi
1506enddef ;
1507
1508vardef topair primary p =
1509    if     pair    p : "(" & decimal xpart p & "," & decimal ypart p & ")"
1510    elseif numeric p : "(" & decimal       p & "," & decimal       p & ")"
1511    else             : "" fi
1512enddef ;
1513
1514string dq ; dq := char 92 & char 34 ;
1515string sq ; sq := char 92 & char 39 ;
1516
1517vardef quote     primary s = sq & tostring(s) & sq enddef;
1518vardef quotation primary s = dq & tostring(s) & dq enddef;
1519
1520vardef mfun_tagged_string(expr value) =
1521    if     numeric   value : "1:" & mfun_numeric_to_string(value)
1522    elseif pair      value : "4:" & mfun_pair_to_string(value)
1523    elseif rgbcolor  value : "5:" & mfun_rgbcolor_to_string(value)
1524    elseif cmykcolor value : "6:" & mfun_cmykcolor_to_string(value)
1525    elseif boolean   value : "3:" & mfun_boolean_to_string(value)
1526    elseif path      value : "7:" & mfun_path_to_string(value)
1527    elseif transform value : "8:" & mfun_transform_to_string(value)
1528    else                   : "2:" & value
1529    fi
1530enddef ;
1531
1532% A more flexible variant for passing data to context. We used to construct strings
1533% but running lua is fast enough so we can gain on string construction in metapost
1534% which is also not that efficient.
1535
1536vardef mfun_key_to_lua(expr k) =
1537    if numeric k : decimal k else : "'" & k & "'" fi
1538enddef ;
1539
1540vardef mfun_point_to_lua(expr k,p,i) =
1541    runscript( "metapost.setvariable(" & mfun_key_to_lua(k) & ",{" &
1542        decimal xpart (point       i of p) & "," &
1543        decimal ypart (point       i of p) & "," &
1544        decimal xpart (precontrol  i of p) & "," &
1545        decimal ypart (precontrol  i of p) & "," &
1546        decimal xpart (postcontrol i of p) & "," &
1547        decimal ypart (postcontrol i of p)
1548    & "})" ) ;
1549enddef ;
1550
1551vardef mfun_transform_to_lua(expr k,t) =
1552    runscript( "metapost.setvariable(" & mfun_key_to_lua(k) & ",{" &
1553        decimal xxpart t & "," &   % rx
1554        decimal xypart t & "," &   % sx
1555        decimal yxpart t & "," &   % sy
1556        decimal yypart t & "," &   % ry
1557        decimal xpart  t & "," &   % tx
1558        decimal ypart  t           % ty
1559    & "})" ) ;
1560enddef ;
1561
1562vardef mfun_numeric_to_lua(expr k,n) =
1563    runscript( "metapost.setvariable(" & mfun_key_to_lua(k) & "," & decimal n & ")" ) ;
1564enddef ;
1565
1566vardef mfun_pair_to_lua(expr k,p) =
1567    runscript( "metapost.setvariable(" & mfun_key_to_lua(k) & ",{" &
1568        decimal xpart p & "," &
1569        decimal ypart p
1570    & "})" ) ;
1571enddef ;
1572
1573vardef mfun_rgbcolor_to_lua(expr k,c) =
1574    runscript( "metapost.setvariable(" & mfun_key_to_lua(k) & ",{" &
1575        decimal redpart   c & "," &
1576        decimal greenpart c & "," &
1577        decimal bluepart  c
1578    & "})" ) ;
1579enddef ;
1580
1581vardef mfun_cmykcolor_to_lua(expr k,c) =
1582    runscript( "metapost.setvariable(" & mfun_key_to_lua(k) & ",{" &
1583        decimal cyanpart    c & "," &
1584        decimal magentapart c & "," &
1585        decimal yellowpart  c & "," &
1586        decimal blackpart   c
1587    & "})" ) ;
1588enddef ;
1589
1590vardef mfun_path_to_lua(expr k,p) =
1591    runscript("metapost.pushvariable(" & mfun_key_to_lua(k) & ")") ;
1592    for i=0 upto length(p) :
1593        mfun_point_to_lua(i+1,p,i) ;
1594    endfor ;
1595    runscript("metapost.popvariable()") ;
1596enddef ;
1597
1598vardef mfun_boolean_to_lua(expr k,b) =
1599    runscript( "metapost.setvariable(" & mfun_key_to_lua(k) & if b : ",true)" else : ",false)" fi ) ;
1600enddef ;
1601
1602vardef mfun_string_to_lua(expr k,s) =
1603    runscript( "metapost.setvariable(" & mfun_key_to_lua(k) & ",[==[" & s & "]==])" ) ;
1604enddef ;
1605
1606def passvariable(expr key, value) =
1607    if     numeric   value : mfun_numeric_to_lua  (key,value) ;
1608    elseif pair      value : mfun_pair_to_lua     (key,value) ;
1609    elseif string    value : mfun_string_to_lua   (key,value) ;
1610    elseif boolean   value : mfun_boolean_to_lua  (key,value) ;
1611    elseif path      value : mfun_path_to_lua     (key,value) ;
1612    elseif rgbcolor  value : mfun_rgbcolor_to_lua (key,value) ;
1613    elseif cmykcolor value : mfun_cmykcolor_to_lua(key,value) ;
1614    elseif transform value : mfun_transform_to_lua(key,value) ;
1615    fi ;
1616enddef ;
1617
1618def passarrayvariable(expr key)(suffix values)(expr first, last, stp) =
1619    runscript("metapost.pushvariable(" & mfun_key_to_lua(key) & ")") ;
1620    for i=first step stp until last :
1621        passvariable(i, values[i]) ;
1622    endfor
1623    runscript("metapost.popvariable()") ;
1624enddef ;
1625
1626def startpassingvariable(expr k) =
1627    runscript("metapost.pushvariable(" & mfun_key_to_lua(k) & ")") ;
1628enddef ;
1629
1630def stoppassingvariable =
1631    runscript("metapost.popvariable()") ;
1632enddef ;
1633
1634% moved here from mp-grap.mpiv
1635
1636% vardef escaped_format(expr s) =
1637%     "" for n=0 upto length(s) : &
1638%         if ASCII substring (n,n+1) of s = 37 :
1639%             "@"
1640%         else :
1641%             substring (n,n+1) of s
1642%         fi
1643%     endfor
1644% enddef ;
1645
1646numeric mfun_esc_b ; % begin
1647numeric mfun_esc_l ; % length
1648string  mfun_esc_s ; % character
1649
1650mfun_esc_s := "%" ; % or: char(37)
1651
1652% this one is the fastest when we have a match
1653
1654% vardef escaped_format(expr s) =
1655%     "" for n=0 upto length(s)-1 : &
1656%       % if ASCII substring (n,n+1) of s = 37 :
1657%         if substring (n,n+1) of s = mfun_esc_s :
1658%             "@"
1659%         else :
1660%             substring (n,n+1) of s
1661%         fi
1662%     endfor
1663% enddef ;
1664
1665% this one wins when we have no match
1666
1667vardef escaped_format(expr s) =
1668    mfun_esc_b := 0 ;
1669    mfun_esc_l := length(s) ;
1670    for n=0 upto mfun_esc_l-1 :
1671      % if ASCII substring (n,n+1) of s = 37 :
1672        if substring (n,n+1) of s = mfun_esc_s :
1673            if mfun_esc_b = 0 :
1674                ""
1675            fi
1676            if n >= mfun_esc_b :
1677                & (substring (mfun_esc_b,n) of s)
1678                exitif numeric begingroup mfun_esc_b := n+1 endgroup ; % hide
1679            fi
1680            & "@"
1681        fi
1682    endfor
1683    if mfun_esc_b = 0 :
1684        s
1685  % elseif mfun_esc_b > 0 :
1686    elseif mfun_esc_b < mfun_esc_l :
1687        & (substring (mfun_esc_b,mfun_esc_l) of s)
1688    fi
1689enddef ;
1690
1691vardef strfmt(expr f, x) = "\MPgraphformat{" & escaped_format(f) & "}{" & mfun_tagged_string(x) & "}" enddef ;
1692vardef varfmt(expr f, x) = "\MPformatted{"   & escaped_format(f) & "}{" & mfun_tagged_string(x) & "}" enddef ;
1693
1694vardef format@#   (expr f, x) = textext@#(strfmt(f, x)) enddef ;
1695vardef formatted@#(expr f, x) = textext@#(varfmt(f, x)) enddef ;
1696
1697% could be this (something to discuss with alan as it involves graph):
1698%
1699% vardef format   (expr f,x) = lua.mp.graphformat(f,mfun_tagged_string(x) enddef ;
1700% vardef formatted(expr f,x) = lua.mp.format     (f,                   x) enddef ;
1701%
1702% def strfmt = format    enddef ; % old
1703% def varfmt = formatted enddef ; % old
1704
1705
1706% def fmttext = lua.mp.formatted enddef ;
1707
1708% new
1709
1710def fillup   text t = draw t withpostscript "both"    enddef ; % we use draw because we need the proper boundingbox
1711def eofillup text t = draw t withpostscript "eoboth"  enddef ; % we use draw because we need the proper boundingbox
1712def eofill   text t = fill t withpostscript "evenodd" enddef ;
1713def nofill   text t = fill t withpostscript "collect" enddef ;
1714def nodraw   text t = draw t withpostscript "collect" enddef ;
1715def dodraw   text t = draw t withpostscript "flush"   enddef ;
1716def dofill   text t = fill t withpostscript "flush"   enddef ;
1717
1718% maybe (saves a bogus path but the problem is that it can influence the dimensions):
1719
1720% def dodraw text t = draw center currentpicture         withpostscript "flush" enddef ;
1721% def dofill text t = fill center currentpicture --cycle withpostscript "flush" enddef ;
1722
1723if contextlmtxmode :
1724    def eoclip text t = clip t withpostscript "evenodd" enddef ;
1725else :
1726    def eoclip text t = clip t enddef ; % no postscripts yet
1727fi ;
1728
1729% def withrule expr r =
1730%     if (t = "even-odd") or (t = "evenodd") : withpostscript "evenodd" fi
1731% enddef ;
1732
1733% A comment will end up on top of the graphic in the output. This can be handy for
1734% locating a graphic: comment("test graphic").
1735
1736def comment expr str =
1737    special "metapost.comment[[" & str & "]]" ;
1738enddef ;
1739
1740vardef report(text t) =
1741    lua.mp.report(t)
1742enddef ;
1743
1744% This overloads a dummy:
1745
1746vardef uniquelist(suffix list) =
1747    % this can be optimized by passing all values at once and returning
1748    % a result but for now this is ok .. we need an undef foo
1749    save i, j, h ;
1750    if known lis[0] :
1751        i := 0 ;
1752        j := -1 ;
1753    else :
1754        i := 1 ;
1755        j := 0 ;
1756    fi ;
1757    h := lua.mp.newhash() ;
1758    forever :
1759        exitif unknown list[i] ;
1760        if not lua.mp.inhash(h,list[i]) :
1761            j := j + 1 ;
1762            list[j] := list[i] ;
1763            lua.mp.tohash(h,list[i]) ;
1764        fi ;
1765        i := i + 1 ;
1766    endfor ;
1767    for n = j+1 step 1 until i-1 :
1768        dispose(list[n])
1769    endfor ;
1770    lua.mp.disposehash(h) ;
1771enddef ;
1772