Source Browser ?

1%D \module
2%D   [       file=mp-luas.mpiv,
3%D        version=2014.04.14,
4%D          title=\CONTEXT\ \METAPOST\ graphics,
5%D       subtitle=\LUA,
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 mreadme.pdf for
12%C details.
13
14if known metafun_loaded_luas : endinput ; fi ;
15
16% When I prototyped the runscript primitive I was just thinking of a usage like
17% the original \directlua primitive in luatex: genererate something and pipe
18% that back to metapost, and have access to some internals. Instead of compiling
19% the code a the metapost end here we delegate that to the lua end. Only strings
20% get passed. Of course in the end the real usage got a bit beyong the intended
21% usage. So, in addition to some definitions here there are and will be use in
22% other metafun modules too. Of course in retrospect I should have done this five
23% years earlier.
24
25newinternal boolean metafun_loaded_luas ; metafun_loaded_luas := true ; immutable metafun_loaded_luas ;
26
27def newscriptindex suffix t = newinternal t ; immutable t ; enddef ;
28
29newscriptindex mfid_scriptindex ; mfid_scriptindex := runscript("mp.mf_script_index('scriptindex')") ;
30
31def scriptindex = runscript mfid_scriptindex enddef ;
32
33string mfun_lua_bs ; mfun_lua_bs := "[===[" ;
34string mfun_lua_es ; mfun_lua_es := "]===]" ;
35
36vardef mlib_luas_luacall(text t) =
37    runscript("" for s = t :
38        if string s :
39            & s
40          % & mfun_lua_bs & s & mfun_lua_es
41        elseif numeric s :
42            & decimal s
43        elseif boolean s :
44            & if s : "true" else : "false" fi
45        elseif pair s :
46            & mfun_pair_to_table(s)
47        elseif path s :
48            & mfun_path_to_table(s)
49        elseif rgbcolor s :
50            & mfun_rgb_to_table(s)
51        elseif cmykcolor s :
52            & mfun_cmyk_to_table(s)
53        else :
54            & ditto & tostring(s) & ditto
55        fi endfor
56    )
57enddef ;
58
59newinternal mfun_luas_b ;
60
61def mlib_luas_luadone =
62    exitif numeric begingroup mfun_luas_b := 1 ; endgroup ;
63enddef ;
64
65vardef mlib_luas_lualist(expr c)(text t) = % we could use mlib_luas_s instead of c
66    interim mfun_luas_b := 0 ;
67    runscript(c & for s = t :
68        if mfun_luas_b = 0 :
69            "("
70          % hide(mfun_luas_b := 1)
71            mlib_luas_luadone
72        else :
73            ","
74        fi
75        &
76        if string s :
77            mfun_lua_bs & s & mfun_lua_es
78        elseif numeric s :
79            decimal s
80        elseif boolean s :
81            if s : "true" else : "false" fi
82        elseif pair s :
83            mfun_pair_to_table(s)
84        elseif path s :
85            mfun_path_to_table(s)
86        elseif rgbcolor s :
87            mfun_rgb_to_table(s)
88        elseif cmykcolor s :
89            mfun_cmyk_to_table(s)
90        else :
91            ditto & tostring(s) & ditto
92        fi & endfor if mfun_luas_b = 0 : "()" else : ")" fi
93    )
94enddef ;
95
96def luacall = mlib_luas_luacall enddef ; % why no let
97
98vardef lualist@#(text t) = mlib_luas_lualist(str @#)(t) enddef ;
99
100string mlib_luas_s ; % saves save/restore
101
102vardef lua@#(text t) =
103    mlib_luas_s := str @# ;
104    if length(mlib_luas_s) > 0 :
105        mlib_luas_lualist(mlib_luas_s,t)
106    else :
107        mlib_luas_luacall(t)
108    fi
109enddef ;
110
111vardef MP@#(text t) =
112    mlib_luas_lualist("MP." & str @#,t)
113enddef ;
114
115% todo: runner
116
117newscriptindex mfun_message ; mfun_message := scriptindex("message") ;
118
119def message text t =
120    runscript mfun_message tostring(t) ; % todo: scananything
121enddef ;
122
123permanent newscriptindex, scriptindex, luacall, lua, lualist, mp, MP  ;
124
125% Color:
126
127% We do a low level runscript:
128%
129% lua.mp.namedcolor(s)       % conflicts with macro namedcolor
130% lua.mp.mf_named_color(s)   % okay but, can also be
131% lua.mp("mf_named_color",s) % which gives expansion mess
132
133newscriptindex mfid_resolvedcolor ; mfid_resolvedcolor := scriptindex "namedcolor" ;
134
135def resolvedcolor = runscript mfid_resolvedcolor enddef ;
136
137permanent resolvedcolor ;
138
139% Modes:
140
141newscriptindex mfid_mode       ; mfid_mode       := scriptindex "mode" ;
142newscriptindex mfid_systemmode ; mfid_systemmode := scriptindex "systemmode" ;
143
144vardef texmode    (expr s) = runscript mfid_mode       s enddef ;
145vardef systemmode (expr s) = runscript mfid_systemmode s enddef ;
146
147% let processingmode = systemmode ;
148
149permanent texmode, systemmode ;
150
151% A few helpers
152
153newscriptindex mfid_isarray   ; mfid_isarray   := scriptindex "isarray"   ;
154newscriptindex mfid_prefix    ; mfid_prefix    := scriptindex "prefix"    ;
155newscriptindex mfid_dimension ; mfid_dimension := scriptindex "dimension" ;
156newscriptindex mfid_isobject  ; mfid_isobject  := scriptindex "isobject"  ;
157
158vardef isarray   suffix a = runscript mfid_isarray  (str a) enddef ;
159vardef prefix    suffix a = runscript mfid_prefix   (str a) enddef ;
160vardef dimension suffix a = runscript mfid_dimension(str a) enddef ;
161
162vardef isobject  expr p = if picture p : runscript mfid_isobject prescriptpart p else : false fi enddef ;
163
164permanent isarray, prefix, dimension, isobject ;
165
166% More access
167
168newscriptindex mfid_getmacro ; mfid_getmacro := scriptindex "getmacro" ; def getmacro = runscript mfid_getmacro enddef ;
169newscriptindex mfid_getdimen ; mfid_getdimen := scriptindex "getdimen" ; def getdimen = runscript mfid_getdimen enddef ;
170newscriptindex mfid_getcount ; mfid_getcount := scriptindex "getcount" ; def getcount = runscript mfid_getcount enddef ;
171newscriptindex mfid_gettoks  ; mfid_gettoks  := scriptindex "gettoks"  ; def gettoks  = runscript mfid_gettoks  enddef ;
172
173% todo: figure out a mixed interface: setdimen "foo" 123pt ; setdimen("foo", 123pt) ;
174
175newscriptindex mfid_setmacro ; mfid_setmacro := scriptindex "setmacro" ; def setmacro(expr k, v) = runscript mfid_setmacro k v ; enddef ;
176newscriptindex mfid_setdimen ; mfid_setdimen := scriptindex "setdimen" ; def setdimen(expr k, v) = runscript mfid_setdimen k v ; enddef ;
177newscriptindex mfid_setcount ; mfid_setcount := scriptindex "setcount" ; def setcount(expr k, v) = runscript mfid_setcount k v ; enddef ;
178newscriptindex mfid_settoks  ; mfid_settoks  := scriptindex "settoks"  ; def settoks (expr k, v) = runscript mfid_settoks  k v ; enddef ;
179
180newscriptindex mfid_setglobalmacro ; mfid_setglobalmacro := scriptindex "setglobalmacro" ; def setglobalmacro(expr k, v) = runscript mfid_setglobalmacro k v ; enddef ;
181newscriptindex mfid_setglobaldimen ; mfid_setglobaldimen := scriptindex "setglobaldimen" ; def setglobaldimen(expr k, v) = runscript mfid_setglobaldimen k v ; enddef ;
182newscriptindex mfid_setglobalcount ; mfid_setglobalcount := scriptindex "setglobalcount" ; def setglobalcount(expr k, v) = runscript mfid_setglobalcount k v ; enddef ;
183newscriptindex mfid_setglobaltoks  ; mfid_setglobaltoks  := scriptindex "setglobaltoks"  ; def setglobaltoks (expr k, v) = runscript mfid_setglobaltoks  k v ; enddef ;
184
185permanent
186    getmacro, getdimen, getcount, gettoks,
187    setmacro, setdimen, setcount, settoks,
188    setglobalmacro, setglobaldimen, setglobalcount, setglobaltoks ;
189
190newscriptindex mfid_positionpath   ; mfid_positionpath   := scriptindex("positionpath") ;
191newscriptindex mfid_positioncurve  ; mfid_positioncurve  := scriptindex("positioncurve") ;
192newscriptindex mfid_positionxy     ; mfid_positionxy     := scriptindex("positionxy") ;
193newscriptindex mfid_positionx      ; mfid_positionx      := scriptindex("positionx") ;
194newscriptindex mfid_positiony      ; mfid_positiony      := scriptindex("positiony") ;
195newscriptindex mfid_positionpar    ; mfid_positionpar    := scriptindex("positionpar") ;
196newscriptindex mfid_positionwhd    ; mfid_positionwhd    := scriptindex("positionwhd") ;
197newscriptindex mfid_positionpage   ; mfid_positionpage   := scriptindex("positionpage") ;
198newscriptindex mfid_positionregion ; mfid_positionregion := scriptindex("positionregion") ;
199newscriptindex mfid_positionbox    ; mfid_positionbox    := scriptindex("positionbox") ;
200newscriptindex mfid_positionanchor ; mfid_positionanchor := scriptindex("positionanchor") ;
201
202vardef positionpath     (expr name) = runscript mfid_positionpath      name enddef ;
203vardef positioncurve    (expr name) = runscript mfid_positioncurve     name enddef ;
204vardef positionxy       (expr name) = runscript mfid_positionxy        name enddef ;
205vardef positionx        (expr name) = runscript mfid_positionx         name enddef ;
206vardef positiony        (expr name) = runscript mfid_positiony         name enddef ;
207vardef positionpar      (expr name) = runscript mfid_positionpar       name enddef ;
208vardef positionwhd      (expr name) = runscript mfid_positionwhd       name enddef ;
209vardef positionpage     (expr name) = runscript mfid_positionpage      name enddef ;
210vardef positioncolumn   (expr name) = runscript mfid_positioncolumn    name enddef ;
211vardef positionparagraph(expr name) = runscript mfid_positionparagraph name enddef ;
212vardef positionregion   (expr name) = runscript mfid_positionregion    name enddef ;
213vardef positionbox      (expr name) = runscript mfid_positionbox       name enddef ;
214vardef positionanchor               = runscript mfid_positionanchor         enddef ;
215
216vardef positioninregion =
217    currentpicture := currentpicture shifted - positionxy(positionanchor) ;
218enddef ;
219
220vardef positionatanchor(expr name) =
221    currentpicture := currentpicture shifted - positionxy(name) ;
222enddef ;
223
224permanent positionpath, positioncurve, positionxy, positionwhd,
225    positionpage, positionregion, positioncolumn, positionparagraph,
226    positionbox, positionanchor, positioninregion, positionatanchor ;
227
228let wdpart = redpart ;
229let htpart = greenpart ;
230let dppart = bluepart ;
231
232permanent wdpart, htpart, dppart;
233
234newscriptindex mfid_texvar ; mfid_texvar := scriptindex "texvar" ; vardef texvar(expr s) = runscript mfid_texvar s enddef ;
235newscriptindex mfid_texstr ; mfid_texstr := scriptindex "texstr" ; vardef texstr(expr s) = runscript mfid_texstr s enddef ;
236
237newscriptindex mfid_path_lengthof ; mfid_path_lengthof := scriptindex "pathlengthof" ;
238newscriptindex mfid_path_pointof  ; mfid_path_pointof  := scriptindex "pathpointof" ;
239newscriptindex mfid_path_leftof   ; mfid_path_leftof   := scriptindex "pathleftof" ;
240newscriptindex mfid_path_rightof  ; mfid_path_rightof  := scriptindex "pathrightof" ;
241newscriptindex mfid_path_reset    ; mfid_path_reset    := scriptindex "pathreset" ;
242
243% 25 pct gain
244
245   def inpath            = = 1 step 1 until runscript mfid_path_lengthof   enddef ;
246vardef pointof primary i =                  runscript mfid_path_pointof  i enddef ;
247vardef leftof  primary i =                  runscript mfid_path_leftof   i enddef ;
248vardef rightof primary i =                  runscript mfid_path_rightof  i enddef ;
249
250permanent inpath, pointof, leftof, rightof ;
251
252% another 10 pct gain
253
254% def inpath   = = 1 step 1 until runscript mfid_path_lengthof enddef ;
255% def pointof  =                  runscript mfid_path_pointof  enddef ;
256% def leftof   =                  runscript mfid_path_leftof   enddef ;
257% def rightof  =                  runscript mfid_path_rightof  enddef ;
258
259extra_endfig := extra_endfig & " runscript mfid_path_reset ; " ;
260
261newscriptindex mfid_utfnum ; mfid_utfnum := scriptindex "utfnum" ;
262newscriptindex mfid_utflen ; mfid_utflen := scriptindex "utflen" ;
263newscriptindex mfid_utfsub ; mfid_utfsub := scriptindex "utfsub" ;
264
265% def utfnum = runscript mfid_utfnum enddef ;
266% def utflen = runscript mfid_utflen enddef ;
267% def utfsub = runscript mfid_utfsub enddef ;
268
269vardef utfnum(expr s) = runscript mfid_utfnum s enddef ; % str
270vardef utflen(expr s) = runscript mfid_utflen s enddef ; % str
271vardef utfsub(text t) = runscript mfid_utfsub t enddef ; % str, first, (optional) last
272
273permanent utfnum, utflen, utfsub ;
274
275newscriptindex mfid_getparameters        ; mfid_getparameters        := scriptindex "getparameters" ;
276newscriptindex mfid_presetparameters     ; mfid_presetparameters     := scriptindex "presetparameters" ;
277newscriptindex mfid_hasparameter         ; mfid_hasparameter         := scriptindex "hasparameter" ;
278newscriptindex mfid_hasoption            ; mfid_hasoption            := scriptindex "hasoption" ;
279newscriptindex mfid_getparameter         ; mfid_getparameter         := scriptindex "getparameter" ;
280newscriptindex mfid_getparameterdefault  ; mfid_getparameterdefault  := scriptindex "getparameterdefault" ;
281newscriptindex mfid_getparametercount    ; mfid_getparametercount    := scriptindex "getparametercount" ;
282newscriptindex mfid_getmaxparametercount ; mfid_getmaxparametercount := scriptindex "getmaxparametercount" ;
283newscriptindex mfid_getparameterpath     ; mfid_getparameterpath     := scriptindex "getparameterpath" ;
284newscriptindex mfid_getparameterpen      ; mfid_getparameterpen      := scriptindex "getparameterpen" ;
285newscriptindex mfid_getparametertext     ; mfid_getparametertext     := scriptindex "getparametertext" ;
286%              mfid_getparameteroption   ; mfid_getparameteroption   := scriptindex "getparameteroption" ;
287newscriptindex mfid_applyparameters      ; mfid_applyparameters      := scriptindex "applyparameters" ;
288newscriptindex mfid_pushparameters       ; mfid_pushparameters       := scriptindex "pushparameters" ;
289newscriptindex mfid_popparameters        ; mfid_popparameters        := scriptindex "popparameters" ;
290newscriptindex mfid_setluaparameter      ; mfid_setluaparameter      := scriptindex "setluaparameter" ;
291
292def getparameters        = runscript mfid_getparameters        enddef ;
293def presetparameters     = runscript mfid_presetparameters     enddef ;
294def hasparameter         = runscript mfid_hasparameter         enddef ;
295def hasoption            = runscript mfid_hasoption            enddef ;
296def getparameter         = runscript mfid_getparameter         enddef ;
297def getparameterdefault  = runscript mfid_getparameterdefault  enddef ;
298def getparametercount    = runscript mfid_getparametercount    enddef ;
299def getmaxparametercount = runscript mfid_getmaxparametercount enddef ;
300def getparameterpath     = runscript mfid_getparameterpath     enddef ;
301def getparameterpen      = runscript mfid_getparameterpen      enddef ;
302def getparametertext     = runscript mfid_getparametertext     enddef ;
303%   getparameteroption   = runscript mfid_getparameteroption   enddef ;
304def applyparameters      = runscript mfid_applyparameters      enddef ;
305def pushparameters       = runscript mfid_pushparameters       enddef ;
306def popparameters        = runscript mfid_popparameters        enddef ;
307def setluaparameter      = runscript mfid_setluaparameter      enddef ;
308
309permanent getparameters, presetparameters, hasparameter, hasoption, getparameter, getparameterdefault,
310    getparametercount, getmaxparametercount, getparameterpath, getparameterpen, getparametertext, % getparameteroption,
311    applyparameters, pushparameters, popparameters, setluaparameter ;
312
313newscriptindex mfun_newrecord ; mfun_newrecord := scriptindex "newrecord" ;
314newscriptindex mfun_setrecord ; mfun_setrecord := scriptindex "setrecord" ;
315newscriptindex mfun_getrecord ; mfun_getrecord := scriptindex "getrecord" ;
316
317% let record = runscript ; % We need to use "let" because we don't expand!
318
319def record    = newinternal numeric runscript enddef ;
320
321def newrecord = runscript mfun_newrecord ; enddef ; % semicolon prevents lookahead
322def setrecord = runscript mfun_setrecord ; enddef ;
323def getrecord = runscript mfun_getrecord   enddef ;
324
325permanent
326    record, newrecord, setrecord, getrecord ;
327
328% No vardef's because we need to scan for an assignment too and we'll see
329% an endgroup otherwise.
330
331newscriptindex mfid_year   ; mfid_year   := scriptindex "year"   ; def year   = runscript mfid_year   enddef ;
332newscriptindex mfid_month  ; mfid_month  := scriptindex "month"  ; def month  = runscript mfid_month  enddef ;
333newscriptindex mfid_day    ; mfid_day    := scriptindex "day"    ; def day    = runscript mfid_day    enddef ;
334newscriptindex mfid_hour   ; mfid_hour   := scriptindex "hour"   ; def hour   = runscript mfid_hour   enddef ;
335newscriptindex mfid_minute ; mfid_minute := scriptindex "minute" ; def minute = runscript mfid_minute enddef ;
336newscriptindex mfid_second ; mfid_second := scriptindex "second" ; def second = runscript mfid_second enddef ;
337
338permanent year, month, day, hour, minute, second ; % overloaded
339
340% You cannot overload a local color bu using a prefix works ok:
341%
342% \definecolor [ name = "mp:myred", r = .9 ] ;
343
344newscriptindex mfid_definecolor ; mfid_definecolor := scriptindex "definecolor" ;
345
346def definecolor = runscript mfid_definecolor ; enddef ; % the semicolon prevents lookahead
347
348permanent definecolor ;
349
350% showproperty  fullcircle ;
351% showhashentry "fullcircle" ;
352
353newscriptindex mfid_showproperty  ; mfid_showproperty  := scriptindex("showproperty") ;
354newscriptindex mfid_showhashentry ; mfid_showhashentry := scriptindex("showhashentry") ;
355
356def showproperty  = runscript mfid_showproperty  enddef ;
357def showhashentry = runscript mfid_showhashentry enddef ;
358
359permanent showproperty, showhashentry ;
360
361newscriptindex mfid_textextanchor ; mfid_textextanchor := scriptindex("textextanchor") ;
362
363% def textextanchor = runscript mfid_textextanchor enddef ;
364
365vardef textextanchor(expr p) =
366    runscript mfid_textextanchor (prescriptpart p)
367enddef ;
368
369permanent textextanchor ;
370
371newscriptindex mfid_anchorxy   ; mfid_anchorxy   := scriptindex "anchorxy"   ;
372newscriptindex mfid_anchorx    ; mfid_anchorx    := scriptindex "anchorx"    ;
373newscriptindex mfid_anchory    ; mfid_anchory    := scriptindex "anchory"    ;
374newscriptindex mfid_anchorht   ; mfid_anchorht   := scriptindex "anchorht"   ;
375newscriptindex mfid_anchordp   ; mfid_anchordp   := scriptindex "anchordp"   ;
376newscriptindex mfid_anchorul   ; mfid_anchorul   := scriptindex "anchorul"   ;
377newscriptindex mfid_anchorll   ; mfid_anchorll   := scriptindex "anchorll"   ;
378newscriptindex mfid_anchorlr   ; mfid_anchorlr   := scriptindex "anchorlr"   ;
379newscriptindex mfid_anchorur   ; mfid_anchorur   := scriptindex "anchorur"   ;
380newscriptindex mfid_anchorbox  ; mfid_anchorbox  := scriptindex "anchorbox"  ;
381newscriptindex mfid_anchorspan ; mfid_anchorspan := scriptindex "anchorspan" ;
382
383def anchorxy (expr name, x, y) = runscript mfid_anchorxy  name x y enddef ;
384def anchorx  (expr name, x, y) = runscript mfid_anchorx   name x y enddef ;
385def anchory  (expr name, x, y) = runscript mfid_anchory   name x y enddef ;
386def anchorht (expr name, x, y) = runscript mfid_anchorht  name x y enddef ;
387def anchordp (expr name, x, y) = runscript mfid_anchordp  name x y enddef ;
388def anchorul (expr name, x, y) = runscript mfid_anchorul  name x y enddef ;
389def anchorll (expr name, x, y) = runscript mfid_anchorll  name x y enddef ;
390def anchorlr (expr name, x, y) = runscript mfid_anchorlr  name x y enddef ;
391def anchorur (expr name, x, y) = runscript mfid_anchorur  name x y enddef ;
392
393% todo: matrix =
394
395string mfun_local_anchor_tag ; mfun_local_anchor_tag := "matrix" ; % todo: push pop
396
397
398vardef localanchorbox (expr lname, fx, fy, rname, tx, ty) = (runscript mfid_anchorbox  lname fx fy rname tx ty) enddef ;
399vardef localanchorspan(expr lname, fx, fy, rname, tx, ty) = (runscript mfid_anchorspan lname fx fy rname tx ty) enddef ;
400vardef localanchorcell(expr  name,  x,  y               ) = (runscript mfid_anchorspan  name  x  y  name  x  y) enddef ;
401
402vardef anchorbox (expr fx, fy, tx, ty) = (runscript mfid_anchorbox  mfun_local_anchor_tag fx fy mfun_local_anchor_tag tx ty) enddef ;
403vardef anchorspan(expr fx, fy, tx, ty) = (runscript mfid_anchorspan mfun_local_anchor_tag fx fy mfun_local_anchor_tag tx ty) enddef ;
404vardef anchorcell(expr  x,  y        ) = (runscript mfid_anchorspan mfun_local_anchor_tag  x  y mfun_local_anchor_tag  x  y) enddef ;
405
406vardef matrixbox (expr fx, fy, tx, ty) = (runscript mfid_anchorbox  mfun_local_anchor_tag fx fy mfun_local_anchor_tag (tx+1) ty) enddef ;
407vardef matrixspan(expr fx, fy, tx, ty) = (runscript mfid_anchorspan mfun_local_anchor_tag fx fy mfun_local_anchor_tag (tx+1) ty) enddef ;
408vardef matrixcell(expr  x,  y        ) = (runscript mfid_anchorbox  mfun_local_anchor_tag  x  y mfun_local_anchor_tag ( x+1)  y) enddef ;
409
410permanent
411    anchorxy, anchorx, anchory,
412    anchorht, anchordp,
413    anchorul, anchorll, anchorlr, anchorur, anchorbox,
414    anchorspan ;
415
416permanent
417    matrixbox, matrixspan, matrixcell
418