summaryrefslogtreecommitdiff
path: root/macros/luatex/generic/minim-mp/minim-mp.mp
blob: 2fd2db1074b85d8ee8be9e13fb43c6a3879da2c3 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389

delimiters ();

% This file is specific to the minim metapost processor (minim-mp) and cannot 
% be used with luamplib or other metapost implementations. See minim.mp for 
% general-purpose extensions.

message "Setting up the minim MetaPost extensions";

def save_picture   text t = save t; picture   t; enddef;
def save_boolean   text t = save t; boolean   t; enddef;
def save_string    text t = save t; string    t; enddef;
def save_path      text t = save t; path      t; enddef;

% 1 lua scripts, functions and variables

def luafunction = gobble inner_luafunction enddef;
vardef inner_luafunction @# (text args) = endgroup
    % we remove the grouping so that the function may return any fragment of 
    % metapost code, in particular lists to-be-parsed as text parameters
    runscript ("return " & (str @#) & build_lua_arguments(args))
    gobble begingroup enddef;

vardef build_lua_arguments (text args) =
    save_boolean first; first = true;
    "(" for a = args:
        & if first: hide(first:=false) "" else: "," fi
        & (quote_for_lua a)
    endfor & ")"
enddef;

vardef luavariable @# =
    runscript ("return quote("&(str @#)&")") enddef;
vardef setluavariable @# expr val=
    runscript ((str @#)&" = "&quote_for_lua(val)) enddef;

% quoting expressions for lua

vardef lua_string(expr s) =
    runscript ("[[quote_for_lua]]"&s) enddef;

vardef hexadecimal tertiary n =
    % TODO: support other number systems
    save d, a, m; a = ASCII("a"); m := abs n;
    save_string res; res =
    if n < 0: "-0x" else: "0x" fi
    for i = 1 upto 7: &
        hide(d := floor m div 256; m := 16(m - 256d);)
        if d < 10: decimal d else: char(a+d-10) fi
        if i = 3: & "." fi
    endfor; res enddef;

vardef scaledpoints tertiary n =
    % use the fact that 800bp = 803pt
    save a, m; m := abs n;
    a1 = m div (1025/1024); % 1025/1024 = 800epsilon * 82
    m := m mod (1025/1024);
    a2 = m div 800epsilon;  % max 82
    m := (m mod 800epsilon) div epsilon;
    a3 = floor(m*803/800 + 1/2);
    save_string res; res =
    if n < 0: "-(" else: "(" fi
        & decimal(a1) & "*803*82 + "
        & decimal(a2) & "*803 + "
        & decimal(a3) & ")";
    res enddef;

vardef quote_for_lua tertiary a =
    save_string res; res =
    if string a:
        lua_string(a)
    elseif numeric a:
        hexadecimal(a)
    elseif pair a:
        "{"& (hexadecimal xpart a) &
        ","& (hexadecimal ypart a) & "}"
    elseif boolean a:
        if a: "true" else: "false" fi
    elseif color a:
        "{"& (hexadecimal redpart a) &
        ","& (hexadecimal greenpart a) &
        ","& (hexadecimal bluepart a) & "}"
    elseif cmykcolor a:
        "{"& (hexadecimal cyanpart a) &
        ","& (hexadecimal magentapart a) &
        ","& (hexadecimal yellowpart a) &
        ","& (hexadecimal blackpart a) & "}"
    elseif pen a:
        hide(errmessage("I cannot pass a pen value to lua");)
        "nil"
    elseif transform a:
        "{"& (hexadecimal xxpart a) &
        ","& (hexadecimal xypart a) &
        ","& (hexadecimal yxpart a) &
        ","& (hexadecimal yypart a) &
        ","& (hexadecimal xpart a) &
        ","& (hexadecimal ypart a) & "}"
    elseif picture a:
        hide(errmessage("I cannot pass a picture value to lua");)
        "nil"
    else: % probably intentionally vacuous, which is fine
        "nil"
    fi; res enddef;

% constructing lua tables

def make_lua_dict (text t) = begingroup
    % Note that though the argument may contain = signs and commas, the rest of 
    % the arguments must consist of suffixes.
    save_boolean first; first := true;
    "{ " forsuffixes kv =
        hide(let = _EQ_ undefined)
        t hide(let = _EQ_ _EQ_) : &
        if first: hide(first := false;) else: ", "& fi
        begingroup make_lua_keyval kv endgroup
    endfor & " }" endgroup
enddef;
let _EQ_ = =;

vardef make_lua_keyval @# expr e =
    (str @#) & " = " & quote_for_lua e
enddef;

% tex registers

string _SUFFIX_HACK_[];
vardef index_or_suffix (suffix s) =
    save_string res; res =
    if string _SUFFIX_HACK_ s: % s is a number
        "["&decimal(s)&"]"
    else: % s is a suffix
        "."&(str s)
    fi ; res enddef;

vardef tex.count @# =
    runscript ("return tex.count" & index_or_suffix(@#)) enddef;
vardef tex.attribute @# =
    runscript ("return tex.attribute" & index_or_suffix(@#)) enddef;
vardef tex.dimen @# =
    runscript ("return sp_to_pt(tex.dimen" & index_or_suffix(@#) & ")") enddef;
vardef tex.toks @# =
    runscript ("return quote(tex.toks" & index_or_suffix(@#) & ")") enddef;

vardef set tex.count @# expr val =
    runscript ("tex.count" & index_or_suffix(@#) & " = " & decimal(val)) enddef;
vardef set tex.attribute @# expr val =
    runscript ("tex.attribute" & index_or_suffix(@#) & " = " & decimal(val)) enddef;
vardef set tex.dimen @# expr val =
    runscript ("tex.dimen" & index_or_suffix(@#) & " = " & scaledpoints(val)) enddef;
vardef set tex.toks @# expr val =
    runscript ("tex.toks" & index_or_suffix(@#) & " = " & lua_string(val)) enddef;

% 1 typesetting

boolean debug_tex_bboxes;
debug_tex_bboxes := false;

let textext = maketext;
let TEX = maketext;

def _set_maketext_result_ (expr nr)(text tr) = image (
    fill unitsquare withprescript "TEXBOX:"&decimal nr;
    save_path bb; bb := unitsquare transformed tr;
    if debug_tex_bboxes: draw bb dashed evenly; fi
    setbounds currentpicture to bb;) enddef;

% baseline pair or numeric -> fill statement
vardef baseline expr o =
    fill if numeric o : (0,o) else: o fi
        -- cycle withprescript "BASELINE:"; enddef;

vardef find_baseline expr p =
    save_pair bl, ibl;
    for c within p:
        if clipped c or bounded c:
            ibl := find_baseline c;
            if known ibl: bl := ibl; fi
        elseif "BASELINE:" = substring (0,9) of prescriptpart c:
            bl := point 0 of pathpart c;
        fi
    endfor bl enddef;

% actual typesetting

primarydef t infont f = image( luafunction minim_infont (t, f); ) enddef;

def glyph expr c of f = luafunction get_glyph (c, f) enddef;

def contours expr t of f = luafunction get_contours (t, f) enddef;

% labels can optionally be typeset with maketext
% and the default font must be set explicitly
string defaultfont;
boolean maketextlabels;
maketextlabels := true;
vardef thelabel@#(expr s,z) =  % Position s near z
  save_picture p;
  p = if     picture s         : s
      elseif maketextlabels    : maketext s
      elseif known defaultfont : s infont defaultfont
      else                     : s infont luafunction font.current()
      fi;
  p shifted (z + labeloffset*laboff@# -
     (labxf@#*lrcorner p + labyf@#*ulcorner p
       + (1-labxf@#-labyf@#)*llcorner p
  )  ) enddef;

% 1 box resources (xforms)

% boxresource number -> fill statement + setbounds
vardef boxresource primary nr = image(
    fill unitsquare withprescript "BOXRESOURCE:" & decimal nr ;
    save btf; transform btf;
    btf = luafunction get_boxresource_dimensions (nr);
    save_path bb; bb = unitsquare transformed btf;
    if debug_tex_bboxes: draw bb dashed evenly; fi
    setbounds currentpicture to bb;
    currentpicture := currentpicture
        shifted luafunction get_boxresource_center (nr);
    ) enddef;

% id = saveboxresource (attributes) image ( ... );
vardef saveboxresource (text attrs) expr p =
    save id; id = luafunction reserve_xform_id();
    % save the dimensions
    save t, o; transform t; pair o;
    (0,0) transformed t = llcorner p;
    (1,0) transformed t = lrcorner p;
    (0,1) transformed t = ulcorner p;
    save bl; bl = -ypart find_baseline p;
    o = (-xpart llcorner p, if known bl: bl else: 0 fi);
    luafunction set_boxresource_dimensions (id, t shifted o, -o);
    % shipout the xform
    shipout image(draw p;
        special "XFORMATTRS:" & make_lua_dict (attrs);
        special "XFORMINDEX:" & decimal id;
    ); id enddef;

% 1 extended graphics state

vardef modify_scripts text t =
    % Note: this is a no-op when the picture is empty
    save_picture curr;
    save_string pre, post;
    % extract script parts
    curr := image(drawdot origin t;);
    pre = prescriptpart curr;
    post = postscriptpart curr;
    % add the prescript
    if pre <> "":
        curr := currentpicture; clearit;
        draw curr withprescript pre;
    fi
    % add the postscript
    if post <> "":
        % here we find the reason for this routine: metapost *should* apply the 
        % postscript to the last element of a picture, but chooses the first 
        % instead.
        curr := currentpicture; clearit;
        setbounds curr to llcorner curr -- lrcorner curr --
            urcorner curr -- ulcorner curr -- cycle;
        % these bounds force an extra nesting level of the next function
        draw with_postscript_to_last(curr, post);
    fi
enddef;

vardef with_postscript_to_last (expr p, script) =
    image( save i; i := 0;
    for c within p:
        if incr i < length(p): draw c;
        elseif clipped c:
            save_picture q; q:= with_postscript_to_last(c, script);
            clip q to pathpart c;
            addto currentpicture also q;
        elseif bounded c:
            save_picture q; q:= with_postscript_to_last(c, script);
            setbounds q to pathpart c;
            addto currentpicture also q;
        else:
            draw c withpostscript script;
        fi
    endfor) enddef;

def append_postscript expr s =
    if length(currentpicture) = 0: special s;
    else: modify_scripts withpostscript s;
    fi enddef;

def savegstate =
    append_postscript "gstate:save"; enddef;
def restoregstate =
    append_postscript "gstate:restore"; enddef;
def setgstate =
    append_postscript "extgstate:" & make_lua_dict enddef;

def withgstate (text t) =
    withprescript "extgstate:" & make_lua_dict (t)
    withprescript "gstate:save"
    withpostscript "gstate:restore" enddef;

% 1 transparency

newinternal string blend_mode;
newinternal string transparency_group_attrs;

% setalpha (α)
vardef setalpha expr alpha =
    save a; a = alpha;
    save_string bm; bm = "/" & blend_mode;
    setgstate(CA=a, ca=a if bm <> "/":, BM=bm fi) enddef;

% <drawing_cmd> withalpha (α)
def withalpha = gobble _withalpha_ enddef;
string _blend_mode_;
vardef _withalpha_ (expr alpha) =
    _with_alpha_ := alpha;
    _blend_mode_ := "/" & blend_mode;
    endgroup
    withgstate(CA=_with_alpha_,ca=_with_alpha_ if _blend_mode_ <> "/":, BM=_blend_mode_ fi)
    gobble begingroup enddef;

% transparent (α) image (...)
vardef transparent (expr alpha) expr p =
    save_string attrs; attrs = "<< /S/Transparency "&transparency_group_attrs&">>";
    save g; g = saveboxresource (Group=attrs) p;
    savegstate; setalpha (alpha);
    draw boxresource g;
    restoregstate;
enddef;

% 1 even-odd rule and multidraw

def nofill expr c = fill c withprescript "OTYPE:nofill" enddef;
def eofill expr c = fill c withprescript "OTYPE:eofill" enddef;
def eofilldraw expr c = filldraw c withprescript "OTYPE:eofilldraw" enddef;

def multidraw (text paths) text opts = draw image(
    for p = paths: ; nofill p opts endfor
    withprescript "OTYPE:outline";) enddef;
def multifill (text paths) text opts = draw image(
    for p = paths: ; nofill p opts endfor
    withprescript "OTYPE:fill";) enddef;
def multifilldraw (text paths) text opts = draw image(
    for p = paths: ; nofill p opts endfor
    withprescript "OTYPE:filldraw";) enddef;
def multieofill (text paths) text opts = draw image(
    for p = paths: ; nofill p opts endfor
    withprescript "OTYPE:eofill";) enddef;
def multieofilldraw (text paths) text opts = draw image(
    for p = paths: ; nofill p opts endfor
    withprescript "OTYPE:eofilldraw";) enddef;

% 1 patterns

def withpattern(suffix s) = withprescript
    ("fillpattern: " & decimal(_patterns_.s)) enddef;
def beginpattern(suffix s) =
    begingroup clearxy; clearit;
    interim defaultcolormodel:=1;
    charcode:=incr _patterns_._last_;
    _patterns_.s:=charcode; drawoptions();
    pickup pencircle scaled 0.4pt;
    save painttype; painttype:=2;
    save _withcolor; let _withcolor = withcolor; save withcolor;
    def withcolor = hide(painttype:=1) _withcolor enddef;
    save matrix; transform matrix; enddef;
def endpattern (expr xstep, ystep) =
    modify_scripts
        withprescript "pdf:/Artifact BMC"
        withpostscript "pdf:EMC";
    if unknown matrix : matrix:=identity; fi
    special "definepattern:" for e = charcode, tilingtype, painttype,
        xstep, ystep, xxpart matrix, xypart matrix, yxpart matrix, yypart matrix:
        & " " & decimal(e) endfor;
    shipit; endgroup enddef;
newinternal tilingtype; tilingtype:=1;
_patterns_._last_ := 0;

% 1 miscellaneous

def debug_pdf = luafunction enable_debugging(); enddef;

vardef texmessage text msg = luafunction texmessage (msg) enddef;

vardef rgb_to_gray expr c =
    luafunction rgb_to_gray (redpart c, greenpart c, bluepart c)
enddef;

%