%D \module %D [ file=mp-luas.mpiv, %D version=2014.04.14, %D title=\CONTEXT\ \METAPOST\ graphics, %D subtitle=\LUA, %D author=Hans Hagen, %D date=\currentdate, %D copyright={PRAGMA ADE \& \CONTEXT\ Development Team}] %C %C This module is part of the \CONTEXT\ macro||package and is %C therefore copyrighted by \PRAGMA. See mreadme.pdf for %C details. if known metafun_loaded_luas : endinput ; fi ; % When I prototyped the runscript primitive I was just thinking of a usage like % the original \directlua primitive in luatex: genererate something and pipe % that back to metapost, and have access to some internals. Instead of compiling % the code a the metapost end here we delegate that to the lua end. Only strings % get passed. Of course in the end the real usage got a bit beyong the intended % usage. So, in addition to some definitions here there are and will be use in % other metafun modules too. Of course in retrospect I should have done this five % years earlier. newinternal boolean metafun_loaded_luas ; metafun_loaded_luas := true ; immutable metafun_loaded_luas ; def newscriptindex suffix t = newinternal t ; immutable t ; enddef ; newscriptindex mfid_scriptindex ; mfid_scriptindex := runscript("mp.mf_script_index('scriptindex')") ; def scriptindex = runscript mfid_scriptindex enddef ; string mfun_lua_bs ; mfun_lua_bs := "[===[" ; string mfun_lua_es ; mfun_lua_es := "]===]" ; vardef mlib_luas_luacall(text t) = runscript("" for s = t : if string s : & s % & mfun_lua_bs & s & mfun_lua_es elseif numeric s : & decimal s elseif boolean s : & if s : "true" else : "false" fi elseif pair s : & mfun_pair_to_table(s) elseif path s : & mfun_path_to_table(s) elseif rgbcolor s : & mfun_rgb_to_table(s) elseif cmykcolor s : & mfun_cmyk_to_table(s) else : & ditto & tostring(s) & ditto fi endfor ) enddef ; newinternal mfun_luas_b ; def mlib_luas_luadone = exitif numeric begingroup mfun_luas_b := 1 ; endgroup ; enddef ; vardef mlib_luas_lualist(expr c)(text t) = % we could use mlib_luas_s instead of c interim mfun_luas_b := 0 ; runscript(c & for s = t : if mfun_luas_b = 0 : "(" % hide(mfun_luas_b := 1) mlib_luas_luadone else : "," fi & if string s : mfun_lua_bs & s & mfun_lua_es elseif numeric s : decimal s elseif boolean s : if s : "true" else : "false" fi elseif pair s : mfun_pair_to_table(s) elseif path s : mfun_path_to_table(s) elseif rgbcolor s : mfun_rgb_to_table(s) elseif cmykcolor s : mfun_cmyk_to_table(s) else : ditto & tostring(s) & ditto fi & endfor if mfun_luas_b = 0 : "()" else : ")" fi ) enddef ; def luacall = mlib_luas_luacall enddef ; % why no let vardef lualist@#(text t) = mlib_luas_lualist(str @#)(t) enddef ; string mlib_luas_s ; % saves save/restore vardef lua@#(text t) = mlib_luas_s := str @# ; if length(mlib_luas_s) > 0 : mlib_luas_lualist(mlib_luas_s,t) else : mlib_luas_luacall(t) fi enddef ; vardef MP@#(text t) = mlib_luas_lualist("MP." & str @#,t) enddef ; % todo: runner newscriptindex mfun_message ; mfun_message := scriptindex("message") ; def message text t = runscript mfun_message tostring(t) ; % todo: scananything enddef ; permanent newscriptindex, scriptindex, luacall, lua, lualist, mp, MP ; % Color: % We do a low level runscript: % % lua.mp.namedcolor(s) % conflicts with macro namedcolor % lua.mp.mf_named_color(s) % okay but, can also be % lua.mp("mf_named_color",s) % which gives expansion mess newscriptindex mfid_resolvedcolor ; mfid_resolvedcolor := scriptindex "namedcolor" ; def resolvedcolor = runscript mfid_resolvedcolor enddef ; permanent resolvedcolor ; % Modes: newscriptindex mfid_mode ; mfid_mode := scriptindex "mode" ; newscriptindex mfid_systemmode ; mfid_systemmode := scriptindex "systemmode" ; vardef texmode (expr s) = runscript mfid_mode s enddef ; vardef systemmode (expr s) = runscript mfid_systemmode s enddef ; % let processingmode = systemmode ; permanent texmode, systemmode ; % A few helpers newscriptindex mfid_isarray ; mfid_isarray := scriptindex "isarray" ; newscriptindex mfid_prefix ; mfid_prefix := scriptindex "prefix" ; newscriptindex mfid_dimension ; mfid_dimension := scriptindex "dimension" ; newscriptindex mfid_isobject ; mfid_isobject := scriptindex "isobject" ; vardef isarray suffix a = runscript mfid_isarray (str a) enddef ; vardef prefix suffix a = runscript mfid_prefix (str a) enddef ; vardef dimension suffix a = runscript mfid_dimension(str a) enddef ; vardef isobject expr p = if picture p : runscript mfid_isobject prescriptpart p else : false fi enddef ; permanent isarray, prefix, dimension, isobject ; % More access newscriptindex mfid_getmacro ; mfid_getmacro := scriptindex "getmacro" ; def getmacro = runscript mfid_getmacro enddef ; newscriptindex mfid_getdimen ; mfid_getdimen := scriptindex "getdimen" ; def getdimen = runscript mfid_getdimen enddef ; newscriptindex mfid_getcount ; mfid_getcount := scriptindex "getcount" ; def getcount = runscript mfid_getcount enddef ; newscriptindex mfid_gettoks ; mfid_gettoks := scriptindex "gettoks" ; def gettoks = runscript mfid_gettoks enddef ; % todo: figure out a mixed interface: setdimen "foo" 123pt ; setdimen("foo", 123pt) ; newscriptindex mfid_setmacro ; mfid_setmacro := scriptindex "setmacro" ; def setmacro(expr k, v) = runscript mfid_setmacro k v ; enddef ; newscriptindex mfid_setdimen ; mfid_setdimen := scriptindex "setdimen" ; def setdimen(expr k, v) = runscript mfid_setdimen k v ; enddef ; newscriptindex mfid_setcount ; mfid_setcount := scriptindex "setcount" ; def setcount(expr k, v) = runscript mfid_setcount k v ; enddef ; newscriptindex mfid_settoks ; mfid_settoks := scriptindex "settoks" ; def settoks (expr k, v) = runscript mfid_settoks k v ; enddef ; newscriptindex mfid_setglobalmacro ; mfid_setglobalmacro := scriptindex "setglobalmacro" ; def setglobalmacro(expr k, v) = runscript mfid_setglobalmacro k v ; enddef ; newscriptindex mfid_setglobaldimen ; mfid_setglobaldimen := scriptindex "setglobaldimen" ; def setglobaldimen(expr k, v) = runscript mfid_setglobaldimen k v ; enddef ; newscriptindex mfid_setglobalcount ; mfid_setglobalcount := scriptindex "setglobalcount" ; def setglobalcount(expr k, v) = runscript mfid_setglobalcount k v ; enddef ; newscriptindex mfid_setglobaltoks ; mfid_setglobaltoks := scriptindex "setglobaltoks" ; def setglobaltoks (expr k, v) = runscript mfid_setglobaltoks k v ; enddef ; permanent getmacro, getdimen, getcount, gettoks, setmacro, setdimen, setcount, settoks, setglobalmacro, setglobaldimen, setglobalcount, setglobaltoks ; newscriptindex mfid_positionpath ; mfid_positionpath := scriptindex("positionpath") ; newscriptindex mfid_positioncurve ; mfid_positioncurve := scriptindex("positioncurve") ; newscriptindex mfid_positionxy ; mfid_positionxy := scriptindex("positionxy") ; newscriptindex mfid_positionx ; mfid_positionx := scriptindex("positionx") ; newscriptindex mfid_positiony ; mfid_positiony := scriptindex("positiony") ; newscriptindex mfid_positionposition ; mfid_positionparagraph := scriptindex("positionparagraph") ; newscriptindex mfid_positionwhd ; mfid_positionwhd := scriptindex("positionwhd") ; newscriptindex mfid_positionpage ; mfid_positionpage := scriptindex("positionpage") ; newscriptindex mfid_positioncolumn ; mfid_positioncolumn := scriptindex("positioncolumn") ; newscriptindex mfid_positionregion ; mfid_positionregion := scriptindex("positionregion") ; newscriptindex mfid_positionbox ; mfid_positionbox := scriptindex("positionbox") ; newscriptindex mfid_positionanchor ; mfid_positionanchor := scriptindex("positionanchor") ; newscriptindex mfid_positioncolumnfromx ; mfid_positioncolumnfromx := scriptindex("positioncolumnfromx") ; newscriptindex mfid_positioncolumnbox ; mfid_positioncolumnbox := scriptindex("positioncolumnbox") ; newscriptindex mfid_overlaycolumnbox ; mfid_overlaycolumnbox := scriptindex("overlaycolumnbox") ; vardef positionpath (expr name) = runscript mfid_positionpath (name) enddef ; vardef positioncurve (expr name) = runscript mfid_positioncurve (name) enddef ; vardef positionxy (expr name) = runscript mfid_positionxy (name) enddef ; vardef positionx (expr name) = runscript mfid_positionx (name) enddef ; vardef positiony (expr name) = runscript mfid_positiony (name) enddef ; vardef positionwhd (expr name) = runscript mfid_positionwhd (name) enddef ; vardef positionpage (expr name) = runscript mfid_positionpage (name) enddef ; vardef positioncolumn (expr name) = runscript mfid_positioncolumn (name) enddef ; vardef positionparagraph(expr name) = runscript mfid_positionparagraph(name) enddef ; vardef positionpar (expr name) = runscript mfid_positionparagraph(name) enddef ; vardef positionregion (expr name) = runscript mfid_positionregion (name) enddef ; vardef positionbox (expr name) = runscript mfid_positionbox (name) enddef ; vardef positionanchor = runscript mfid_positionanchor enddef ; vardef positioncolumnatx(expr name) = runscript mfid_positioncolumnatx(name) enddef ; vardef positioncolumnbox(expr column) = runscript mfid_positioncolumnbox(column) enddef ; vardef overlaycolumnbox (expr column) = runscript mfid_overlaycolumnbox (column) enddef ; vardef positioninregion = currentpicture := currentpicture shifted - positionxy(positionanchor) ; enddef ; vardef positionatanchor(expr name) = currentpicture := currentpicture shifted - positionxy(name) ; enddef ; permanent positionpath, positioncurve, positionxy, positionwhd, positionpage, positionregion, positioncolumn, positionparagraph, positionpar, positionbox, positionanchor, positioninregion, positionatanchor, positioncolumnatx, positioncolumnbox, overlaycolumnbox ; let wdpart = redpart ; let htpart = greenpart ; let dppart = bluepart ; permanent wdpart, htpart, dppart; newscriptindex mfid_sortedpath ; mfid_sortedpath := scriptindex "sortedpath" ; newscriptindex mfid_uniquepath ; mfid_uniquepath := scriptindex "uniquepath" ; def sortedpath = runscript mfid_sortedpath enddef ; def uniquepath = runscript mfid_uniquepath enddef ; permanent sortedpath, uniquepath ; newscriptindex mfid_texvar ; mfid_texvar := scriptindex "texvar" ; vardef texvar(expr s) = runscript mfid_texvar s enddef ; newscriptindex mfid_texstr ; mfid_texstr := scriptindex "texstr" ; vardef texstr(expr s) = runscript mfid_texstr s enddef ; newscriptindex mfid_path_lengthof ; mfid_path_lengthof := scriptindex "pathlengthof" ; newscriptindex mfid_path_pointof ; mfid_path_pointof := scriptindex "pathpointof" ; newscriptindex mfid_path_leftof ; mfid_path_leftof := scriptindex "pathleftof" ; newscriptindex mfid_path_rightof ; mfid_path_rightof := scriptindex "pathrightof" ; newscriptindex mfid_path_reset ; mfid_path_reset := scriptindex "pathreset" ; % 25 pct gain def inpath = = 1 step 1 until runscript mfid_path_lengthof enddef ; vardef pointof primary i = runscript mfid_path_pointof i enddef ; vardef leftof primary i = runscript mfid_path_leftof i enddef ; vardef rightof primary i = runscript mfid_path_rightof i enddef ; permanent inpath, pointof, leftof, rightof ; % another 10 pct gain % def inpath = = 1 step 1 until runscript mfid_path_lengthof enddef ; % def pointof = runscript mfid_path_pointof enddef ; % def leftof = runscript mfid_path_leftof enddef ; % def rightof = runscript mfid_path_rightof enddef ; extra_endfig := extra_endfig & " runscript mfid_path_reset ; " ; newscriptindex mfid_utfchr ; mfid_utfchr := scriptindex "utfchr" ; newscriptindex mfid_utfnum ; mfid_utfnum := scriptindex "utfnum" ; newscriptindex mfid_utflen ; mfid_utflen := scriptindex "utflen" ; newscriptindex mfid_utfsub ; mfid_utfsub := scriptindex "utfsub" ; % def utfnum = runscript mfid_utfnum enddef ; % def utflen = runscript mfid_utflen enddef ; % def utfsub = runscript mfid_utfsub enddef ; vardef utfchr(expr s) = runscript mfid_utfchr s enddef ; % number vardef utfnum(expr s) = runscript mfid_utfnum s enddef ; % str vardef utflen(expr s) = runscript mfid_utflen s enddef ; % str vardef utfsub(text t) = runscript mfid_utfsub t enddef ; % str, first, (optional) last permanent utfchr, utfnum, utflen, utfsub ; newscriptindex mfid_getparameters ; mfid_getparameters := scriptindex "getparameters" ; newscriptindex mfid_setparameters ; mfid_setparameters := scriptindex "setparameters" ; newscriptindex mfid_presetparameters ; mfid_presetparameters := scriptindex "presetparameters" ; newscriptindex mfid_hasparameter ; mfid_hasparameter := scriptindex "hasparameter" ; newscriptindex mfid_hasoption ; mfid_hasoption := scriptindex "hasoption" ; newscriptindex mfid_getparameter ; mfid_getparameter := scriptindex "getparameter" ; newscriptindex mfid_getparameterdefault ; mfid_getparameterdefault := scriptindex "getparameterdefault" ; newscriptindex mfid_getparametercount ; mfid_getparametercount := scriptindex "getparametercount" ; newscriptindex mfid_getmaxparametercount ; mfid_getmaxparametercount := scriptindex "getmaxparametercount" ; newscriptindex mfid_getparameterpath ; mfid_getparameterpath := scriptindex "getparameterpath" ; newscriptindex mfid_getparameterpen ; mfid_getparameterpen := scriptindex "getparameterpen" ; newscriptindex mfid_getparametertext ; mfid_getparametertext := scriptindex "getparametertext" ; % mfid_getparameteroption ; mfid_getparameteroption := scriptindex "getparameteroption" ; newscriptindex mfid_applyparameters ; mfid_applyparameters := scriptindex "applyparameters" ; newscriptindex mfid_mergeparameters ; mfid_mergeparameters := scriptindex "mergeparameters" ; newscriptindex mfid_pushparameters ; mfid_pushparameters := scriptindex "pushparameters" ; newscriptindex mfid_popparameters ; mfid_popparameters := scriptindex "popparameters" ; newscriptindex mfid_setluaparameter ; mfid_setluaparameter := scriptindex "setluaparameter" ; def getparameters = runscript mfid_getparameters enddef ; def presetparameters = runscript mfid_presetparameters enddef ; def setparameters = runscript mfid_setparameters enddef ; def hasparameter = runscript mfid_hasparameter enddef ; def hasoption = runscript mfid_hasoption enddef ; def getparameter = runscript mfid_getparameter enddef ; def getparameterdefault = runscript mfid_getparameterdefault enddef ; def getparametercount = runscript mfid_getparametercount enddef ; def getmaxparametercount = runscript mfid_getmaxparametercount enddef ; def getparameterpath = runscript mfid_getparameterpath enddef ; def getparameterpen = runscript mfid_getparameterpen enddef ; def getparametertext = runscript mfid_getparametertext enddef ; % getparameteroption = runscript mfid_getparameteroption enddef ; def applyparameters = runscript mfid_applyparameters enddef ; def mergeparameters = runscript mfid_mergeparameters enddef ; def pushparameters = runscript mfid_pushparameters enddef ; def popparameters = runscript mfid_popparameters enddef ; def setluaparameter = runscript mfid_setluaparameter enddef ; permanent getparameters, presetparameters, setparameters, hasparameter, hasoption, getparameter, getparameterdefault, getparametercount, getmaxparametercount, getparameterpath, getparameterpen, getparametertext, % getparameteroption, applyparameters, mergeparameters, pushparameters, popparameters, setluaparameter ; newscriptindex mfun_newrecord ; mfun_newrecord := scriptindex "newrecord" ; newscriptindex mfun_setrecord ; mfun_setrecord := scriptindex "setrecord" ; newscriptindex mfun_getrecord ; mfun_getrecord := scriptindex "getrecord" ; newscriptindex mfun_cntrecord ; mfun_cntrecord := scriptindex "cntrecord" ; % let record = runscript ; % We need to use "let" because we don't expand! def record = newinternal numeric runscript enddef ; def newrecord = runscript mfun_newrecord ; enddef ; % semicolon prevents lookahead def setrecord = runscript mfun_setrecord ; enddef ; def getrecord = runscript mfun_getrecord enddef ; def cntrecord = runscript mfun_cntrecord enddef ; permanent record, newrecord, setrecord, getrecord, cntrecord ; % No vardef's because we need to scan for an assignment too and we'll see % an endgroup otherwise. newscriptindex mfid_year ; mfid_year := scriptindex "year" ; def year = runscript mfid_year enddef ; newscriptindex mfid_month ; mfid_month := scriptindex "month" ; def month = runscript mfid_month enddef ; newscriptindex mfid_day ; mfid_day := scriptindex "day" ; def day = runscript mfid_day enddef ; newscriptindex mfid_hour ; mfid_hour := scriptindex "hour" ; def hour = runscript mfid_hour enddef ; newscriptindex mfid_minute ; mfid_minute := scriptindex "minute" ; def minute = runscript mfid_minute enddef ; newscriptindex mfid_second ; mfid_second := scriptindex "second" ; def second = runscript mfid_second enddef ; permanent year, month, day, hour, minute, second ; % overloaded % You cannot overload a local color bu using a prefix works ok: % % \definecolor [ name = "mp:myred", r = .9 ] ; newscriptindex mfid_definecolor ; mfid_definecolor := scriptindex "definecolor" ; def definecolor = runscript mfid_definecolor ; enddef ; % the semicolon prevents lookahead permanent definecolor ; % showproperty fullcircle ; % showhashentry "fullcircle" ; newscriptindex mfid_showproperty ; mfid_showproperty := scriptindex("showproperty") ; newscriptindex mfid_showhashentry ; mfid_showhashentry := scriptindex("showhashentry") ; def showproperty = runscript mfid_showproperty enddef ; def showhashentry = runscript mfid_showhashentry enddef ; permanent showproperty, showhashentry ; newscriptindex mfid_textextanchor ; mfid_textextanchor := scriptindex("textextanchor") ; % def textextanchor = runscript mfid_textextanchor enddef ; vardef textextanchor(expr p) = runscript mfid_textextanchor (prescriptpart p) enddef ; permanent textextanchor ; newscriptindex mfid_anchorxy ; mfid_anchorxy := scriptindex "anchorxy" ; newscriptindex mfid_anchorx ; mfid_anchorx := scriptindex "anchorx" ; newscriptindex mfid_anchory ; mfid_anchory := scriptindex "anchory" ; newscriptindex mfid_anchorht ; mfid_anchorht := scriptindex "anchorht" ; newscriptindex mfid_anchordp ; mfid_anchordp := scriptindex "anchordp" ; newscriptindex mfid_anchorul ; mfid_anchorul := scriptindex "anchorul" ; newscriptindex mfid_anchorll ; mfid_anchorll := scriptindex "anchorll" ; newscriptindex mfid_anchorlr ; mfid_anchorlr := scriptindex "anchorlr" ; newscriptindex mfid_anchorur ; mfid_anchorur := scriptindex "anchorur" ; newscriptindex mfid_anchorbox ; mfid_anchorbox := scriptindex "anchorbox" ; newscriptindex mfid_anchorspan ; mfid_anchorspan := scriptindex "anchorspan" ; def anchorxy (expr name, x, y) = runscript mfid_anchorxy name x y enddef ; def anchorx (expr name, x, y) = runscript mfid_anchorx name x y enddef ; def anchory (expr name, x, y) = runscript mfid_anchory name x y enddef ; def anchorht (expr name, x, y) = runscript mfid_anchorht name x y enddef ; def anchordp (expr name, x, y) = runscript mfid_anchordp name x y enddef ; def anchorul (expr name, x, y) = runscript mfid_anchorul name x y enddef ; def anchorll (expr name, x, y) = runscript mfid_anchorll name x y enddef ; def anchorlr (expr name, x, y) = runscript mfid_anchorlr name x y enddef ; def anchorur (expr name, x, y) = runscript mfid_anchorur name x y enddef ; % todo: matrix = string mfun_local_anchor_tag ; mfun_local_anchor_tag := "matrix" ; % todo: push pop vardef localanchorbox (expr lname, fx, fy, rname, tx, ty) = (runscript mfid_anchorbox lname fx fy rname tx ty) enddef ; vardef localanchorspan(expr lname, fx, fy, rname, tx, ty) = (runscript mfid_anchorspan lname fx fy rname tx ty) enddef ; vardef localanchorcell(expr name, x, y ) = (runscript mfid_anchorspan name x y name x y) enddef ; vardef anchorbox (expr fx, fy, tx, ty) = (runscript mfid_anchorbox mfun_local_anchor_tag fx fy mfun_local_anchor_tag tx ty) enddef ; vardef anchorspan(expr fx, fy, tx, ty) = (runscript mfid_anchorspan mfun_local_anchor_tag fx fy mfun_local_anchor_tag tx ty) enddef ; vardef anchorcell(expr x, y ) = (runscript mfid_anchorspan mfun_local_anchor_tag x y mfun_local_anchor_tag x y) enddef ; vardef matrixbox (expr fx, fy, tx, ty) = (runscript mfid_anchorbox mfun_local_anchor_tag fx fy mfun_local_anchor_tag (tx+1) ty) enddef ; vardef matrixspan(expr fx, fy, tx, ty) = (runscript mfid_anchorspan mfun_local_anchor_tag fx fy mfun_local_anchor_tag (tx+1) ty) enddef ; vardef matrixcell(expr x, y ) = (runscript mfid_anchorbox mfun_local_anchor_tag x y mfun_local_anchor_tag ( x+1) y) enddef ; permanent anchorxy, anchorx, anchory, anchorht, anchordp, anchorul, anchorll, anchorlr, anchorur, anchorbox, anchorspan ; permanent matrixbox, matrixspan, matrixcell