path: root/metapost/context/base/mpxl/mp-luas.mpxl

%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_positionpar    ; mfid_positionpar    := scriptindex("positionpar") ;
newscriptindex mfid_positionwhd    ; mfid_positionwhd    := scriptindex("positionwhd") ;
newscriptindex mfid_positionpage   ; mfid_positionpage   := scriptindex("positionpage") ;
newscriptindex mfid_positionregion ; mfid_positionregion := scriptindex("positionregion") ;
newscriptindex mfid_positionbox    ; mfid_positionbox    := scriptindex("positionbox") ;
newscriptindex mfid_positionanchor ; mfid_positionanchor := scriptindex("positionanchor") ;

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 positionpar      (expr name) = runscript mfid_positionpar       (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 positionregion   (expr name) = runscript mfid_positionregion    (name) enddef ;
vardef positionbox      (expr name) = runscript mfid_positionbox       (name) enddef ;
vardef positionanchor               = runscript mfid_positionanchor           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,
    positionbox, positionanchor, positioninregion, positionatanchor ;

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 sortpath, 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_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 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 utfnum, utflen, utfsub ;

newscriptindex mfid_getparameters        ; mfid_getparameters        := scriptindex "getparameters" ;
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_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 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 pushparameters       = runscript mfid_pushparameters       enddef ;
def popparameters        = runscript mfid_popparameters        enddef ;
def setluaparameter      = runscript mfid_setluaparameter      enddef ;

permanent getparameters, presetparameters, hasparameter, hasoption, getparameter, getparameterdefault,
    getparametercount, getmaxparametercount, getparameterpath, getparameterpen, getparametertext, % getparameteroption,
    applyparameters, 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