diff options
| author | Karl Berry <karl@freefriends.org> | 2021-03-06 21:58:15 +0000 |
|---|---|---|
| committer | Karl Berry <karl@freefriends.org> | 2021-03-06 21:58:15 +0000 |
| commit | 974640d66e61e81cb197ad96fdff7b08343e4c5a (patch) | |
| tree | 2e1f75f32f312b7f24ba82b4590ae230bcd6f399 /Master/texmf-dist/metapost | |
| parent | b4fa72e61230aca75f7f6fbf988821f71edfb6b2 (diff) | |
context
git-svn-id: svn://tug.org/texlive/trunk@58167 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/texmf-dist/metapost')
42 files changed, 10157 insertions, 2668 deletions
diff --git a/Master/texmf-dist/metapost/context/base/mpii/mp-tool.mpii b/Master/texmf-dist/metapost/context/base/mpii/mp-tool.mpii index de8e1e8e2fd..27c90de389a 100644 --- a/Master/texmf-dist/metapost/context/base/mpii/mp-tool.mpii +++ b/Master/texmf-dist/metapost/context/base/mpii/mp-tool.mpii @@ -1841,7 +1841,9 @@ enddef ; primarydef p enlonged len = begingroup - if pair p : + if len == 0 : + p + elseif pair p : save q ; path q ; q := origin -- p ; save al ; al := arclength(q) ; if al > 0 : @@ -1864,8 +1866,12 @@ enddef ; % drawarrow p withcolor red ; % drawarrow p shortened 1cm withcolor green ; +% primarydef p shortened d = +% reverse ( ( reverse (p enlonged -d) ) enlonged -d ) +% enddef ; + primarydef p shortened d = - reverse ( ( reverse (p enlonged -d) ) enlonged -d ) + reverse ( ( reverse (p enlonged -xpart paired(d)) ) enlonged -ypart paired(d) ) enddef ; % yes or no, untested -) diff --git a/Master/texmf-dist/metapost/context/base/mpiv/metafun.mpxl b/Master/texmf-dist/metapost/context/base/mpiv/metafun.mpxl deleted file mode 100644 index a6160ef3e2c..00000000000 --- a/Master/texmf-dist/metapost/context/base/mpiv/metafun.mpxl +++ /dev/null @@ -1,46 +0,0 @@ -%D \module -%D [ file=metafun.mp, -%D version=2000.07.15, -%D title=\CONTEXT\ \METAPOST\ graphics, -%D subtitle=format generation file, -%D author=Hans Hagen, -%D date=\currentdate, -%D copyright={PRAGMA / Hans Hagen \& Ton Otten}] -%C -%C This module is part of the \CONTEXT\ macro||package and is -%C therefore copyrighted by \PRAGMA. See mreadme.pdf for -%C details. - -%D First we input John Hobby's metapost plain file. However, because we want to -%D prevent dependency problems and in the end even may use a patched version, -%D we prefer to use a copy. - -boolean contextlmtxmode ; contextlmtxmode := if known fontmaking : false else: true fi; - -input "mp-base.mpiv" ; -input "mp-tool.mpiv" ; -input "mp-mlib.mpiv" ; -input "mp-luas.mpxl" ; -input "mp-math.mpxl" ; -input "mp-cont.mpxl" ; -input "mp-page.mpxl" ; -input "mp-butt.mpiv" ; -input "mp-shap.mpiv" ; -input "mp-grph.mpiv" ; -input "mp-grid.mpiv" ; -input "mp-form.mpiv" ; -input "mp-figs.mpiv" ; -input "mp-func.mpiv" ; -input "mp-node.mpiv" ; -input "mp-apos.mpiv" ; -input "mp-abck.mpiv" ; -input "mp-blob.mpiv" ; - -input "mp-lmtx.mpxl" ; % playground, not official - -string metafunversion ; metafunversion = "metafun xl " & mfun_timestamp; - -let normalend = end ; - -def end = ; message "" ; message metafunversion ; message "" ; endinput ; enddef ; -def bye = ; message "" ; message metafunversion ; message "" ; endinput ; enddef ; diff --git a/Master/texmf-dist/metapost/context/base/mpiv/mp-back.mpiv b/Master/texmf-dist/metapost/context/base/mpiv/mp-back.mpiv index f588adea9c4..e77b3f0d9c3 100644 --- a/Master/texmf-dist/metapost/context/base/mpiv/mp-back.mpiv +++ b/Master/texmf-dist/metapost/context/base/mpiv/mp-back.mpiv @@ -22,14 +22,15 @@ def some_hash ( expr hash_width , hash_angle , hash_gap ) = - stripe_gap := hash_gap ; - stripe_angle := hash_angle ; - drawoptions (withpen pencircle scaled hash_linewidth - withcolor hash_linecolor) ; - path p ; p := unitsquare xscaled hash_width yscaled hash_height ; - stripe_path_a () (draw) p ; % next we move it all to quadrant 1 - currentpicture := currentpicture shifted urcorner currentpicture ; - + begingroup ; + stripe_gap := hash_gap ; + stripe_angle := hash_angle ; + drawoptions (withpen pencircle scaled hash_linewidth + withcolor hash_linecolor) ; + path p ; p := unitsquare xscaled hash_width yscaled hash_height ; + stripe_path_a () (draw) p ; % next we move it all to quadrant 1 + currentpicture := currentpicture shifted urcorner currentpicture ; + endgroup ; enddef ; def some_double_back (expr back_type , @@ -44,162 +45,167 @@ def some_double_back (expr back_type , back_leftcolor , back_rightcolor ) = - numeric ww ; ww := back_width ; - numeric hh ; hh := back_height ; - numeric dd ; dd := back_delta ; - - color back_nillcolor ; back_nillcolor := back_topcolor ; - - path p ; p := fullsquare xscaled ww yscaled hh ; - path q ; q := fullsquare xscaled (ww-2dd) yscaled (hh-2dd) ; - path r ; r := llcorner p -- - lrcorner p shifted (-3dd,0) .. controls lrcorner p .. - lrcorner p shifted (0, 3dd) -- - urcorner p shifted (0,-3dd) .. controls urcorner p .. - urcorner p shifted (-3dd,0) -- - ulcorner p -- cycle ; - path s ; s := r xscaled ((ww-2dd)/ww) yscaled ((hh-2dd)/hh) ; - path t ; t := llcorner p -- - lrcorner p -- - urcorner p shifted (0,-3dd) .. controls urcorner p .. - urcorner p shifted (-3dd,0) -- - ulcorner p shifted ( 3dd,0) .. controls ulcorner p .. - ulcorner p shifted (0,-3dd) -- - llcorner p -- cycle ; - path u ; u := t xscaled ((ww-2dd)/ww) yscaled ((hh-2dd)/hh) ; - path v ; v := llcorner p shifted ( 3dd,0) -- - lrcorner p shifted (-3dd,0) .. controls lrcorner p .. - lrcorner p shifted (0, 3dd) -- - urcorner p shifted (0,-3dd) .. controls urcorner p .. - urcorner p shifted (-3dd,0) -- - ulcorner p shifted ( 3dd,0) .. controls ulcorner p .. - ulcorner p shifted (0,-3dd) .. - llcorner p shifted (0, 3dd) .. controls llcorner p .. cycle ; % {down} .. cycle ; - path w ; w := t xscaled ((ww-2dd)/ww) yscaled ((hh-2dd)/hh) ; - path a ; a := llcorner p -- ulcorner p -- - ulcorner q -- llcorner q -- cycle ; - path b ; b := llcorner p -- lrcorner p -- - lrcorner q -- llcorner q -- cycle ; - path c ; c := lrcorner p -- urcorner p -- - urcorner q -- lrcorner q -- cycle ; - path d ; d := ulcorner p -- urcorner p -- - urcorner q -- ulcorner q -- cycle ; - path e ; e := llcorner p -- lrcorner p -- - urcorner p -- urcorner q -- - lrcorner q -- llcorner q -- cycle ; - path f ; f := llcorner p -- ulcorner p -- - urcorner p -- urcorner q -- - ulcorner q -- llcorner q -- cycle ; - - linecap := butt ; pickup pencircle scaled back_linewidth ; - - if back_type=1 : - - fill p withcolor back_fillcolor ; - fill a withcolor back_leftcolor ; - fill b withcolor back_bottomcolor ; - fill c withcolor back_rightcolor ; - fill d withcolor back_topcolor ; - draw a withcolor back_linecolor ; - draw d withcolor back_linecolor ; - draw b withcolor back_linecolor ; - draw c withcolor back_linecolor ; - - elseif back_type=2 : - - fill p withcolor back_fillcolor ; - fill e withcolor back_bottomcolor ; - fill f withcolor back_topcolor ; - draw e withcolor back_linecolor ; - draw f withcolor back_linecolor ; - - elseif back_type=3 : - - fill v withcolor back_nillcolor ; - fill w withcolor back_fillcolor ; - draw v withcolor back_linecolor ; - draw w withcolor back_linecolor ; - - elseif back_type=4 : - - fill t withcolor back_nillcolor ; - fill u withcolor back_fillcolor ; - draw t withcolor back_linecolor ; - draw u withcolor back_linecolor ; - - elseif back_type=5 : - - t := t rotatedaround(center t,180) ; - u := u rotatedaround(center u,180) ; - - fill t withcolor back_nillcolor ; - fill u withcolor back_fillcolor ; - draw t withcolor back_linecolor ; - draw u withcolor back_linecolor ; - - elseif back_type=6 : - - r := r rotatedaround(center r,180) ; - s := s rotatedaround(center s,180) ; - - fill r withcolor back_nillcolor ; - fill s withcolor back_fillcolor ; - draw r withcolor back_linecolor ; - draw s withcolor back_linecolor ; - - elseif back_type=7 : - - fill r withcolor back_nillcolor ; - fill s withcolor back_fillcolor ; - draw r withcolor back_linecolor ; - draw s withcolor back_linecolor ; - -fi ; - + begingroup ; + + save ww, hh, dd, p, q, r, s, t, u, v, w, a, c, d, e, f, back_nillcolor ; + + numeric ww ; ww := back_width ; + numeric hh ; hh := back_height ; + numeric dd ; dd := back_delta ; + + color back_nillcolor ; back_nillcolor := back_topcolor ; + + path p ; p := fullsquare xscaled ww yscaled hh ; + path q ; q := fullsquare xscaled (ww-2dd) yscaled (hh-2dd) ; + path r ; r := llcorner p -- + lrcorner p shifted (-3dd,0) .. controls lrcorner p .. + lrcorner p shifted (0, 3dd) -- + urcorner p shifted (0,-3dd) .. controls urcorner p .. + urcorner p shifted (-3dd,0) -- + ulcorner p -- cycle ; + path s ; s := r xscaled ((ww-2dd)/ww) yscaled ((hh-2dd)/hh) ; + path t ; t := llcorner p -- + lrcorner p -- + urcorner p shifted (0,-3dd) .. controls urcorner p .. + urcorner p shifted (-3dd,0) -- + ulcorner p shifted ( 3dd,0) .. controls ulcorner p .. + ulcorner p shifted (0,-3dd) -- + llcorner p -- cycle ; + path u ; u := t xscaled ((ww-2dd)/ww) yscaled ((hh-2dd)/hh) ; + path v ; v := llcorner p shifted ( 3dd,0) -- + lrcorner p shifted (-3dd,0) .. controls lrcorner p .. + lrcorner p shifted (0, 3dd) -- + urcorner p shifted (0,-3dd) .. controls urcorner p .. + urcorner p shifted (-3dd,0) -- + ulcorner p shifted ( 3dd,0) .. controls ulcorner p .. + ulcorner p shifted (0,-3dd) .. + llcorner p shifted (0, 3dd) .. controls llcorner p .. cycle ; % {down} .. cycle ; + path w ; w := t xscaled ((ww-2dd)/ww) yscaled ((hh-2dd)/hh) ; + path a ; a := llcorner p -- ulcorner p -- + ulcorner q -- llcorner q -- cycle ; + path b ; b := llcorner p -- lrcorner p -- + lrcorner q -- llcorner q -- cycle ; + path c ; c := lrcorner p -- urcorner p -- + urcorner q -- lrcorner q -- cycle ; + path d ; d := ulcorner p -- urcorner p -- + urcorner q -- ulcorner q -- cycle ; + path e ; e := llcorner p -- lrcorner p -- + urcorner p -- urcorner q -- + lrcorner q -- llcorner q -- cycle ; + path f ; f := llcorner p -- ulcorner p -- + urcorner p -- urcorner q -- + ulcorner q -- llcorner q -- cycle ; + + linecap := butt ; pickup pencircle scaled back_linewidth ; + + if back_type = 1 : + + fill p withcolor back_fillcolor ; + fill a withcolor back_leftcolor ; + fill b withcolor back_bottomcolor ; + fill c withcolor back_rightcolor ; + fill d withcolor back_topcolor ; + draw a withcolor back_linecolor ; + draw d withcolor back_linecolor ; + draw b withcolor back_linecolor ; + draw c withcolor back_linecolor ; + + elseif back_type = 2 : + + fill p withcolor back_fillcolor ; + fill e withcolor back_bottomcolor ; + fill f withcolor back_topcolor ; + draw e withcolor back_linecolor ; + draw f withcolor back_linecolor ; + + elseif back_type = 3 : + + fill v withcolor back_nillcolor ; + fill w withcolor back_fillcolor ; + draw v withcolor back_linecolor ; + draw w withcolor back_linecolor ; + + elseif back_type = 4 : + + fill t withcolor back_nillcolor ; + fill u withcolor back_fillcolor ; + draw t withcolor back_linecolor ; + draw u withcolor back_linecolor ; + + elseif back_type = 5 : + + t := t rotatedaround(center t,180) ; + u := u rotatedaround(center u,180) ; + + fill t withcolor back_nillcolor ; + fill u withcolor back_fillcolor ; + draw t withcolor back_linecolor ; + draw u withcolor back_linecolor ; + + elseif back_type = 6 : + + r := r rotatedaround(center r,180) ; + s := s rotatedaround(center s,180) ; + + fill r withcolor back_nillcolor ; + fill s withcolor back_fillcolor ; + draw r withcolor back_linecolor ; + draw s withcolor back_linecolor ; + + elseif back_type = 7 : + + fill r withcolor back_nillcolor ; + fill s withcolor back_fillcolor ; + draw r withcolor back_linecolor ; + draw s withcolor back_linecolor ; + + fi ; + + endgroup; enddef ; -endinput ; - -beginfig (1) ; - -some_double_back (1, 4.5cm, 1.5cm, .25cm, 1mm, - .5white, .8white, .7white, .6white, .7white, .6white) - -currentpicture := currentpicture shifted (0,-3cm) ; - -some_double_back (2, 4.5cm, 1.5cm, .25cm, 1mm, - .5white, .8white, .7white, .6white, white, white) - -currentpicture := currentpicture shifted (0,-3cm) ; - -some_double_back (3, 4.5cm, 1.5cm, .25cm, 1mm, - .5white, .8white, .7white, white, white, white) - -currentpicture := currentpicture shifted (0,-3cm) ; - -some_double_back (4, 4.5cm, 1.5cm, .25cm, 1mm, - .5white, .8white, .7white, white, white, white) - -currentpicture := currentpicture shifted (0,-3cm) ; - -some_double_back (5, 4.5cm, 1.5cm, .25cm, 1mm, - .5white, .8white, .7white, white, white, white) - -currentpicture := currentpicture shifted (0,-3cm) ; - -some_double_back (6, 4.5cm, 1.5cm, .25cm, 1mm, - .5white, .8white, .7white, white, white, white) - -currentpicture := currentpicture shifted (0,-3cm) ; - -some_double_back (7, 4.5cm, 1.5cm, .25cm, 1mm, - .5white, .8white, .7white, white, white, white) - -currentpicture := currentpicture shifted (0,-3cm) ; - -some_double_back (8, 4.5cm, 1.5cm, .25cm, 1mm, - .5white, .8white, .7white, white, white, white) - -endfig ; - -end . +% endinput ; +% +% beginfig (1) ; +% +% some_double_back (1, 4.5cm, 1.5cm, .25cm, 1mm, +% .5white, .8white, .7white, .6white, .7white, .6white) +% +% currentpicture := currentpicture shifted (0,-3cm) ; +% +% some_double_back (2, 4.5cm, 1.5cm, .25cm, 1mm, +% .5white, .8white, .7white, .6white, white, white) +% +% currentpicture := currentpicture shifted (0,-3cm) ; +% +% some_double_back (3, 4.5cm, 1.5cm, .25cm, 1mm, +% .5white, .8white, .7white, white, white, white) +% +% currentpicture := currentpicture shifted (0,-3cm) ; +% +% some_double_back (4, 4.5cm, 1.5cm, .25cm, 1mm, +% .5white, .8white, .7white, white, white, white) +% +% currentpicture := currentpicture shifted (0,-3cm) ; +% +% some_double_back (5, 4.5cm, 1.5cm, .25cm, 1mm, +% .5white, .8white, .7white, white, white, white) +% +% currentpicture := currentpicture shifted (0,-3cm) ; +% +% some_double_back (6, 4.5cm, 1.5cm, .25cm, 1mm, +% .5white, .8white, .7white, white, white, white) +% +% currentpicture := currentpicture shifted (0,-3cm) ; +% +% some_double_back (7, 4.5cm, 1.5cm, .25cm, 1mm, +% .5white, .8white, .7white, white, white, white) +% +% currentpicture := currentpicture shifted (0,-3cm) ; +% +% some_double_back (8, 4.5cm, 1.5cm, .25cm, 1mm, +% .5white, .8white, .7white, white, white, white) +% +% endfig ; +% +% end . diff --git a/Master/texmf-dist/metapost/context/base/mpiv/mp-base.mpiv b/Master/texmf-dist/metapost/context/base/mpiv/mp-base.mpiv index 75dd4b4b00a..08bd42c0526 100644 --- a/Master/texmf-dist/metapost/context/base/mpiv/mp-base.mpiv +++ b/Master/texmf-dist/metapost/context/base/mpiv/mp-base.mpiv @@ -237,11 +237,13 @@ EOF = char 0 ; % end-of-file for readfrom and write..to % pen constants -pen pensquare, penrazor, penspeck ; +pen pensquare, penrazor, penspec ; pensquare = makepen(unitsquare shifted -(.5,.5)) ; penrazor = makepen((-.5,0) -- (.5,0) -- cycle) ; -penspeck = pensquare scaled eps ; +penspec = pensquare scaled eps ; + +def penspeck = penspec enddef ; % nullary operators diff --git a/Master/texmf-dist/metapost/context/base/mpiv/mp-blob.mpiv b/Master/texmf-dist/metapost/context/base/mpiv/mp-blob.mpiv index dd147bedeb2..8808b5df66c 100644 --- a/Master/texmf-dist/metapost/context/base/mpiv/mp-blob.mpiv +++ b/Master/texmf-dist/metapost/context/base/mpiv/mp-blob.mpiv @@ -91,7 +91,10 @@ vardef followtext(expr pth, txt) = at := arctime pos of pat ; ap := point at of pat ; ad := direction at of pat ; - pic[i] := pic[i] shifted (-wid/2,0) rotated(angle(ad)) shifted ap ; + pic[i] := pic[i] + shifted (-wid/2,0) + if ad <> origin : rotated(angle(ad)) fi + shifted ap ; draw pic[i] ; if tracingfollowtext = 1 : draw boundingbox pic[i] withpen pencircle scaled .25pt withcolor red ; diff --git a/Master/texmf-dist/metapost/context/base/mpiv/mp-cont.mpiv b/Master/texmf-dist/metapost/context/base/mpiv/mp-cont.mpiv index 083286bee44..13d68684893 100644 --- a/Master/texmf-dist/metapost/context/base/mpiv/mp-cont.mpiv +++ b/Master/texmf-dist/metapost/context/base/mpiv/mp-cont.mpiv @@ -155,4 +155,4 @@ vardef OuterMargin = if not OnRightPage : LeftMargin else : RightMargin fi endd vardef InnerMargin = if not OnRightPage : RightMargin else : LeftMargin fi enddef ; vardef OuterEdge = if not OnRightPage : LeftEdge else : RightEdge fi enddef ; -vardef InnerEdge = if not OnRightPage : Rightedge else : LeftEdge fi enddef ; +vardef InnerEdge = if not OnRightPage : RightEdge else : LeftEdge fi enddef ; diff --git a/Master/texmf-dist/metapost/context/base/mpiv/mp-cont.mpxl b/Master/texmf-dist/metapost/context/base/mpiv/mp-cont.mpxl deleted file mode 100644 index bc318d4b993..00000000000 --- a/Master/texmf-dist/metapost/context/base/mpiv/mp-cont.mpxl +++ /dev/null @@ -1,158 +0,0 @@ -%D \module -%D [ file=mp-cont.mpiv, -%D version=1999.03.10, -%D title=\CONTEXT\ \METAPOST\ graphics, -%D subtitle=Interfaces, -%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. - -%D This module is rather preliminary and subjected to changes. - -if known context_cont : endinput ; fi ; - -boolean context_cont ; context_cont := true ; - -string CurrentLayout ; CurrentLayout := "default" ; - -boolean mfun_swapped ; - -def SwapPageState = - mfun_swapped := true ; % eventually this will go ! -enddef ; - -extra_beginfig := extra_beginfig & "mfun_swapped := false ;" ; - -newinternal mfid_PaperHeight ; mfid_PaperHeight := scriptindex "PaperHeight" ; vardef PaperHeight = runscript mfid_PaperHeight enddef ; -newinternal mfid_PaperWidth ; mfid_PaperWidth := scriptindex "PaperWidth" ; vardef PaperWidth = runscript mfid_PaperWidth enddef ; -newinternal mfid_PrintPaperHeight ; mfid_PrintPaperHeight := scriptindex "PrintPaperHeight" ; vardef PrintPaperHeight = runscript mfid_PrintPaperHeight enddef ; -newinternal mfid_PrintPaperWidth ; mfid_PrintPaperWidth := scriptindex "PrintPaperWidth" ; vardef PrintPaperWidth = runscript mfid_PrintPaperWidth enddef ; -newinternal mfid_TopSpace ; mfid_TopSpace := scriptindex "TopSpace" ; vardef TopSpace = runscript mfid_TopSpace enddef ; -newinternal mfid_BottomSpace ; mfid_BottomSpace := scriptindex "BottomSpace" ; vardef BottomSpace = runscript mfid_BottomSpace enddef ; -newinternal mfid_BackSpace ; mfid_BackSpace := scriptindex "BackSpace" ; vardef BackSpace = runscript mfid_BackSpace enddef ; -newinternal mfid_CutSpace ; mfid_CutSpace := scriptindex "CutSpace" ; vardef CutSpace = runscript mfid_CutSpace enddef ; -newinternal mfid_MakeupHeight ; mfid_MakeupHeight := scriptindex "MakeupHeight" ; vardef MakeupHeight = runscript mfid_MakeupHeight enddef ; -newinternal mfid_MakeupWidth ; mfid_MakeupWidth := scriptindex "MakeupWidth" ; vardef MakeupWidth = runscript mfid_MakeupWidth enddef ; -newinternal mfid_TopHeight ; mfid_TopHeight := scriptindex "TopHeight" ; vardef TopHeight = runscript mfid_TopHeight enddef ; -newinternal mfid_TopDistance ; mfid_TopDistance := scriptindex "TopDistance" ; vardef TopDistance = runscript mfid_TopDistance enddef ; -newinternal mfid_HeaderHeight ; mfid_HeaderHeight := scriptindex "HeaderHeight" ; vardef HeaderHeight = runscript mfid_HeaderHeight enddef ; -newinternal mfid_HeaderDistance ; mfid_HeaderDistance := scriptindex "HeaderDistance" ; vardef HeaderDistance = runscript mfid_HeaderDistance enddef ; -newinternal mfid_TextHeight ; mfid_TextHeight := scriptindex "TextHeight" ; vardef TextHeight = runscript mfid_TextHeight enddef ; -newinternal mfid_FooterDistance ; mfid_FooterDistance := scriptindex "FooterDistance" ; vardef FooterDistance = runscript mfid_FooterDistance enddef ; -newinternal mfid_FooterHeight ; mfid_FooterHeight := scriptindex "FooterHeight" ; vardef FooterHeight = runscript mfid_FooterHeight enddef ; -newinternal mfid_BottomDistance ; mfid_BottomDistance := scriptindex "BottomDistance" ; vardef BottomDistance = runscript mfid_BottomDistance enddef ; -newinternal mfid_BottomHeight ; mfid_BottomHeight := scriptindex "BottomHeight" ; vardef BottomHeight = runscript mfid_BottomHeight enddef ; -newinternal mfid_LeftEdgeWidth ; mfid_LeftEdgeWidth := scriptindex "LeftEdgeWidth" ; vardef LeftEdgeWidth = runscript mfid_LeftEdgeWidth enddef ; -newinternal mfid_LeftEdgeDistance ; mfid_LeftEdgeDistance := scriptindex "LeftEdgeDistance" ; vardef LeftEdgeDistance = runscript mfid_LeftEdgeDistance enddef ; -newinternal mfid_LeftMarginWidth ; mfid_LeftMarginWidth := scriptindex "LeftMarginWidth" ; vardef LeftMarginWidth = runscript mfid_LeftMarginWidth enddef ; -newinternal mfid_LeftMarginDistance ; mfid_LeftMarginDistance := scriptindex "LeftMarginDistance" ; vardef LeftMarginDistance = runscript mfid_LeftMarginDistance enddef ; -newinternal mfid_TextWidth ; mfid_TextWidth := scriptindex "TextWidth" ; vardef TextWidth = runscript mfid_TextWidth enddef ; -newinternal mfid_RightMarginDistance ; mfid_RightMarginDistance := scriptindex "RightMarginDistance" ; vardef RightMarginDistance = runscript mfid_RightMarginDistance enddef ; -newinternal mfid_RightMarginWidth ; mfid_RightMarginWidth := scriptindex "RightMarginWidth" ; vardef RightMarginWidth = runscript mfid_RightMarginWidth enddef ; -newinternal mfid_RightEdgeDistance ; mfid_RightEdgeDistance := scriptindex "RightEdgeDistance" ; vardef RightEdgeDistance = runscript mfid_RightEdgeDistance enddef ; -newinternal mfid_RightEdgeWidth ; mfid_RightEdgeWidth := scriptindex "RightEdgeWidth" ; vardef RightEdgeWidth = runscript mfid_RightEdgeWidth enddef ; -newinternal mfid_InnerMarginDistance ; mfid_InnerMarginDistance := scriptindex "InnerMarginDistance" ; vardef InnerMarginDistance = runscript mfid_InnerMarginDistance enddef ; -newinternal mfid_InnerMarginWidth ; mfid_InnerMarginWidth := scriptindex "InnerMarginWidth" ; vardef InnerMarginWidth = runscript mfid_InnerMarginWidth enddef ; -newinternal mfid_OuterMarginDistance ; mfid_OuterMarginDistance := scriptindex "OuterMarginDistance" ; vardef OuterMarginDistance = runscript mfid_OuterMarginDistance enddef ; -newinternal mfid_OuterMarginWidth ; mfid_OuterMarginWidth := scriptindex "OuterMarginWidth" ; vardef OuterMarginWidth = runscript mfid_OuterMarginWidth enddef ; -newinternal mfid_InnerEdgeDistance ; mfid_InnerEdgeDistance := scriptindex "InnerEdgeDistance" ; vardef InnerEdgeDistance = runscript mfid_InnerEdgeDistance enddef ; -newinternal mfid_InnerEdgeWidth ; mfid_InnerEdgeWidth := scriptindex "InnerEdgeWidth" ; vardef InnerEdgeWidth = runscript mfid_InnerEdgeWidth enddef ; -newinternal mfid_OuterEdgeDistance ; mfid_OuterEdgeDistance := scriptindex "OuterEdgeDistance" ; vardef OuterEdgeDistance = runscript mfid_OuterEdgeDistance enddef ; -newinternal mfid_OuterEdgeWidth ; mfid_OuterEdgeWidth := scriptindex "OuterEdgeWidth" ; vardef OuterEdgeWidth = runscript mfid_OuterEdgeWidth enddef ; -newinternal mfid_PageOffset ; mfid_PageOffset := scriptindex "PageOffset" ; vardef PageOffset = runscript mfid_PageOffset enddef ; -newinternal mfid_PageDepth ; mfid_PageDepth := scriptindex "PageDepth" ; vardef PageDepth = runscript mfid_PageDepth enddef ; -newinternal mfid_LayoutColumns ; mfid_LayoutColumns := scriptindex "LayoutColumns" ; vardef LayoutColumns = runscript mfid_LayoutColumns enddef ; -newinternal mfid_LayoutColumnDistance ; mfid_LayoutColumnDistance := scriptindex "LayoutColumnDistance" ; vardef LayoutColumnDistance = runscript mfid_LayoutColumnDistance enddef ; -newinternal mfid_LayoutColumnWidth ; mfid_LayoutColumnWidth := scriptindex "LayoutColumnWidth" ; vardef LayoutColumnWidth = runscript mfid_LayoutColumnWidth enddef ; - -newinternal mfid_OnRightPage ; mfid_OnRightPage := scriptindex "OnRightPage" ; vardef OnRightPage = runscript mfid_OnRightPage enddef ; -newinternal mfid_OnOddPage ; mfid_OnOddPage := scriptindex "OnOddPage" ; vardef OnOddPage = runscript mfid_OnOddPage enddef ; -newinternal mfid_InPageBody ; mfid_InPageBody := scriptindex "InPageBody" ; vardef InPageBody = runscript mfid_InPageBody enddef ; - -newinternal mfid_RealPageNumber ; mfid_RealPageNumber := scriptindex "RealPageNumber" ; vardef RealPageNumber = runscript mfid_RealPageNumber enddef ; -newinternal mfid_LastPageNumber ; mfid_LastPageNumber := scriptindex "LastPageNumber" ; vardef LastPageNumber = runscript mfid_LastPageNumber enddef ; - -newinternal mfid_PageNumber ; mfid_PageNumber := scriptindex "PageNumber" ; vardef PageNumber = runscript mfid_PageNumber enddef ; -newinternal mfid_NOfPages ; mfid_NOfPages := scriptindex "NOfPages" ; vardef NOfPages = runscript mfid_NOfPages enddef ; - -newinternal mfid_SubPageNumber ; mfid_SubPageNumber := scriptindex "SubPageNumber" ; vardef SubPageNumber = runscript mfid_SubPageNumber enddef ; -newinternal mfid_NOfSubPages ; mfid_NOfSubPages := scriptindex "NOfSubPages" ; vardef NOfSubPages = runscript mfid_NOfSubPages enddef ; - -newinternal mfid_CurrentColumn ; mfid_CurrentColumn := scriptindex "CurrentColumn" ; vardef CurrentColumn = runscript mfid_CurrentColumn enddef ; -newinternal mfid_NOfColumns ; mfid_NOfColumns := scriptindex "NOfColumns" ; vardef NOfColumns = runscript mfid_NOfColumns enddef ; - -newinternal mfid_BaseLineSkip ; mfid_BaseLineSkip := scriptindex "BaseLineSkip" ; vardef BaseLineSkip = runscript mfid_BaseLineSkip enddef ; -newinternal mfid_LineHeight ; mfid_LineHeight := scriptindex "LineHeight" ; vardef LineHeight = runscript mfid_LineHeight enddef ; -newinternal mfid_BodyFontSize ; mfid_BodyFontSize := scriptindex "BodyFontSize" ; vardef BodyFontSize = runscript mfid_BodyFontSize enddef ; - -newinternal mfid_TopSkip ; mfid_TopSkip := scriptindex "TopSkip" ; vardef TopSkip = runscript mfid_TopSkip enddef ; -newinternal mfid_StrutHeight ; mfid_StrutHeight := scriptindex "StrutHeight" ; vardef StrutHeight = runscript mfid_StrutHeight enddef ; -newinternal mfid_StrutDepth ; mfid_StrutDepth := scriptindex "StrutDepth" ; vardef StrutDepth = runscript mfid_StrutDepth enddef ; - -newinternal mfid_CurrentWidth ; mfid_CurrentWidth := scriptindex "CurrentWidth" ; vardef CurrentWidth = runscript mfid_CurrentWidth enddef ; -newinternal mfid_CurrentHeight ; mfid_CurrentHeight := scriptindex "CurrentHeight" ; vardef CurrentHeight = runscript mfid_CurrentHeight enddef ; - -newinternal mfid_HSize ; mfid_HSize := scriptindex "HSize" ; vardef HSize = runscript mfid_HSize enddef ; -newinternal mfid_VSize ; mfid_VSize := scriptindex "VSize" ; vardef VSize = runscript mfid_VSize enddef ; - -newinternal mfid_EmWidth ; mfid_EmWidth := scriptindex "EmWidth" ; vardef EmWidth = runscript mfid_EmWidth enddef ; -newinternal mfid_ExHeight ; mfid_ExHeight := scriptindex "ExHeight" ; vardef ExHeight = runscript mfid_ExHeight enddef ; - -newinternal mfid_PageFraction ; mfid_PageFraction := scriptindex "PageFraction" ; vardef PageFraction = runscript mfid_PageFraction enddef ; - -newinternal mfid_SpineWidth ; mfid_SpineWidth := scriptindex "SpineWidth" ; vardef SpineWidth = runscript mfid_SpineWidth enddef ; -newinternal mfid_PaperBleed ; mfid_PaperBleed := scriptindex "PaperBleed" ; vardef PaperBleed = runscript mfid_PaperBleed enddef ; - -% mfid_CurrentLayout ; mfid_CurrentLayout := scriptindex "CurrentLayout" ; vardef CurrentLayout = runscript mfid_CurrentLayout enddef ; -newinternal mfid_OverlayWidth ; mfid_OverlayWidth := scriptindex "OverlayWidth" ; vardef OverlayWidth = runscript mfid_OverlayWidth enddef ; -newinternal mfid_OverlayHeight ; mfid_OverlayHeight := scriptindex "OverlayHeight" ; vardef OverlayHeight = runscript mfid_OverlayHeight enddef ; -newinternal mfid_OverlayDepth ; mfid_OverlayDepth := scriptindex "OverlayDepth" ; vardef OverlayDepth = runscript mfid_OverlayDepth enddef ; -newinternal mfid_OverlayLineWidth ; mfid_OverlayLineWidth := scriptindex "OverlayLineWidth" ; vardef OverlayLineWidth = runscript mfid_OverlayLineWidth enddef ; -newinternal mfid_OverlayOffset ; mfid_OverlayOffset := scriptindex "OverlayOffset" ; vardef OverlayOffset = runscript mfid_OverlayOffset enddef ; -newinternal mfid_OverlayRegion ; mfid_OverlayRegion := scriptindex "OverlayRegion" ; vardef OverlayRegion = runscript mfid_OverlayRegion enddef ; -% mfid_OverlayLineColor ; mfid_OverlayLineColor := scriptindex "OverlayLineColor ; vardef OverlayLineColor = runscript mfid_OverlayLineColor enddef ; -% mfid_OverlayColor ; mfid_OverlayColor := scriptindex "OverlayColor ; vardef OverlayColor = runscript mfid_OverlayColor enddef ; - -newinternal mfid_defaultcolormodel ; mfid_defaultcolormodel := scriptindex "defaultcolormodel" ; vardef defaultcolormodel = runscript mfid_defaultcolormodel enddef ; - -vardef LeftMarginWidth = if mfun_swapped and not OnRightPage : runscript mfid_RightMarginWidth else : runscript mfid_LeftMarginWidth fi enddef ; -vardef RightMarginWidth = if mfun_swapped and not OnRightPage : runscript mfid_LeftMarginWidth else : runscript mfid_RightMarginWidth fi enddef ; -vardef LeftMarginDistance = if mfun_swapped and not OnRightPage : runscript mfid_RightMarginDistance else : runscript mfid_LeftMarginDistance fi enddef ; -vardef RightMarginDistance = if mfun_swapped and not OnRightPage : runscript mfid_LeftMarginDistance else : runscript mfid_RightMarginDistance fi enddef ; - -vardef LeftEdgeWidth = if mfun_swapped and not OnRightPage : runscript mfid_RightEdgeWidth else : runscript mfid_LeftEdgeWidth fi enddef ; -vardef RightEdgeWidth = if mfun_swapped and not OnRightPage : runscript mfid_LeftEdgeWidth else : runscript mfid_RightEdgeWidth fi enddef ; -vardef LeftEdgeDistance = if mfun_swapped and not OnRightPage : runscript mfid_RightEdgeDistance else : runscript mfid_LeftEdgeDistance fi enddef ; -vardef RightEdgeDistance = if mfun_swapped and not OnRightPage : runscript mfid_LeftEdgeDistance else : runscript mfid_RightEdgeDistance fi enddef ; - -vardef BackSpace = if mfun_swapped and not OnRightPage : PaperWidth - MakeupWidth - fi runscript mfid_BackSpace enddef ; -vardef CutSpace = if mfun_swapped and not OnRightPage : PaperWidth - MakeupWidth - fi runscript mfid_CutSpace enddef ; - -% better use: - -vardef OuterMarginWidth = if not OnRightPage : runscript mfid_LeftMarginWidth else : runscript mfid_RightMarginWidth fi enddef ; -vardef InnerMarginWidth = if not OnRightPage : runscript mfid_RightMarginWidth else : runscript mfid_LeftMarginWidth fi enddef ; -vardef OuterMarginDistance = if not OnRightPage : runscript mfid_LeftMarginDistance else : runscript mfid_RightMarginDistance fi enddef ; -vardef InnerMarginDistance = if not OnRightPage : runscript mfid_RightMarginDistance else : runscript mfid_LeftMarginDistance fi enddef ; - -vardef OuterEdgeWidth = if not OnRightPage : runscript mfid_LeftEdgeWidth else : runscript mfid_RightEdgeWidth fi enddef ; -vardef InnerEdgeWidth = if not OnRightPage : runscript mfid_RightEdgeWidth else : runscript mfid_LeftEdgeWidth fi enddef ; -vardef OuterEdgeDistance = if not OnRightPage : runscript mfid_LeftEdgeDistance else : runscript mfid_RightEdgeDistance fi enddef ; -vardef InnerEdgeDistance = if not OnRightPage : runscript mfid_RightEdgeDistance else : runscript mfid_LeftEdgeDistance fi enddef ; - -vardef OuterSpaceWidth = if not OnRightPage : runscript mfid_BackSpace else : runscript mfid_CutSpace fi enddef ; -vardef InnerSpaceWidth = if not OnRightPage : runscript mfid_CutSpace else : runscript mfid_BackSpace fi enddef ; - -% indices - -vardef OuterMargin = if not OnRightPage : LeftMargin else : RightMargin fi enddef ; -vardef InnerMargin = if not OnRightPage : RightMargin else : LeftMargin fi enddef ; - -vardef OuterEdge = if not OnRightPage : LeftEdge else : RightEdge fi enddef ; -vardef InnerEdge = if not OnRightPage : Rightedge else : LeftEdge fi enddef ; - - diff --git a/Master/texmf-dist/metapost/context/base/mpiv/mp-core.mpiv b/Master/texmf-dist/metapost/context/base/mpiv/mp-core.mpiv deleted file mode 100644 index 0ef24e57e98..00000000000 --- a/Master/texmf-dist/metapost/context/base/mpiv/mp-core.mpiv +++ /dev/null @@ -1,1558 +0,0 @@ -%D \module -%D [ file=mp-core.mpiv, -%D version=1999.08.01, % anchoring -%D title=\CONTEXT\ \METAPOST\ graphics, -%D subtitle=background macros, -%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 context_core : endinput ; fi ; - -boolean context_core ; context_core := true ; - -%D Copied to here .. not used any more. - -if unknown NOfTextColumns : numeric NOfTextColumns ; NOfTextColumns := 1 ; fi ; -if unknown NOfTextAreas : numeric NOfTextAreas ; NOfTextAreas := 1 ; fi ; - -def SaveTextAreas = - path SavedTextAreas [] ; - path SavedTextColumns[] ; - numeric NOfSavedTextAreas ; - numeric NOfSavedTextColumns ; - for i=1 upto NOfTextAreas : - SavedTextAreas[i] := TextAreas[i] ; - endfor ; - for i=1 upto NOfTextColumns : - SavedTextColumns[i] := TextColumns[i] ; - endfor ; - NOfSavedTextAreas := NOfTextAreas ; - NOfSavedTextColumns := NOfTextColumns ; -enddef ; - -def ResetTextAreas = - path TextAreas[], TextColumns[], PlainTextArea, RegionTextArea ; - numeric NOfTextAreas ; NOfTextAreas := 0 ; - numeric NOfTextColumns ; NOfTextColumns := 0 ; - numeric nofmultipars ; nofmultipars := 0 ; - TextAreas[0] := TextColumns[0] := origin -- cycle ; -enddef ; - -ResetTextAreas ; SaveTextAreas ; ; - -def RegisterTextArea (expr x, y, w, h, d) = - begingroup ; - save p ; path p ; - p := unitsquare xyscaled(w,h+d) shifted (x,y-d) ; - if NOfTextAreas>0 : - % if needed, concatenate areas - if (round(llcorner TextAreas[NOfTextAreas]) = round(ulcorner p)) and - (round(lrcorner TextAreas[NOfTextAreas]) = round(urcorner p)) : - p := - ulcorner TextAreas[NOfTextAreas] -- - urcorner TextAreas[NOfTextAreas] -- - lrcorner p -- - llcorner p -- cycle ; - else : - NOfTextAreas := NOfTextAreas + 1 ; - fi ; - else : - NOfTextAreas := NOfTextAreas + 1 ; - fi ; - TextAreas[NOfTextAreas] := p ; - if NOfTextColumns>0 : - if (round(xpart llcorner TextColumns[NOfTextColumns]) = round(xpart ulcorner p)) and - (round(xpart lrcorner TextColumns[NOfTextColumns]) = round(xpart urcorner p)) : - p := - ulcorner TextColumns[NOfTextColumns] -- - urcorner TextColumns[NOfTextColumns] -- - lrcorner p -- - llcorner p -- cycle ; - else : - NOfTextColumns := NOfTextColumns + 1 ; - fi ; - else : - NOfTextColumns := NOfTextColumns + 1 ; - fi ; - TextColumns[NOfTextColumns] := p ; - endgroup ; -enddef ; - -%D We store a local area in slot zero. - -def RegisterPlainTextArea(expr x,y,w,h,d) = - PlainTextArea := unitsquare xyscaled(w,h+d) shifted (x,y-d) ; -enddef ; - -def RegisterRegionTextArea(expr x,y,w,h,d) = - RegionTextArea := unitsquare xyscaled(w,h+d) shifted (x,y-d) ; - % RegionTextArea := RegionTextArea enlarged 2mm ; -enddef ; - -def RegisterLocalTextArea (expr x, y, w, h, d) = - TextAreas[0] := TextColumns[0] := unitsquare xyscaled(w,h+d) shifted (x,y-d) ; -enddef ; - -def ResetLocalTextArea = - TextAreas[0] := TextColumns[0] := origin -- cycle ; -enddef ; - -ResetLocalTextArea ; - -vardef InsideTextArea (expr _i_, _xy_) = - (round(xpart _xy_) >= round(xpart llcorner TextAreas[_i_])) and - (round(xpart _xy_) <= round(xpart lrcorner TextAreas[_i_])) and - (round(ypart _xy_) >= round(ypart llcorner TextAreas[_i_])) and - (round(ypart _xy_) <= round(ypart urcorner TextAreas[_i_])) -enddef ; - -vardef InsideSavedTextArea (expr _i_, _xy_) = - (round(xpart _xy_) >= round(xpart llcorner SavedTextAreas[_i_])) and - (round(xpart _xy_) <= round(xpart lrcorner SavedTextAreas[_i_])) and - (round(ypart _xy_) >= round(ypart llcorner SavedTextAreas[_i_])) and - (round(ypart _xy_) <= round(ypart urcorner SavedTextAreas[_i_])) -enddef ; - -vardef InsideSomeTextArea (expr _xy_) = - save ok ; boolean ok ; ok := false ; - for i := 1 upto NOfTextAreas : - if InsideTextArea(i,_xy_) : - ok := true ; % we can move the exit here - fi ; - exitif ok ; - endfor ; - ok -enddef ; - -vardef InsideSomeSavedTextArea (expr _xy_) = - save ok ; boolean ok ; ok := false ; - for i := 1 upto NOfSavedTextAreas : - if InsideSavedTextArea(i,_xy_) : - ok := true ; - fi ; - exitif ok ; - endfor ; - ok -enddef ; - -vardef TextAreaX (expr x) = - numeric _TextAreaX_ ; _TextAreaX_ := 0 ; - for i := 1 upto NOfTextAreas : - if (round(x) >= round(xpart llcorner TextAreas[i])) and - (round(x) <= round(xpart lrcorner TextAreas[i])) : - _TextAreaX_ := xpart llcorner TextAreas[i] ; - fi ; - endfor ; - _TextAreaX_ -enddef ; - -vardef TextAreaY (expr y) = - numeric _TextAreaY_ ; _TextAreaY_ := 0 ; - for i := 1 upto NOfTextAreas : - if (round(y) >= round(ypart llcorner TextAreas[NOfTextAreas])) and - (round(y) <= round(ypart ulcorner TextAreas[NOfTextAreas])) : - _TextAreaY_ := ypart llcorner TextAreas[NOfTextAreas] ; - fi ; - endfor ; - _TextAreaY_ -enddef ; - -vardef TextAreaXY (expr x, y) = - pair _TextAreaXY_ ; _TextAreaXY_ := origin ; - for i := 1 upto NOfTextAreas : - if (round(x) >= round(xpart llcorner TextAreas[i])) and - (round(x) <= round(xpart lrcorner TextAreas[i])) and - (round(y) >= round(ypart llcorner TextAreas[i])) and - (round(y) <= round(ypart ulcorner TextAreas[i])) : - _TextAreaXY_ := llconer TextAreas[i] ; - fi ; - endfor ; - _TextAreaXY_ -enddef ; - -vardef TextAreaW (expr x) = - numeric _TextAreaW_ ; _TextAreaW_ := 0 ; - for i := 1 upto NOfTextAreas : - if (round(x) >= round(xpart llcorner TextAreas[i])) and - (round(x) <= round(xpart lrcorner TextAreas[i])) : - _TextAreaW_ := bbwidth(TextAreas[i]) ; - fi ; - endfor ; - _TextAreaW_ -enddef ; - -vardef TextAreaH (expr y) = - numeric _TextAreaH_ ; _TextAreaH_ := 0 ; - for i := 1 upto NOfTextAreas : - if (round(y) >= round(ypart llcorner TextAreas[i])) and - (round(y) <= round(ypart ulcorner TextAreas[i])) : - _TextAreaH_ := bbheight(TextAreas[i]) ; - fi ; - endfor ; - _TextAreaH_ -enddef ; - -vardef TextAreaWH (expr x, y) = - pair _TextAreaWH_ ; _TextAreaWH_ := origin ; - for i := 1 upto NOfTextAreas : - if (round(x) >= round(xpart llcorner TextAreas[i])) and - (round(x) <= round(xpart lrcorner TextAreas[i])) and - (round(y) >= round(ypart llcorner TextAreas[i])) and - (round(y) <= round(ypart ulcorner TextAreas[i])) : - _TextAreaWH_ := (bbwidth(TextAreas[i]),bbheight(TextAreas[i])) ; - fi ; - endfor ; - _TextAreaWH_ -enddef ; - -%D Till here. - -pair lxy[], rxy[], cxy[], llxy[], lrxy[], ulxy[], urxy[] ; -path pxy[] ; -numeric hxy[], wxy[], dxy[], nxy[] ; - -def box_found (expr n,x,y,w,h,d) = - not ((x=0) and (y=0) and (w=0) and (h=0) and (d=0)) -enddef ; - -def initialize_box_pos (expr pos,n,x,y,w,h,d) = - pair lxy, rxy, cxy, llxy, lrxy, ulxy, urxy ; - path pxy ; numeric hxy, wxy, dxy, nxy; - lxy := (x,y) ; - llxy := (x,y-d) ; - lrxy := (x+w,y-d) ; - urxy := (x+w,y+h) ; - ulxy := (x,y+h) ; - wxy := w ; - hxy := h ; - dxy := d ; - rxy := lxy shifted (wxy,0) ; - pxy := llxy--lrxy--urxy--ulxy--cycle ; - cxy := center pxy ; - nxy := n ; - freeze_box(pos) ; -enddef ; - -def freeze_box (expr pos) = - lxy[pos] := lxy ; - llxy[pos] := llxy ; - lrxy[pos] := lrxy ; - urxy[pos] := urxy ; - ulxy[pos] := ulxy ; - wxy[pos] := wxy ; - hxy[pos] := hxy ; - dxy[pos] := dxy ; - rxy[pos] := rxy ; - pxy[pos] := pxy ; - cxy[pos] := cxy ; - nxy[pos] := nxy ; -enddef ; - -def initialize_box (expr n,x,y,w,h,d) = - numeric bpos ; bpos := 0 ; initialize_box_pos(bpos,n,x,y,w,h,d) ; -enddef ; - -def initialize_area (expr fn,fx,fy,fw,fh,fd, - tn,tx,ty,tw,th,td) = - numeric fpos ; fpos := 1 ; initialize_box_pos(fpos,fn,fx,fy,fw,fh,fd) ; - numeric tpos ; tpos := 2 ; initialize_box_pos(tpos,tn,tx,ty,tw,th,td) ; - do_initialize_area (fpos, tpos) ; -enddef ; - -def do_initialize_area (expr fpos, tpos) = - lxy := lxy[fpos] ; - llxy := (xpart llxy[fpos], ypart llxy[tpos]) ; - lrxy := lrxy[tpos] ; - urxy := (xpart urxy[tpos], ypart urxy[fpos]) ; - ulxy := ulxy[fpos] ; - wxy := xpart lrxy - xpart llxy ; - hxy := hxy[fpos] ; - dxy := dxy[tpos] ; - rxy := lxy shifted (wxy,0) ; - pxy := llxy--lrxy--urxy--ulxy--cycle ; - cxy := center pxy ; -enddef ; - -def set_par_line_height (expr ph, pd) = - par_strut_height := if ph>0 : ph elseif StrutHeight>0 : StrutHeight else : 8pt fi ; - par_strut_depth := if pd>0 : pd elseif StrutDepth >0 : StrutDepth else : 3pt fi ; - par_line_height := par_strut_height + par_strut_depth ; -enddef ; - -def initialize_par (expr fn,fx,fy,fw,fh,fd, - tn,tx,ty,tw,th,td, - mn,mx,my,mw,mh,md, - pn,px,py,pw,ph,pd, - rw,rl,rr,rh,ra,ri) = - - numeric fpos ; fpos := 1 ; initialize_box_pos(fpos,fn,fx,fy,fw,fh,fd) ; - numeric tpos ; tpos := 2 ; initialize_box_pos(tpos,tn,tx,ty,tw,th,td) ; - numeric mpos ; mpos := 3 ; initialize_box_pos(mpos,mn,mx,my,mw,mh,md) ; - numeric ppos ; ppos := 4 ; initialize_box_pos(ppos,pn,px,py,pw,ph,pd) ; - - numeric par_strut_height, par_strut_depth, par_line_height ; - - set_par_line_height (ph, pd) ; - - do_initialize_area (fpos, tpos) ; - do_initialize_par (fpos, tpos, mpos, ppos, rw,rl,rr,rh,ra,ri) ; - -enddef ; - -def initialize_area_par (expr fn,fx,fy,fw,fh,fd, - tn,tx,ty,tw,th,td, - wn,wx,wy,ww,wh,wd) = - - numeric fpos ; fpos := 1 ; initialize_box_pos(fpos,fn,fx,fy,fw,fh,fd) ; - numeric tpos ; tpos := 2 ; initialize_box_pos(tpos,tn,tx,ty,tw,th,td) ; - numeric wpos ; wpos := 3 ; initialize_box_pos(wpos,wn,wx,wy,ww,wh,wd) ; - - numeric par_strut_height, par_strut_depth, par_line_height ; - - set_par_line_height (wh, wd) ; - - numeric ffpos ; ffpos := 4 ; initialize_box_pos(ffpos,wn,wx,fy,0,wh,wd) ; - numeric ttpos ; ttpos := 5 ; initialize_box_pos(ttpos,wn,wx+ww,ty,0,wh,wd) ; - - do_initialize_area (ffpos, ttpos) ; - - numeric mpos ; mpos := 6 ; freeze_box(mpos) ; - - do_initialize_par (fpos, tpos, mpos, ffpos, 0,0,0,0,0,0) ; - -enddef ; - -def do_initialize_par (expr fpos, tpos, mpos, ppos, rw,rl,rr,rh,ra,ri) = - - pair lref, rref, pref, lhref, rhref ; - - % clip the page area to the left and right skips - - llxy[mpos] := llxy[mpos] shifted (+rl,0) ; - lrxy[mpos] := lrxy[mpos] shifted (-rr,0) ; - urxy[mpos] := urxy[mpos] shifted (-rr,0) ; - ulxy[mpos] := ulxy[mpos] shifted (+rl,0) ; - - % fixate the leftskip, rightskip and hanging indentation - - lref := (xpart llxy[mpos],ypart ulxy[ppos]) ; lhref := lref shifted (rh,0) ; - rref := (xpart lrxy[mpos],ypart urxy[ppos]) ; rhref := rref shifted (rh,0) ; - - pref := lxy[ppos] ; - - if nxy[tpos] > nxy[fpos] : - if nxy[fpos] = nxy[mpos] : - % first of multiple pages - llxy[tpos] := llxy[mpos] ; - lrxy[tpos] := lrxy[mpos] ; - urxy[tpos] := lrxy[mpos] shifted (0,par_line_height) ; - ulxy[tpos] := llxy[mpos] shifted (0,par_line_height) ; - boxgriddirection := down ; - elseif nxy[tpos] = nxy[mpos] : - % last of multiple pages - llxy[fpos] := ulxy[mpos] shifted (0,-par_line_height) ; - lrxy[fpos] := urxy[mpos] shifted (0,-par_line_height) ; - urxy[fpos] := urxy[mpos] ; - ulxy[fpos] := ulxy[mpos] ; - boxgriddirection := up ; - else : - % middle of multiple pages - llxy[fpos] := ulxy[mpos] shifted (0,-par_line_height) ; - lrxy[fpos] := urxy[mpos] shifted (0,-par_line_height) ; - urxy[fpos] := urxy[mpos] ; - ulxy[fpos] := ulxy[mpos] ; - llxy[tpos] := llxy[mpos] ; - lrxy[tpos] := lrxy[mpos] ; - urxy[tpos] := lrxy[mpos] shifted (0,par_line_height) ; - ulxy[tpos] := llxy[mpos] shifted (0,par_line_height) ; - boxgriddirection := up ; - fi ; - else : - % just one page - boxgriddirection := up ; - fi ; - - path txy, bxy, pxy, mxy ; - - txy := originpath ; % top - bxy := originpath ; % bottom - pxy := originpath ; % composed - - boolean lefthang, righthang, somehang ; - - % we only hang on the first of a multiple page background - - if nxy[mpos] > nxy[fpos] : - lefthang := righthang := somehang := false ; - else : - lefthang := (rh>0) ; righthang := (rh<0) ; somehang := false ; - fi ; - - if lefthang : - mxy := boundingbox (lref -- lref shifted (rh,ra*par_line_height)) ; - elseif righthang : - mxy := boundingbox (rref -- rref shifted (rh,ra*par_line_height)) ; - else : - mxy := originpath ; - fi ; - - if round(ypart llxy[fpos]) = round(ypart llxy[tpos]) : - - % We have a one-liner. Watch how er use the bottom pos for - % determining the height. - - llxy[fpos] := (xpart llxy[fpos], ypart llxy[tpos]) ; - ulxy[fpos] := (xpart ulxy[fpos], ypart ulxy[tpos]) ; - - else : - - % We have a multi-liner. For convenience we now correct the - % begin and end points for indentation. - - if lefthang and (round(ypart llxy[tpos]) >= round(ypart lrcorner mxy)) : - llxy[tpos] := (xpart lhref, ypart llxy[tpos]) ; - ulxy[tpos] := (xpart lhref, ypart ulxy[tpos]) ; - else : - llxy[tpos] := (xpart lref, ypart llxy[tpos]) ; - ulxy[tpos] := (xpart lref, ypart ulxy[tpos]) ; - fi ; - - if righthang and (round(ypart lrxy[fpos]) >= round(ypart llcorner mxy)) : - lrxy[fpos] := (xpart rhref, ypart lrxy[fpos]) ; - urxy[fpos] := (xpart rhref, ypart urxy[fpos]) ; - else : - lrxy[fpos] := (xpart rref, ypart lrxy[fpos]) ; - urxy[fpos] := (xpart rref, ypart urxy[fpos]) ; - fi ; - - fi ; - - somehang := (ypart ulxy[fpos]>ypart llcorner mxy) and - (ypart llxy[tpos]<ypart llcorner mxy) ; - - if round(ypart llxy[fpos]) = round(ypart llxy[tpos]) : - - % A (short) one-liner goes into the top box. - - txy := llxy[fpos] -- lrxy[tpos] -- urxy[tpos] -- ulxy[fpos] -- cycle ; - - elseif (round(ypart llxy[fpos]) = round(ypart ulxy[tpos])) and - (round(xpart lrxy[tpos]) < round(xpart llxy[fpos])) : - - % We have a sentence that spans two lines but with only end - % of line and begin of line segments. We need to take care of - % indentation. - - txy := llxy[fpos] -- lrxy[fpos] -- urxy[fpos] -- ulxy[fpos] -- cycle ; - bxy := llxy[tpos] -- lrxy[tpos] -- urxy[tpos] -- ulxy[tpos] -- cycle ; - - elseif (round(ypart llxy[fpos]) = round(ypart ulxy[tpos])) : - - % We have a sentence that spans two lines but with overlap. - - pxy := - llxy[tpos] -- lrxy[tpos] -- urxy[tpos] -- lrxy[fpos] -- - urxy[fpos] -- ulxy[fpos] -- llxy[fpos] -- ulxy[tpos] -- cycle ; - - elseif lefthang and somehang : - - % We have a sentence that spans more than two lines with - % left hanging indentation. - - pxy := - llxy[tpos] -- lrxy[tpos] -- urxy[tpos] -- - (xpart urxy[fpos],ypart urxy[tpos]) -- - urxy[fpos] -- ulxy[fpos] -- llxy[fpos] -- - if round(ypart urxy[tpos]) < round(ypart llcorner mxy) : - (xpart lrcorner mxy,ypart llxy[fpos]) -- - lrcorner mxy -- - (xpart llxy[tpos],ypart llcorner mxy) -- - else : - (xpart llxy[tpos],ypart llxy[fpos]) -- - fi - cycle ; - - elseif righthang and somehang : - - % We have a sentence that spans more than two lines with - % right hanging indentation. - - pxy := - llxy[tpos] -- lrxy[tpos] -- urxy[tpos] -- - if round(ypart urxy[tpos]) < round(ypart llcorner mxy) : - (xpart lrcorner mxy,ypart urxy[tpos]) -- - lrcorner mxy -- llcorner mxy -- - else : - (xpart urxy[fpos],ypart urxy[tpos]) -- - fi - urxy[fpos] -- ulxy[fpos] -- llxy[fpos] -- - (xpart llxy[tpos],ypart llxy[fpos]) -- - cycle ; - - else : - - % We have a sentence that spans more than two lines with - % no hanging indentation. - - pxy := - llxy[tpos] -- lrxy[tpos] -- urxy[tpos] -- - (xpart urxy[fpos],ypart urxy[tpos]) -- - urxy[fpos] -- ulxy[fpos] -- llxy[fpos] -- - (xpart llxy[tpos],ypart llxy[fpos]) -- - cycle ; - - fi ; - - pxy := simplified pxy ; - pxy := unspiked pxy ; - -enddef ; - -pair last_multi_par_shift ; last_multi_par_shift := origin ; - -def relocate_multipars (expr xy) = - last_multi_par_shift := xy ; - for i=1 upto nofmultipars : - multipars[i] := multipars[i] shifted last_multi_par_shift ; - endfor ; -enddef ; - -boolean compensate_multi_par_topskip ; -boolean span_multi_column_pars ; -boolean auto_multi_par_hsize ; -boolean enable_multi_par_fallback ; - -compensate_multi_par_topskip := true ; -span_multi_column_pars := false ; -auto_multi_par_hsize := false ; % true ; -enable_multi_par_fallback := true ; - -vardef multi_par_at_top (expr i) = - (round (ypart ulcorner multipars[i]) = round (ypart ulcorner (TextAreas[multirefs[i]] shifted last_multi_par_shift))) -enddef ; - -numeric nofmultipars ; nofmultipars := 0 ; - -boolean obey_multi_par_hang ; obey_multi_par_hang := true ; -boolean obey_multi_par_more ; obey_multi_par_more := true ; -boolean snap_multi_par_tops ; snap_multi_par_tops := true ; -boolean local_multi_par_area ; local_multi_par_area := false ; -boolean use_multi_par_region ; use_multi_par_region := false ; -boolean ignore_multi_par_page ; ignore_multi_par_page := false ; -boolean force_multi_par_chain ; force_multi_par_chain := true ; -boolean one_piece_multi_par ; one_piece_multi_par := false ; -boolean check_multi_par_chain ; check_multi_par_chain := true ; % extra page check - -boolean multi_column_first_page_hack; multi_column_first_page_hack := true ; % seems to work ok - -def simplify_multi_pars = % boundingbox ipv shape als optie - for i := 1 upto nofmultipars : - multipars[i] := boundingbox multipars[i] ; - endfor ; -enddef ; - -def save_multipar (expr i, l, p) = - nofmultipars := nofmultipars + 1 ; - multirefs[nofmultipars] := i ; - multilocs[nofmultipars] := l ; - multipars[nofmultipars] := unspiked (simplified p) ; -enddef ; - -def prepare_multi_pars (expr fn,fx,fy,fw,fh,fd, - tn,tx,ty,tw,th,td, - wn,wx,wy,ww,wh,wd, - pn,px,py,pw,ph,pd, - rw,rl,rr,rh,ra,ri) = - -% fill PlainTextArea withcolor red ; -% fill RegionTextArea withcolor green; - - if span_multi_column_pars : - begingroup ; - save TextAreas ; path TextAreas[] ; - save NOfTextAreas ; numeric NOfTextAreas ; - for i=1 upto NOfTextColumns : - TextAreas[i] := TextColumns[i] ; - endfor ; - NOfTextAreas := NOfTextColumns ; - fi ; - - last_multi_par_shift := origin ; - -% save _tx_, _ty_, _fx_, _fy_ ; -% if use_multi_par_region : -% _fx_ := fx ; %min(xpart ulcorner RegionTextArea,fx) ; -% _fy_ := fy ; %min(xpart ulcorner RegionTextArea,fy) ; -% _tx_ := min(xpart lrcorner RegionTextArea,tx) ; -% _ty_ := min(xpart lrcorner RegionTextArea,ty) ; -% else : -% _fx_ := fx ; -% _fy_ := fy ; -% _tx_ := tx ; -% _ty_ := ty ; -% fi ; - -% numeric fpos ; fpos := 1 ; initialize_box_pos(fpos,fn,_fx_,_fy_,fw,fh,fd) ; -% numeric tpos ; tpos := 2 ; initialize_box_pos(tpos,tn,_tx_,_ty_,tw,th,td) ; - numeric fpos ; fpos := 1 ; initialize_box_pos(fpos,fn,fx,fy,fw,fh,fd) ; - numeric tpos ; tpos := 2 ; initialize_box_pos(tpos,tn,tx,ty,tw,th,td) ; - numeric wpos ; wpos := 3 ; initialize_box_pos(wpos,wn,wx,wy,ww,wh,wd) ; - numeric ppos ; ppos := 4 ; initialize_box_pos(ppos,pn,px,py,pw,ph,pd) ; - - if local_multi_par_area : - RealPageNumber := fn ; - NOfTextAreas := 1 ; - NOfSavedTextAreas := 0 ; - TextAreas[1] := TextAreas[0] ; - TextColumns[1] := TextColumns[0] ; - nxy[fpos] := nxy[tpos] := nxy[wpos] := nxy[ppos] := RealPageNumber ; - elseif use_multi_par_region : - RealPageNumber := fn ; - NOfTextAreas := 1 ; - NOfSavedTextAreas := 0 ; - TextAreas[1] := RegionTextArea ; - TextColumns[1] := RegionTextArea ; - nxy[fpos] := nxy[tpos] := nxy[wpos] := nxy[ppos] := RealPageNumber ; - elseif ignore_multi_par_page : - RealPageNumber := fn ; - nxy[fpos] := nxy[tpos] := nxy[wpos] := nxy[ppos] := RealPageNumber ; - fi ; - - numeric par_strut_height, par_strut_depth, par_line_height ; - - set_par_line_height (ph, pd) ; - - numeric par_hang_indent, par_hang_after, par_indent, par_left_skip, par_right_skip ; - - par_hang_indent := rh ; - par_hang_after := ra ; - par_indent := ri ; - par_left_skip := rl ; - par_right_skip := rr ; - - pair par_start_pos ; - pair par_stop_pos ; - - par_start_pos := llxy[fpos] - if par_indent <0: shifted (-par_indent, 0) fi - if par_left_skip<0: shifted (-par_left_skip,0) fi ; - - par_stop_pos := lrxy[tpos] - if par_right_skip<0: shifted (par_right_skip,0) fi ; % nasty as the endpos can be shifted by rightskip - - if wxy[wpos]>0 : - left_skip := rl + xpart llxy[wpos] - xpart llxy[ppos] ; - right_skip := rw - left_skip - ww ; - else : - left_skip := rl ; - right_skip := rr ; - fi ; - - path multipar, multipars[] ; - numeric multiref, multirefs[] ; - numeric multiloc, multilocs[] ; % 1=begin 2=between 3=end - - numeric multi_par_pages ; multi_par_pages := nxy[tpos]-nxy[fpos]+1 ; - - % locals .. why can't i move these outside? - - vardef _pmp_set_multipar_ (expr i) = - ( (TextAreas[i] leftenlarged -left_skip) rightenlarged (-right_skip - if auto_multi_par_hsize : + rw - bbwidth(TextAreas[i]) fi) ) - enddef ; - - vardef _pmp_snapped_multi_pos_ (expr p) = - if snap_multi_par_tops : - if abs(ypart p - ypart ulcorner multipar) < par_line_height : - (xpart p,ypart ulcorner multipar) - else : - p - fi - else : - p - fi - enddef ; - - vardef _pmp_estimated_par_lines_ (expr h) = - round(h/par_line_height) - enddef ; - - vardef _pmp_top_multi_par_(expr p) = - (round(_pmp_estimated_par_lines_(bbheight(p)*par_line_height))=round(bbheight(p))) - enddef ; - - vardef _pmp_multi_par_tsc_(expr p) = - if _pmp_top_multi_par_(p) : TopSkipCorrection else : 0 fi - enddef ; - - vardef _pmp_estimated_multi_par_height_ (expr n, t) = - if round(par_line_height)=0 : - 0 - else : - save ok, h ; boolean ok ; - numeric h ; h := 0 ; - ok := false ; - if (nxy[fpos]=RealPageNumber-1) : - for i := 1 upto NOfSavedTextAreas : - if (InsideSavedTextArea(i,par_start_pos)) : - ok := true ; - h := h + _pmp_estimated_par_lines_(ypart ulxy[fpos] - ypart llcorner SavedTextAreas[i]) ; - elseif ok : - h := h + _pmp_estimated_par_lines_(bbheight(SavedTextAreas[i])) ; - fi ; - endfor ; - fi ; - if ok : - for i := 1 upto n-1 : - h := h + _pmp_estimated_par_lines_(bbheight(TextAreas[i])) ; - endfor ; - else : - % already: ok := false ; - for i := 1 upto n-1 : - if (InsideTextArea(i,par_start_pos)) : - ok := true ; - h := h + _pmp_estimated_par_lines_(ypart ulxy[fpos] - ypart llcorner TextAreas[i]) ; - elseif ok : - h := h + _pmp_estimated_par_lines_(bbheight(TextAreas[i])) ; - fi ; - endfor ; - fi ; - h - fi - enddef ; - - vardef _pmp_left_top_hang_ (expr same_area) = - - par_hang_after := ra + _pmp_estimated_par_lines_(py-fy) ; - - if (par_hang_indent>0) and (par_hang_after<0) and obey_multi_par_hang : - pair _ul_ ; _ul_ := (xpart ulcorner multipar, ypart _pmp_snapped_multi_pos_(ulxy[fpos])); - pair _pa_ ; _pa_ := _ul_ shifted (0,par_hang_after*par_line_height) ; - _pa_ := (xpart _pa_,max(ypart _pa_ -TopSkipCorrection,ypart llcorner multipar)) ; - if same_area : - _pa_ := (xpart _pa_,max(ypart _pa_ -TopSkipCorrection,ypart llxy[tpos])) ; - fi ; - if obey_multi_par_more and (round(par_line_height)>0) : - par_hang_after := min(0,round(par_hang_after + (ypart urxy[fpos]-ypart _pa_)/par_line_height)) ; - fi ; - (xpart _ul_ + par_hang_indent, ypart lrxy[fpos]) -- - (xpart _ul_ + par_hang_indent, ypart _pa_) -- - (xpart ulcorner multipar, ypart _pa_) - else : - (xpart ulcorner multipar, ypart lrxy[fpos]) - fi - enddef ; - - vardef _pmp_right_top_hang_ (expr same_area) = - - par_hang_after := ra + _pmp_estimated_par_lines_(py-fy) ; - - if (par_hang_indent<0) and (par_hang_after<0) and obey_multi_par_hang : - pair _ur_ ; _ur_ := (xpart urcorner multipar, ypart _pmp_snapped_multi_pos_(urxy[fpos])) ; - pair _pa_ ; _pa_ := _ur_ shifted (0,par_hang_after*par_line_height) ; - _pa_ := (xpart _pa_,max(ypart _pa_ -TopSkipCorrection,ypart llcorner multipar)) ; - if same_area : - _pa_ := (xpart _pa_,max(ypart _pa_ -TopSkipCorrection,ypart _pmp_snapped_multi_pos_(ulxy[tpos]))) ; - fi ; - if obey_multi_par_more and (round(par_line_height)>0) : - par_hang_after := min(0,round(par_hang_after + (ypart urxy[fpos]-ypart _pa_)/par_line_height)) ; - fi ; - (xpart urcorner multipar, ypart _pa_) -- - (xpart _ur_ + par_hang_indent, ypart _pa_) -- - (xpart _ur_ + par_hang_indent, ypart _pmp_snapped_multi_pos_(urxy[fpos])) - else : - (xpart urcorner multipar, ypart _pmp_snapped_multi_pos_(urxy[fpos])) - fi - enddef ; - - vardef _pmp_x_left_top_hang_ (expr i, t) = - par_hang_after := min(0,ra + _pmp_estimated_multi_par_height_(i,t)) ; - if (par_hang_indent>0) and (par_hang_after<0) : - pair _ul_ ; _ul_ := ulcorner multipar ; - pair _pa_ ; _pa_ := _ul_ shifted (0,par_hang_after*par_line_height) ; - _pa_ := (xpart _pa_,max(ypart _pa_,ypart llcorner multipar)) ; - if t : - _pa_ := (xpart _pa_,max(ypart _pa_,ypart llxy[tpos])); - fi ; - if abs(ypart _pa_-ypart llxy[tpos])<par_line_height : - _pa_ := (xpart _pa_,ypart llxy[tpos]); - fi ; - if abs(ypart _pa_-ypart llcorner multipar)<par_line_height : - _pa_ := (xpart _pa_,ypart llcorner multipar); - fi ; - (xpart _ul_, ypart _pa_) -- - (xpart _ul_ + par_hang_indent, ypart _pa_) -- - (xpart _ul_ + par_hang_indent, ypart _ul_) - else : - ulcorner multipar - fi - enddef ; - - vardef _pmp_x_right_top_hang_ (expr i, t) = - par_hang_after := min(0,ra + _pmp_estimated_multi_par_height_(i,t)) ; - if (par_hang_indent<0) and (par_hang_after<0) : - pair _ur_ ; _ur_ := urcorner multipar ; - pair _pa_ ; _pa_ := _ur_ shifted (0,par_hang_after*par_line_height) ; - _pa_ := (xpart _pa_,max(ypart _pa_,ypart lrcorner multipar)) ; - if t : - _pa_ := (xpart _pa_,max(ypart _pa_,ypart _pmp_snapped_multi_pos_(urxy[tpos]))) ; - fi ; - (xpart _ur_ + par_hang_indent, ypart _ur_) -- - (xpart _ur_ + par_hang_indent, ypart _pa_) -- - (xpart _ur_, ypart _pa_) - else : - urcorner multipar - fi - enddef ; - - vardef _pmp_left_bottom_hang_ (expr same_area) = - pair _ll_, _sa_, _pa_ ; - _sa_ := if same_area : llxy[tpos] else : lrcorner multipar fi ; - if (par_hang_indent>0) and (par_hang_after>0) and obey_multi_par_hang : - _ll_ := (xpart ulcorner multipar, ypart _pmp_snapped_multi_pos_(ulxy[fpos])) ; - _pa_ := _ll_ shifted (0,-par_hang_after*par_line_height) ; - _pa_ := (xpart _pa_,max(ypart _pa_,ypart llcorner multipar)) ; - if same_area : - _pa_ := (xpart _pa_,max(ypart _pa_,ypart _sa_)) ; - fi ; - if obey_multi_par_more and (round(par_line_height)>0) : - par_hang_after := max(0,round(par_hang_after - (ypart urxy[fpos]-ypart _pa_)/par_line_height)) ; - fi ; - _pa_ -- - (xpart _pa_ + par_hang_indent,ypart _pa_) -- - (xpart _pa_ + par_hang_indent,ypart _sa_) - else : - (xpart llcorner multipar, ypart _sa_) - fi - enddef ; - - vardef _pmp_right_bottom_hang_ (expr same_area) = - pair _lr_, _sa_, _pa_ ; - _sa_ := if same_area : _pmp_snapped_multi_pos_(ulxy[tpos]) else : lrcorner multipar fi ; - if (par_hang_indent<0) and (par_hang_after>0) and obey_multi_par_hang : - _lr_ := (xpart urcorner multipar, ypart _pmp_snapped_multi_pos_(urxy[fpos])) ; - _pa_ := _lr_ shifted (0,-par_hang_after*par_line_height) ; - _pa_ := (xpart _pa_,max(ypart _pa_,ypart lrcorner multipar)) ; - if same_area : - _pa_ := (xpart _pa_,max(ypart _pa_,ypart _pmp_snapped_multi_pos_(ulxy[tpos]))) ; - fi ; - if obey_multi_par_more and (round(par_line_height)>0) : - par_hang_after := max(0,round(par_hang_after - (ypart urxy[fpos]-ypart _pa_)/par_line_height)) ; - fi ; - (xpart _pa_ + par_hang_indent,ypart _sa_) -- - (xpart _pa_ + par_hang_indent,ypart _pa_) -- - _pa_ - else : - (xpart lrcorner multipar, ypart _sa_) - fi - enddef ; - - vardef _pmp_x_left_bottom_hang_ (expr i, t) = - pair _ll_, _sa_, _pa_ ; - _sa_ := if t : llxy[tpos] else : llcorner multipar fi ; - if (par_hang_indent>0) and (ra>0) : - par_hang_after := max(0,ra - _pmp_estimated_multi_par_height_(i,t)) ; - _ll_ := ulcorner multipar ; - _pa_ := _ll_ shifted (0,-par_hang_after*par_line_height) ; - _pa_ := (xpart _pa_,max(ypart _pa_,ypart llcorner multipar)) ; - _pa_ := (xpart _pa_,max(ypart _pa_,ypart _sa_)) ; - % we need to compensate for topskip enlarged areas - if abs(ypart _pa_ - ypart _sa_) > par_line_height : - (xpart _pa_ + par_hang_indent,ypart _sa_) -- - (xpart _pa_ + par_hang_indent,ypart _pa_) -- - fi - _pa_ - else : - (xpart llcorner multipar, ypart _sa_) - fi - enddef ; - - vardef _pmp_x_right_bottom_hang_ (expr i, t) = - pair _lr_, _sa_, _pa_ ; - _sa_ := if t : _pmp_snapped_multi_pos_(ulxy[tpos]) else : llcorner multipar fi ; - if (par_hang_indent<0) and (ra>0) : - par_hang_after := max(0,ra - _pmp_estimated_multi_par_height_(i, t)) ; - _lr_ := urcorner multipar ; - _pa_ := _lr_ shifted (0,-par_hang_after*par_line_height) ; - _pa_ := (xpart _pa_,max(ypart _pa_,ypart lrcorner multipar)) ; - _pa_ := (xpart _pa_,max(ypart _pa_,ypart _sa_)) ; - % we need to compensate for topskip enlarged areas - _pa_ - if abs(ypart _pa_ - ypart _sa_) > par_line_height : - -- (xpart _pa_ + par_hang_indent,ypart _pa_) - -- (xpart _pa_ + par_hang_indent,ypart _sa_) - fi - else : - (xpart lrcorner multipar, ypart _sa_) - fi - enddef ; - - % def _pmp_test_multipar_ = - % multipar := boundingbox multipar ; - % enddef ; - - % first loop - - ii := 0 ; nn := NOfTextAreas+1 ; nofmultipars := 0 ; - - if enable_multi_par_fallback and (nxy[fpos]=RealPageNumber) - and (nxy[tpos]=RealPageNumber) and not (InsideSomeTextArea(lxy[fpos]) and InsideSomeTextArea(rxy[tpos])) : - - % fallback - - % multipar := - % llxy[fpos] -- - % lrxy[tpos] -- - % urxy[tpos] -- - % ulxy[fpos] -- cycle ; - % - % save_multipar (1,1,multipar) ; - - % we need to take the boundingbox because there can be - % more lines and we want a proper rectange - - multipar := - ulxy[fpos] -- - urxy[tpos] -- - lrxy[fpos] -- - llxy[tpos] -- cycle ; - - save_multipar (1,1,boundingbox(multipar)) ; - - else : - - % normal - - for i=1 upto NOfTextAreas : - - TopSkipCorrection := 0 ; - - multipar := _pmp_set_multipar_(i) ; - - % watch how we compensate for negative indentation - - if (nxy[fpos]=RealPageNumber) and (InsideTextArea(i,par_start_pos)) : - - % first one in chain - - ii := i ; - - if (nxy[tpos]=RealPageNumber) and (InsideTextArea(i,par_stop_pos)) : - - % in same area - - nn := i ; - - if compensate_multi_par_topskip and (round(LineHeight-ph-pd)=0) : - - TopSkipCorrection := TopSkip - StrutHeight ; - - if round(ypart ulxy[fpos] + TopSkipCorrection) = round(ypart ulcorner TextAreas[i]) : - ulxy[fpos] := ulxy[fpos] shifted (0,TopSkipCorrection) ; - urxy[fpos] := urxy[fpos] shifted (0,TopSkipCorrection) ; - else : - TopSkipCorrection := 0 ; - fi ; - - fi ; - - if ypart llxy[fpos] = ypart llxy[tpos] : - - multipar := - llxy[fpos] -- - lrxy[tpos] -- - _pmp_snapped_multi_pos_(urxy[tpos]) -- - _pmp_snapped_multi_pos_(ulxy[fpos]) -- - cycle ; - - save_multipar (i,1,multipar) ; - - elseif (ypart llxy[fpos] = ypart ulxy[tpos]) and (xpart llxy[tpos] < xpart llxy[fpos]) : - - % two loners - - multipar := if obey_multi_par_hang : - - _pmp_right_bottom_hang_(true) -- - _pmp_right_top_hang_(true) -- - _pmp_snapped_multi_pos_(urxy[fpos]) -- - lrxy[fpos] -- - - else : - - llxy[fpos] -- - (xpart urcorner multipar, ypart llxy[fpos]) -- - (xpart urcorner multipar, ypart ulxy[fpos]) -- - _pmp_snapped_multi_pos_(ulxy[fpos]) -- - - fi cycle ; - - save_multipar (i,1,multipar) ; - - multipar := _pmp_set_multipar_(i) ; - - multipar := if obey_multi_par_hang : - - _pmp_left_bottom_hang_(true) -- - llxy[tpos] -- - _pmp_snapped_multi_pos_(ulxy[tpos]) -- - _pmp_left_top_hang_(true) -- - - else : - - (xpart llcorner multipar, ypart llxy[tpos]) -- - llxy[tpos] -- - _pmp_snapped_multi_pos_(ulxy[tpos]) -- - (xpart llcorner multipar, ypart ulxy[tpos]) -- - - fi cycle ; - - save_multipar (i,1,multipar) ; - - else : - - multipar := if obey_multi_par_hang : - - _pmp_left_bottom_hang_(true) -- - llxy[tpos] -- - _pmp_snapped_multi_pos_(ulxy[tpos]) -- - _pmp_right_bottom_hang_(true) -- - _pmp_right_top_hang_(true) -- - _pmp_snapped_multi_pos_(urxy[fpos]) -- - lrxy[fpos] -- - _pmp_left_top_hang_(true) -- - - else : - - (xpart llcorner multipar, ypart llxy[tpos]) -- - llxy[tpos] -- - _pmp_snapped_multi_pos_(ulxy[tpos]) -- - (xpart lrcorner multipar, ypart ulxy[tpos]) -- - (xpart urcorner multipar, ypart urxy[fpos]) -- - _pmp_snapped_multi_pos_(urxy[fpos]) -- - lrxy[fpos] -- - (xpart ulcorner multipar, ypart lrxy[fpos]) -- - - fi cycle ; - - save_multipar (i,1,multipar) ; - - fi ; - - else : - - multipar := if obey_multi_par_hang : - - _pmp_left_bottom_hang_(false) -- - _pmp_right_bottom_hang_(false) -- - _pmp_right_top_hang_(false) -- - _pmp_snapped_multi_pos_(urxy[fpos]) -- - lrxy[fpos] -- - _pmp_left_top_hang_(false) -- - - else : - - llcorner multipar -- - lrcorner multipar -- - (xpart urcorner multipar, ypart urxy[fpos]) -- - _pmp_snapped_multi_pos_(urxy[fpos]) -- - lrxy[fpos] -- - (xpart ulcorner multipar, ypart lrxy[fpos]) -- - - fi cycle ; - - save_multipar (i,1,multipar) ; - - fi ; - - elseif (nxy[tpos]=RealPageNumber) and (InsideTextArea(i,par_stop_pos)) : - - % last one in chain - - nn := i ; - - if obey_multi_par_hang and obey_multi_par_more : - - multipar := - _pmp_x_left_top_hang_(i,true) -- - _pmp_x_right_top_hang_(i,true) -- - _pmp_x_right_bottom_hang_(i,true) -- - _pmp_snapped_multi_pos_(ulxy[tpos]) -- - llxy[tpos] -- - _pmp_x_left_bottom_hang_(i,true) -- - cycle ; - - else : - - multipar := - ulcorner multipar -- - urcorner multipar -- - (xpart lrcorner multipar, ypart urxy[tpos]) -- - _pmp_snapped_multi_pos_(ulxy[tpos]) -- - llxy[tpos] -- - (xpart llcorner multipar, ypart llxy[tpos]) -- - cycle ; - - fi ; - - save_multipar (i,3,multipar) ; - - elseif multi_column_first_page_hack and ((nxy[fpos]=RealPageNumber) and (nxy[tpos]>=RealPageNumber) and (NOfTextColumns>1)) : - - save_multipar (i,2,multipar) ; - - else : - % handled later - fi ; - - endfor ; - - - % second loop - - if force_multi_par_chain or (ii > 1) : - - for i=ii+1 upto nn-1 : - - % rest of chain / todo : hang - - % hm, the second+ column in column sets now gets lost in a NOfTextColumns - - if (not check_multi_par_chain) or ((nxy[fpos]<RealPageNumber) and (nxy[tpos]>RealPageNumber)) : - - multipar := _pmp_set_multipar_(i) ; - - if obey_multi_par_hang and obey_multi_par_more : - - multipar := - _pmp_x_left_top_hang_(i,false) -- - _pmp_x_right_top_hang_(i,false) -- - _pmp_x_right_bottom_hang_(i,false) -- - _pmp_x_left_bottom_hang_(i,false) -- - cycle ; - - fi ; - - save_multipar(i,2,multipar) ; - - fi ; - - endfor ; - - fi ; - - % end of normal/fallback - - fi ; - - if span_multi_column_pars : - endgroup ; - fi ; - - % potential safeguard: - - % for i=1 upto nofmultipars : - % if length p <= 4 : - % multipars[i] := boundingbox(multipars[i]) ; - % fi ; - % end ; - - % quick hack for gb: - - one_piece_multi_par := (nofmultipars=1) and (pn=tn) ; - -enddef ; - -def boxgridoptions = withcolor .8red enddef ; -def boxlineoptions = withcolor .8blue enddef ; -def boxfilloptions = withcolor .8white enddef ; - -numeric boxgridtype ; boxgridtype := 0 ; -numeric boxlinetype ; boxlinetype := 1 ; -numeric boxfilltype ; boxfilltype := 1 ; -numeric boxdashtype ; boxdashtype := 0 ; -pair boxgriddirection ; boxgriddirection := up ; -numeric boxgridwidth ; boxgridwidth := 1pt ; -numeric boxlinewidth ; boxlinewidth := 1pt ; -numeric boxlineradius ; boxlineradius := 0pt ; -numeric boxfilloffset ; boxfilloffset := 0pt ; -numeric boxgriddistance ; boxgriddistance := .5cm ; -numeric boxgridshift ; boxgridshift := 0pt ; - -% def draw_box = -% draw pxy boxlineoptions withpen pencircle scaled boxlinewidth ; -% draw lxy -- rxy boxlineoptions withpen pencircle scaled boxgridwidth ; -% enddef ; - -def draw_par = % 1 2 3 11 12 - do_draw_par(pxy) ; do_draw_par(txy) ; do_draw_par(bxy) ; - for i = pxy, txy, bxy : - if boxgridtype = 1 : - boxgriddirection := origin ; - draw baseline_grid (i,boxgriddirection,true ) boxgridoptions ; - elseif boxgridtype = 2 : - boxgriddirection := origin ; - draw baseline_grid (i,boxgriddirection,false) boxgridoptions ; - elseif boxgridtype = 3 : - boxgriddirection := origin ; - draw baseline_grid (i,boxgriddirection,true ) boxgridoptions ; - draw baseline_grid (i,boxgriddirection,true ) shifted (0,ExHeight) boxgridoptions ; - elseif boxgridtype = 4 : - boxgriddirection := origin ; - draw baseline_grid (i,boxgriddirection,true ) shifted (0,ExHeight/2) boxgridoptions ; - elseif boxgridtype = 11 : - draw graphic_grid(i,boxgriddistance,boxgriddistance,boxgriddistance/2,boxgriddistance/2) ; - elseif boxgridtype = 12 : - draw graphic_grid(i,boxgriddistance,boxgriddistance,0,0) ; - fi ; - endfor ; -enddef ; - -def do_show_par (expr p, r, c) = - if length(p) > 2 : - for i=0 upto length(p) : - draw fullcircle scaled r shifted point i of p withpen pencircle scaled .5pt withcolor c ; - endfor ; - fi ; - draw p withpen pencircle scaled .5pt withcolor c ; -enddef ; - -def show_par = - if length(mxy) > 2 : - draw mxy dashed evenly withpen pencircle scaled .5pt withcolor .5white ; - fi ; - do_show_par(txy, 4pt, .5green) ; - do_show_par(bxy, 6pt, .5blue ) ; - do_show_par(pxy, 8pt, .5red ) ; - draw pref withpen pencircle scaled 2pt ; -enddef ; - -def sort_multi_pars = - if nofmultipars>1 : - begingroup ; - save _p_, _n_ ; path _p_ ; numeric _n_ ; - for i := 1 upto nofmultipars : - if multilocs[i] = 3 : - _p_ := multipars[nofmultipars] ; - multipars[nofmultipars] := multipars[i] ; - multipars[i] := _p_ ; - _n_ := multirefs[nofmultipars] ; - multirefs[nofmultipars] := multirefs[i] ; - multirefs[i] := _n_ ; - _n_ := multilocs[nofmultipars] ; - multilocs[nofmultipars] := multilocs[i] ; - multilocs[i] := _n_ ; - fi ; - endfor ; - endgroup ; - fi ; -enddef ; - -def collapse_multi_pars = - if nofmultipars>1 : - begingroup ; - save _nofmultipars_ ; numeric _nofmultipars_ ; - _nofmultipars_ := 1 ; - sort_multi_pars ; % block not in order: 1, 3, 2.... - for i:=1 upto nofmultipars-1 : - if (round(xpart(llcorner multipars[i]-llcorner multipars[i+1]))=0) and - (round(xpart(lrcorner multipars[i]-lrcorner multipars[i+1]))=0) : - multilocs[_nofmultipars_] := multilocs[i+1] ; - multirefs[_nofmultipars_] := multirefs[i+1] ; - multipars[_nofmultipars_] := - ulcorner multipars[_nofmultipars_] -- - urcorner multipars[_nofmultipars_] -- - lrcorner multipars[i+1] -- - llcorner multipars[i+1] -- cycle ; - else : - _nofmultipars_ := _nofmultipars_ + 1 ; - multipars[_nofmultipars_] := multipars[i+1] ; - multilocs[_nofmultipars_] := multilocs[i+1] ; - multirefs[_nofmultipars_] := multirefs[i+1] ; - fi ; - endfor ; - nofmultipars := _nofmultipars_ ; - endgroup ; - fi ; -enddef ; - -def draw_multi_pars = - for i=1 upto nofmultipars : - do_draw_par(multipars[i]) ; - if boxgridtype= 1 : - draw baseline_grid (multipars[i],if multilocs[i]=1: down else: up fi,true) ; - elseif boxgridtype= 2 : - draw baseline_grid (multipars[i],if multilocs[i]=1: down else: up fi,false) ; - elseif boxgridtype= 3 : - draw baseline_grid (multipars[i],if multilocs[i]=1: down else: up fi,true) ; - draw baseline_grid (multipars[i],if multilocs[i]=1: down else: up fi,true) shifted (0,ExHeight) ; - elseif boxgridtype= 4 : - draw baseline_grid (multipars[i],if multilocs[i]=1: down else: up fi,true) shifted (0,ExHeight/2) ; - elseif boxgridtype=11 : - draw graphic_grid(multipars[i],boxgriddistance,boxgriddistance,boxgriddistance/2,boxgriddistance/2) ; - elseif boxgridtype=12 : - draw graphic_grid(multipars[i],boxgriddistance,boxgriddistance,0,0) ; - fi ; - endfor ; -enddef ; - -def show_multi_pars = - for i=1 upto nofmultipars : - do_show_par(multipars[i], 6pt, .5blue) ; - endfor ; -enddef ; - -vardef do_draw_par (expr p) = - if (length p>2) and (bbwidth(p)>1) and (bbheight(p)>1) : - save pp ; path pp ; - if (boxlineradius>0) and (boxlinetype=2) : - pp := p cornered boxlineradius ; - else : - pp := p ; - fi ; - if boxfilltype>0 : - if boxfilloffset>0 : - % temporary hack - begingroup ; - interim linejoin := mitered ; - filldraw pp boxfilloptions withpen pencircle scaled (2*boxfilloffset) ; - endgroup ; - else : - fill pp boxfilloptions ; - fi ; - fi ; - if boxlinetype>0 : - draw pp boxlineoptions withpen pencircle scaled boxlinewidth ; - fi ; - fi ; -enddef ; - -vardef baseline_grid (expr pxy, pdir, at_baseline) = - save width ; width := bbwidth(pxy) ; - save height ; height := bbheight(pxy) ; - if (par_line_height>0) and (height>1) and (width>1) and (boxgridwidth>0) : - save i, grid, bb ; picture grid ; pair start ; path bb ; - def _do_ (expr start) = - % 1 = normal, 2 = with background (i.e. no shine-through) - if boxdashtype = 2 : - draw start -- start shifted (width,0) - withpen pencircle scaled boxgridwidth - boxfilloptions ; - fi ; - draw start -- start shifted (width,0) - if boxdashtype > 0 : - dashed evenly - fi - withpen pencircle scaled boxgridwidth - boxgridoptions ; - enddef ; - grid := image ( % fails with inlinespace - if pdir=up : - for i = if at_baseline : par_strut_depth else : 0 fi step par_line_height until max(height,par_line_height) : - _do_ (llcorner pxy shifted (0,+i)) ; - endfor ; - else : - for i = if at_baseline : par_strut_height else : 0 fi step par_line_height until height : - _do_ (ulcorner pxy shifted (0,-i)) ; - endfor ; - fi ; - ) ; - clip grid to pxy ; - bb := boundingbox grid ; - grid := grid shifted (0,boxgridshift) ; - setbounds grid to bb ; - grid - else : - nullpicture - fi -enddef ; - -vardef graphic_grid (expr pxy, dx, dy, x, y) = - if (bbheight(pxy)>dy) and (bbwidth(pxy)>dx) and (boxgridwidth>0) : - save grid ; picture grid ; - grid := image ( - for i = xpart llcorner pxy step dx until xpart lrcorner pxy : - draw (i,ypart llcorner pxy) -- (i,ypart ulcorner pxy) withpen pencircle scaled boxgridwidth ; - endfor ; - for i = ypart llcorner pxy step dy until ypart ulcorner pxy : - draw (xpart llcorner pxy,i) -- (xpart lrcorner pxy,i) withpen pencircle scaled boxgridwidth ; - endfor - ) shifted (x,y) ; - clip grid to pxy ; - grid - else : - nullpicture - fi -enddef ; - -def anchor_box (expr n,x,y,w,h,d) = - currentpicture := currentpicture shifted (-x,-y) ; -enddef ; - -let draw_area = draw_box ; -let anchor_area = anchor_box ; -let anchor_par = anchor_box ; - -numeric sync_n[], sync_p[][], sync_w[][], sync_h[][], sync_d[][], sync_t[][] ; -pair sync_xy[][] ; color sync_c[][] ; - -def ResetSyncTasks = - path SyncPaths[] ; numeric SyncTasks[], NOfSyncPaths, CurrentSyncClass ; - NOfSyncPaths := CurrentSyncClass := 0 ; - if unknown SyncLeftOffset : numeric SyncLeftOffset ; SyncLeftOffset := 0 ; fi ; - if unknown SyncWidth : numeric SyncWidth ; SyncWidth := 0 ; fi ; - if unknown SyncThreshold : numeric SyncThreshold ; SyncThreshold := LineHeight ; fi ; - if unknown SyncColor : color SyncColor ; SyncColor := .5white ; fi ; - if (SyncLeftOffset = 0) and (SyncWidth = 0) : - SyncWidth := if known TextWidth : TextWidth else : -1cm fi ; - fi ; -enddef ; - -ResetSyncTasks ; - -vardef SyncBox(expr n, i, leftoffset, width, topoffset, bottomoffset) = - save o ; pair o ; o := (xpart llcorner PlainTextArea,ypart sync_xy[n][i]) ; - o shifted (leftoffset,sync_h[n][i]+topoffset) -- - o shifted (width+leftoffset,sync_h[n][i]+topoffset) -- - o shifted (width+leftoffset,bottomoffset) -- - o shifted (leftoffset,bottomoffset) -- cycle -enddef ; - -def SetSyncColor(expr n, i, c) = - sync_c[n][i] := c ; -enddef ; - -def SetSyncThreshold(expr n, i, th) = - sync_th[n][i] := th ; -enddef ; - -vardef TheSyncColor(expr n, i) = - if known sync_c[n][i] : sync_c[n][i] else : SyncColor fi -enddef ; - -vardef TheSyncThreshold(expr n, i) = - if known sync_th[n][i] : sync_th[n][i] else : SyncThreshold fi -enddef ; - -vardef PrepareSyncTasks(expr n, collapse, extendtop, prestartnext) = - ResetSyncTasks ; - if known sync_n[n] : - CurrentSyncClass := n ; - save ok, l, d ; boolean ok ; ok := false ; NOfSyncPaths := l := 0 ; - for i=1 upto sync_n[n] : - if RealPageNumber > sync_p[n][i] : - l := i ; - elseif RealPageNumber = sync_p[n][i] : - NOfSyncPaths := NOfSyncPaths + 1 ; - if not ok : - if i>1 : - if sync_t[n][i-1] = sync_t[n][i] : - SyncPaths[NOfSyncPaths] := SyncBox(n, i, SyncLeftOffset, SyncWidth, PaperHeight, -PaperHeight) ; - SyncTasks[NOfSyncPaths] := i ; - else : - SyncPaths[NOfSyncPaths] := SyncBox(n, i-1, SyncLeftOffset, SyncWidth, PaperHeight, -PaperHeight) ; - SyncTasks[NOfSyncPaths] := i-1 ; - NOfSyncPaths := NOfSyncPaths + 1 ; - SyncPaths[NOfSyncPaths] := SyncBox(n, i, SyncLeftOffset, SyncWidth, 0, -PaperHeight) ; - SyncTasks[NOfSyncPaths] := i ; - fi ; - else : - SyncPaths[NOfSyncPaths] := SyncBox(n, i, SyncLeftOffset, SyncWidth, 0, -PaperHeight) ; - SyncTasks[NOfSyncPaths] := i ; - fi ; - else : - SyncPaths[NOfSyncPaths] := SyncBox(n, i, SyncLeftOffset, SyncWidth, 0, -PaperHeight) ; - SyncTasks[NOfSyncPaths] := i ; - fi ; - ok := true ; - fi ; - endfor ; - if (NOfSyncPaths = 0) and (l > 0) : - NOfSyncPaths := 1 ; - SyncPaths[NOfSyncPaths] := SyncBox(n, l, SyncLeftOffset, SyncWidth, PaperHeight, -PaperHeight) ; - SyncTasks[NOfSyncPaths] := l ; - fi ; - if NOfSyncPaths > 0 : - for i = 1 upto NOfSyncPaths-1 : - SyncPaths[i] := topboundary SyncPaths[i] -- reverse topboundary SyncPaths[i+1] -- cycle ; - endfor ; - if unknown SyncThresholdMethod : - numeric SyncThresholdMethod ; SyncThresholdMethod := 2 ; - fi ; - if extendtop : - if SyncThresholdMethod = 1 : - if NOfSyncPaths>1 : - d := ypart (ulcorner PlainTextArea - sync_xy[n][SyncTasks[2]]) ; - if (SyncTasks[2]>1) and (d > 0pt) and (d <= TheSyncThreshold(n,sync_t[n][SyncTasks[2]])) and (sync_p[n][SyncTasks[2]] = RealPageNumber) : - SyncPaths[2] := SyncPaths[2] topenlarged PaperHeight ; - fi ; - fi ; - else : - for i = 1 upto NOfSyncPaths : - d := ypart (ulcorner PlainTextArea - sync_xy[n][SyncTasks[i]]) ; - if (d > 0) and (d <= TheSyncThreshold(n,sync_t[n][SyncTasks[i]])) and (sync_p[n][SyncTasks[i]] = RealPageNumber) : - SyncPaths[i] := SyncPaths[i] topenlarged PaperHeight ; - fi ; - endfor ; - fi ; - fi ; - if prestartnext : - if NOfSyncPaths>1 : - if SyncTasks[NOfSyncPaths] < sync_n[n] : % there is a next one - d := ypart (ulcorner PlainTextArea - sync_xy[n][SyncTasks[NOfSyncPaths]+1]) ; - if (d > 0) and (d <= TheSyncThreshold(n, sync_t[n][SyncTasks[i]])) and (sync_p[n][SyncTasks[NOfSyncPaths]+1] = RealPageNumber+1) : - SyncPaths[NOfSyncPaths+1] := - (xpart ulcorner SyncPaths[NOfSyncPaths],ypart llcorner PlainTextArea) -- - (xpart urcorner SyncPaths[NOfSyncPaths],ypart llcorner PlainTextArea) -- - lrcorner SyncPaths[NOfSyncPaths] -- - llcorner SyncPaths[NOfSyncPaths] -- cycle ; - SyncTasks[NOfSyncPaths+1] := SyncTasks[NOfSyncPaths]+1 ; - NOfSyncPaths := NOfSyncPaths + 1 ; - fi ; - fi ; - fi ; - else : - if NOfSyncPaths>1 : - d := ypart (sync_xy[n][SyncTasks[NOfSyncPaths]] - llcorner PlainTextArea) ; - if (d < TheSyncThreshold(n, SyncTasks[NOfSyncPaths])) : - NOfSyncPaths := NOfSyncPaths - 1 ; - SyncPaths[NOfSyncPaths] := SyncPaths[NOfSyncPaths] bottomenlarged PaperHeight ; - fi ; - fi ; - fi ; - if (NOfSyncPaths>1) and collapse : - save j ; numeric j ; j := 1 ; - for i = 2 upto NOfSyncPaths : - if sync_t[n][SyncTasks[i]] = sync_t[n][SyncTasks[j]] : - SyncPaths[j] := boundingbox image (draw SyncPaths[i] ; draw SyncPaths[j] ; ) ; - SyncTasks[j] := SyncTasks[i] ; - else : - j := j + 1 ; - SyncPaths[j] := SyncPaths[i] ; - SyncTasks[j] := SyncTasks[i] ; - fi ; - endfor ; - NOfSyncPaths := j ; - fi ; - fi ; - fi ; -enddef ; - -def SyncTask(expr n) = - if known SyncTasks[n] : SyncTasks[n] else : 0 fi -enddef ; - -def FlushSyncTasks = - for i = 1 upto NOfSyncPaths : - ProcessSyncTask(SyncPaths[i], TheSyncColor(CurrentSyncClass,sync_t[CurrentSyncClass][SyncTasks[i]])) ; - endfor ; -enddef ; - -def ProcessSyncTask(expr p, c) = - fill p withcolor c ; -enddef ; diff --git a/Master/texmf-dist/metapost/context/base/mpiv/mp-grap.mpiv b/Master/texmf-dist/metapost/context/base/mpiv/mp-grap.mpiv index 0299c0587a1..2288307e4e1 100644 --- a/Master/texmf-dist/metapost/context/base/mpiv/mp-grap.mpiv +++ b/Master/texmf-dist/metapost/context/base/mpiv/mp-grap.mpiv @@ -24,6 +24,10 @@ if numbersystem <> "double" : endinput ; fi +if known contextlmtxmode : + def _op_ = base_draw_options enddef ; +fi ; + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % $Id : graph.mp,v 1.2 2004/09/19 21 :47 :10 karl Exp $ @@ -102,17 +106,23 @@ vardef logten primary x = else: mlog(abs x)/mlog(10) fi enddef ; -vardef ln primary x = - if unknown x: whatever - elseif x=0: Mzero - else: mlog(abs x)/256 fi -enddef ; +if known contextlmtxmode : + % already defined +else : -vardef exp primary x = - if unknown x: whatever - elseif x<= Mzero: 0 - else: (mexp 256)**x fi -enddef ; + vardef ln primary x = + if unknown x: whatever + elseif x=0: Mzero + else: mlog(abs x)/256 fi + enddef ; + + vardef exp primary x = + if unknown x: whatever + elseif x<= Mzero: 0 + else: (mexp 256)**x fi + enddef ; + +fi vardef powten primary x = if unknown x: whatever @@ -1151,7 +1161,9 @@ enddef ; % We format in luatex (using \mathematics{}) ... % we could pass via variables and save escaping as that is inefficient -if unknown context_mlib : +if known contextlmtxmode : +% already defined +elseif unknown context_mlib : vardef escaped_format(expr s) = "" for n=0 upto length(s) : & diff --git a/Master/texmf-dist/metapost/context/base/mpiv/mp-luas.mpiv b/Master/texmf-dist/metapost/context/base/mpiv/mp-luas.mpiv index 57937c0c162..2b1266a6cd6 100644 --- a/Master/texmf-dist/metapost/context/base/mpiv/mp-luas.mpiv +++ b/Master/texmf-dist/metapost/context/base/mpiv/mp-luas.mpiv @@ -149,6 +149,11 @@ def setdimen(expr k,v) = lua.mp._set_dimen_(k,v) enddef ; def setcount(expr k,v) = lua.mp._set_count_(k,v) enddef ; def settoks (expr k,v) = lua.mp._set_toks_ (k,v) enddef ; +def setglobalmacro(expr k,v) = lua.mp._set_global_macro_(k,v) enddef ; +def setglobaldimen(expr k,v) = lua.mp._set_global_dimen_(k,v) enddef ; +def setglobalcount(expr k,v) = lua.mp._set_global_count_(k,v) enddef ; +def setglobaltoks (expr k,v) = lua.mp._set_global_toks_ (k,v) enddef ; + vardef positionpath (expr name) = lua.mp.positionpath (name) enddef ; vardef positioncurve (expr name) = lua.mp.positioncurve (name) enddef ; vardef positionxy (expr name) = lua.mp.positionxy (name) enddef ; diff --git a/Master/texmf-dist/metapost/context/base/mpiv/mp-luas.mpxl b/Master/texmf-dist/metapost/context/base/mpiv/mp-luas.mpxl deleted file mode 100644 index 421e82946d0..00000000000 --- a/Master/texmf-dist/metapost/context/base/mpiv/mp-luas.mpxl +++ /dev/null @@ -1,250 +0,0 @@ -%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 context_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. - -boolean context_luas ; context_luas := true ; - -newinternal 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 ; - -def message expr t = - lua.mp.report(tostring(t)) ; -enddef ; - -% 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 - -newinternal mfid_resolvedcolor ; mfid_resolvedcolor := scriptindex "namedcolor" ; - -def resolvedcolor = runscript mfid_resolvedcolor enddef ; - -% Modes: - -vardef texmode (expr s) = lua.mp("mode", s) enddef ; -vardef systemmode(expr s) = lua.mp("systemmode",s) enddef ; - -% A few helpers - -vardef isarray suffix a = lua.mp.isarray (str a) enddef ; -vardef prefix suffix a = lua.mp.prefix (str a) enddef ; -vardef dimension suffix a = lua.mp.dimension(str a) enddef ; - -% More access - -vardef getmacro(expr k) = lua.mp._get_macro_(k) enddef ; -vardef getdimen(expr k) = lua.mp._get_dimen_(k) enddef ; -vardef getcount(expr k) = lua.mp._get_count_(k) enddef ; -vardef gettoks (expr k) = lua.mp._get_toks_ (k) enddef ; - -def setmacro(expr k,v) = lua.mp._set_macro_(k,v) enddef ; -def setdimen(expr k,v) = lua.mp._set_dimen_(k,v) enddef ; -def setcount(expr k,v) = lua.mp._set_count_(k,v) enddef ; -def settoks (expr k,v) = lua.mp._set_toks_ (k,v) enddef ; - -vardef positionpath (expr name) = lua.mp.positionpath (name) enddef ; -vardef positioncurve (expr name) = lua.mp.positioncurve (name) enddef ; -vardef positionxy (expr name) = lua.mp.positionxy (name) enddef ; -vardef positionpxy (expr name) = lua.mp.positionpxy (name) enddef ; -vardef positionwhd (expr name) = lua.mp.positionwhd (name) enddef ; -vardef positionpage (expr name) = lua.mp.positionpage (name) enddef ; -vardef positionregion(expr name) = lua.mp.positionregion(name) enddef ; -vardef positionbox (expr name) = lua.mp.positionbox (name) enddef ; -vardef positionanchor = lua.mp.positionanchor() enddef ; - -let wdpart = redpart ; -let htpart = greenpart ; -let dppart = bluepart ; - -vardef positioninregion = - currentpicture := currentpicture shifted - positionxy(positionanchor) ; -enddef ; - -vardef positionatanchor(expr name) = - currentpicture := currentpicture shifted - positionxy(name) ; -enddef ; - -vardef texvar(expr name) = lua.mp.texvar(name) enddef ; -vardef texstr(expr name) = lua.mp.texstr(name) enddef ; - -newinternal mfid_path_lengthof ; mfid_path_lengthof := scriptindex "pathlengthof" ; -newinternal mfid_path_pointof ; mfid_path_pointof := scriptindex "pathpointof" ; -newinternal mfid_path_leftof ; mfid_path_leftof := scriptindex "pathleftof" ; -newinternal mfid_path_rightof ; mfid_path_rightof := scriptindex "pathrightof" ; -newinternal 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 ; - -% 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 ; " ; - -vardef utflen(expr s) = lua.mp.utflen(s) enddef ; -vardef utfsub(expr s,f,t) = lua.mp.utfsub(s,f,t) enddef ; - -newinternal mfid_getparameters ; mfid_getparameters := scriptindex "getparameters" ; -newinternal mfid_presetparameters ; mfid_presetparameters := scriptindex "presetparameters" ; -newinternal mfid_hasparameter ; mfid_hasparameter := scriptindex "hasparameter" ; -newinternal mfid_hasoption ; mfid_hasoption := scriptindex "hasoption" ; -newinternal mfid_getparameter ; mfid_getparameter := scriptindex "getparameter" ; -newinternal mfid_getparameterdefault ; mfid_getparameterdefault := scriptindex "getparameterdefault" ; -newinternal mfid_getparametercount ; mfid_getparametercount := scriptindex "getparametercount" ; -newinternal mfid_getmaxparametercount ; mfid_getmaxparametercount := scriptindex "getmaxparametercount" ; -newinternal mfid_getparameterpath ; mfid_getparameterpath := scriptindex "getparameterpath" ; -newinternal mfid_getparameterpen ; mfid_getparameterpen := scriptindex "getparameterpen" ; -newinternal mfid_getparametertext ; mfid_getparametertext := scriptindex "getparametertext" ; -%%%%%%%%%%% mfid_getparameteroption ; mfid_getparameteroption := scriptindex "getparameteroption" ; -newinternal mfid_applyparameters ; mfid_applyparameters := scriptindex "applyparameters" ; -newinternal mfid_pushparameters ; mfid_pushparameters := scriptindex "pushparameters" ; -newinternal mfid_popparameters ; mfid_popparameters := scriptindex "popparameters" ; - -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 ; - -% This might also be done in stock mkiv: - -newinternal mfid_year ; mfid_year := scriptindex "year" ; vardef year = runscript mfid_year enddef ; -newinternal mfid_month ; mfid_month := scriptindex "month" ; vardef month = runscript mfid_month enddef ; -newinternal mfid_day ; mfid_day := scriptindex "day" ; vardef day = runscript mfid_day enddef ; -newinternal mfid_hour ; mfid_hour := scriptindex "hour" ; vardef hour = runscript mfid_hour enddef ; -newinternal mfid_minute ; mfid_minute := scriptindex "minute" ; vardef minute = runscript mfid_minute enddef ; -newinternal mfid_second ; mfid_second := scriptindex "second" ; vardef second = runscript mfid_second enddef ; - -% You cannot overload a local color bu using a prefix works ok: -% -% \definecolor [ name = "mp:myred", r = .9 ] ; - -newinternal mfid_definecolor ; mfid_definecolor := scriptindex "definecolor" ; - -def definecolor = runscript mfid_definecolor ; enddef ; % the semicolon prevents lookahead diff --git a/Master/texmf-dist/metapost/context/base/mpiv/mp-math.mpxl b/Master/texmf-dist/metapost/context/base/mpiv/mp-math.mpxl deleted file mode 100644 index ea8c1cd7c7a..00000000000 --- a/Master/texmf-dist/metapost/context/base/mpiv/mp-math.mpxl +++ /dev/null @@ -1,161 +0,0 @@ -%D \module -%D [ file=mp-math.mpiv, -%D version=2019.07.26, % was mp-core: 1999.08.01, anchoring -%D title=\CONTEXT\ \METAPOST\ graphics, -%D subtitle=extra math functions, -%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 context_math : endinput ; fi ; - -boolean context_math ; context_math := true ; - -% draw textext(decimal runscript("mp.numeric(xmath.gamma(.12))")) ; - -newinternal mfid_m_acos ; mfid_m_acos := scriptindex "m_acos" ; def m_acos = runscript mfid_m_acos enddef ; -newinternal mfid_m_acosh ; mfid_m_acosh := scriptindex "m_acosh" ; def m_acosh = runscript mfid_m_acosh enddef ; -newinternal mfid_m_asin ; mfid_m_asin := scriptindex "m_asin" ; def m_asin = runscript mfid_m_asin enddef ; -newinternal mfid_m_asinh ; mfid_m_asinh := scriptindex "m_asinh" ; def m_asinh = runscript mfid_m_asinh enddef ; -newinternal mfid_m_atan ; mfid_m_atan := scriptindex "m_atan" ; def m_atan = runscript mfid_m_atan enddef ; -newinternal mfid_m_atantwo ; mfid_m_atantwo := scriptindex "m_atan2" ; def m_atantwo = runscript mfid_m_atantwo enddef ; % atan2 -newinternal mfid_m_atanh ; mfid_m_atanh := scriptindex "m_atanh" ; def m_atanh = runscript mfid_m_atanh enddef ; -newinternal mfid_m_cbrt ; mfid_m_cbrt := scriptindex "m_cbrt" ; def m_cbrt = runscript mfid_m_cbrt enddef ; -newinternal mfid_m_ceil ; mfid_m_ceil := scriptindex "m_ceil" ; def m_ceil = runscript mfid_m_ceil enddef ; -newinternal mfid_m_copysign ; mfid_m_copysign := scriptindex "m_copysign" ; def m_copysign = runscript mfid_m_copysign enddef ; -newinternal mfid_m_cos ; mfid_m_cos := scriptindex "m_cos" ; def m_cos = runscript mfid_m_cos enddef ; -newinternal mfid_m_cosh ; mfid_m_cosh := scriptindex "m_cosh" ; def m_cosh = runscript mfid_m_cosh enddef ; -newinternal mfid_m_deg ; mfid_m_deg := scriptindex "m_deg" ; def m_deg = runscript mfid_m_deg enddef ; -newinternal mfid_m_erf ; mfid_m_erf := scriptindex "m_erf" ; def m_erf = runscript mfid_m_erf enddef ; -newinternal mfid_m_erfc ; mfid_m_erfc := scriptindex "m_erfc" ; def m_erfc = runscript mfid_m_erfc enddef ; -newinternal mfid_m_exp ; mfid_m_exp := scriptindex "m_exp" ; def m_exp = runscript mfid_m_exp enddef ; -newinternal mfid_m_exptwo ; mfid_m_exptwo := scriptindex "m_exp2" ; def m_exptwo = runscript mfid_m_exptwo enddef ; % exp2 -newinternal mfid_m_expm ; mfid_m_expm := scriptindex "m_expm1" ; def m_expm = runscript mfid_m_expm enddef ; % expm1 -newinternal mfid_m_fabs ; mfid_m_fabs := scriptindex "m_fabs" ; def m_fabs = runscript mfid_m_fabs enddef ; -newinternal mfid_m_fdim ; mfid_m_fdim := scriptindex "m_fdim" ; def m_fdim = runscript mfid_m_fdim enddef ; -newinternal mfid_m_floor ; mfid_m_floor := scriptindex "m_floor" ; def m_floor = runscript mfid_m_floor enddef ; -newinternal mfid_m_fma ; mfid_m_fma := scriptindex "m_fma" ; def m_fma = runscript mfid_m_fma enddef ; -newinternal mfid_m_fmax ; mfid_m_fmax := scriptindex "m_fmax" ; def m_fmax = runscript mfid_m_fmax enddef ; -newinternal mfid_m_fmin ; mfid_m_fmin := scriptindex "m_fmin" ; def m_fmin = runscript mfid_m_fmin enddef ; -newinternal mfid_m_fmod ; mfid_m_fmod := scriptindex "m_fmod" ; def m_fmod = runscript mfid_m_fmod enddef ; -newinternal mfid_m_frexp ; mfid_m_frexp := scriptindex "m_frexp" ; def m_frexp = runscript mfid_m_frexp enddef ; -newinternal mfid_m_gamma ; mfid_m_gamma := scriptindex "m_gamma" ; def m_gamma = runscript mfid_m_gamma enddef ; -newinternal mfid_m_hypot ; mfid_m_hypot := scriptindex "m_hypot" ; def m_hypot = runscript mfid_m_hypot enddef ; -newinternal mfid_m_isfinite ; mfid_m_isfinite := scriptindex "m_isfinite" ; def m_isfinite = runscript mfid_m_isfinite enddef ; -newinternal mfid_m_isinf ; mfid_m_isinf := scriptindex "m_isinf" ; def m_isinf = runscript mfid_m_isinf enddef ; -newinternal mfid_m_isnan ; mfid_m_isnan := scriptindex "m_isnan" ; def m_isnan = runscript mfid_m_isnan enddef ; -newinternal mfid_m_isnormal ; mfid_m_isnormal := scriptindex "m_isnormal" ; def m_isnormal = runscript mfid_m_isnormal enddef ; -newinternal mfid_m_jz ; mfid_m_jz := scriptindex "m_j0" ; def m_jz = runscript mfid_m_jz enddef ; % j0 -newinternal mfid_m_j ; mfid_m_j := scriptindex "m_j1" ; def m_j = runscript mfid_m_j enddef ; % j1 -newinternal mfid_m_jn ; mfid_m_jn := scriptindex "m_jn" ; def m_jn = runscript mfid_m_jn enddef ; -newinternal mfid_m_ldexp ; mfid_m_ldexp := scriptindex "m_ldexp" ; def m_ldexp = runscript mfid_m_ldexp enddef ; -newinternal mfid_m_lgamma ; mfid_m_lgamma := scriptindex "m_lgamma" ; def m_lgamma = runscript mfid_m_lgamma enddef ; -newinternal mfid_m_log ; mfid_m_log := scriptindex "m_log" ; def m_log = runscript mfid_m_log enddef ; -newinternal mfid_m_logten ; mfid_m_logte := scriptindex "m_log10" ; def m_logten = runscript mfid_m_logten enddef ; % log10 -newinternal mfid_m_logp ; mfid_m_logp := scriptindex "m_log1p" ; def m_logp = runscript mfid_m_logp enddef ; % log1p -newinternal mfid_m_logtwo ; mfid_m_logtwo := scriptindex "m_log2" ; def m_logtwo = runscript mfid_m_logtwo enddef ; % log2 -newinternal mfid_m_logb ; mfid_m_logb := scriptindex "m_logb" ; def m_logb = runscript mfid_m_logb enddef ; -newinternal mfid_m_modf ; mfid_m_modf := scriptindex "m_modf" ; def m_modf = runscript mfid_m_modf enddef ; -newinternal mfid_m_nearbyint ; mfid_m_nearbyint := scriptindex "m_nearbyint" ; def m_nearbyint = runscript mfid_m_nearbyint enddef ; -newinternal mfid_m_nextafter ; mfid_m_nextafter := scriptindex "m_nextafter" ; def m_nextafter = runscript mfid_m_nextafter enddef ; -newinternal mfid_m_pow ; mfid_m_pow := scriptindex "m_pow" ; def m_pow = runscript mfid_m_pow enddef ; -newinternal mfid_m_rad ; mfid_m_rad := scriptindex "m_rad" ; def m_rad = runscript mfid_m_rad enddef ; -newinternal mfid_m_remainder ; mfid_m_remainder := scriptindex "m_remainder" ; def m_remainder = runscript mfid_m_remainder enddef ; -newinternal mfid_m_remquo ; mfid_m_remquo := scriptindex "m_remquo" ; def m_remquo = runscript mfid_m_remquo enddef ; -newinternal mfid_m_round ; mfid_m_round := scriptindex "m_round" ; def m_round = runscript mfid_m_round enddef ; -newinternal mfid_m_scalbn ; mfid_m_scalbn := scriptindex "m_scalbn" ; def m_scalbn = runscript mfid_m_scalbn enddef ; -newinternal mfid_m_sin ; mfid_m_sin := scriptindex "m_sin" ; def m_sin = runscript mfid_m_sin enddef ; -newinternal mfid_m_sinh ; mfid_m_sinh := scriptindex "m_sinh" ; def m_sinh = runscript mfid_m_sinh enddef ; -newinternal mfid_m_sqrt ; mfid_m_sqrt := scriptindex "m_sqrt" ; def m_sqrt = runscript mfid_m_sqrt enddef ; -newinternal mfid_m_tan ; mfid_m_tan := scriptindex "m_tan" ; def m_tan = runscript mfid_m_tan enddef ; -newinternal mfid_m_tanh ; mfid_m_tanh := scriptindex "m_tanh" ; def m_tanh = runscript mfid_m_tanh enddef ; -newinternal mfid_m_tgamma ; mfid_m_tgamma := scriptindex "m_tgamma" ; def m_tgamma = runscript mfid_m_tgamma enddef ; -newinternal mfid_m_trunc ; mfid_m_trunc := scriptindex "m_trunc" ; def m_trunc = runscript mfid_m_trunc enddef ; -newinternal mfid_m_yz ; mfid_m_yz := scriptindex "m_y0" ; def m_yz = runscript mfid_m_yz enddef ; % y0 -newinternal mfid_m_y ; mfid_m_y := scriptindex "m_y1" ; def m_y = runscript mfid_m_y enddef ; % y1 -newinternal mfid_m_yn ; mfid_m_yn := scriptindex "m_yn" ; def m_yn = runscript mfid_m_yn enddef ; - -newinternal mfid_c_sin ; mfid_c_asin := scriptindex "c_sin" ; def c_sin = runscript mfid_c_sin enddef ; -newinternal mfid_c_cos ; mfid_c_acos := scriptindex "c_cos" ; def c_cos = runscript mfid_c_cos enddef ; -newinternal mfid_c_tan ; mfid_c_acos := scriptindex "c_tan" ; def c_tan = runscript mfid_c_tan enddef ; -newinternal mfid_c_sinh ; mfid_c_acos := scriptindex "c_sinh" ; def c_sinh = runscript mfid_c_sinh enddef ; -newinternal mfid_c_cosh ; mfid_c_acos := scriptindex "c_cosh" ; def c_cosh = runscript mfid_c_cosh enddef ; -newinternal mfid_c_tanh ; mfid_c_acos := scriptindex "c_tanh" ; def c_tanh = runscript mfid_c_tanh enddef ; - -newinternal mfid_c_asin ; mfid_c_acos := scriptindex "c_asin" ; def c_asin = runscript mfid_c_asin enddef ; -newinternal mfid_c_acos ; mfid_c_acos := scriptindex "c_acos" ; def c_acos = runscript mfid_c_acos enddef ; -newinternal mfid_c_atan ; mfid_c_acos := scriptindex "c_atan" ; def c_atan = runscript mfid_c_atan enddef ; -newinternal mfid_c_asinh ; mfid_c_acos := scriptindex "c_asinh" ; def c_asinh = runscript mfid_c_asinh enddef ; -newinternal mfid_c_acosh ; mfid_c_acos := scriptindex "c_acosh" ; def c_acosh = runscript mfid_c_acosh enddef ; -newinternal mfid_c_atanh ; mfid_c_acos := scriptindex "c_atanh" ; def c_atanh = runscript mfid_c_atanh enddef ; - -newinternal mfid_c_sqrt ; mfid_c_acos := scriptindex "c_sqrt" ; def c_sqrt = runscript mfid_c_sqrt enddef ; -newinternal mfid_c_abs ; mfid_c_acos := scriptindex "c_abs" ; def c_abs = runscript mfid_c_abs enddef ; -newinternal mfid_c_arg ; mfid_c_acos := scriptindex "c_arg" ; def c_arg = runscript mfid_c_arg enddef ; -newinternal mfid_c_conj ; mfid_c_acos := scriptindex "c_conj" ; def c_conj = runscript mfid_c_conj enddef ; -newinternal mfid_c_exp ; mfid_c_acos := scriptindex "c_exp" ; def c_exp = runscript mfid_c_exp enddef ; -newinternal mfid_c_log ; mfid_c_acos := scriptindex "c_log" ; def c_log = runscript mfid_c_log enddef ; -newinternal mfid_c_proj ; mfid_c_acos := scriptindex "c_proj" ; def c_proj = runscript mfid_c_proj enddef ; - -newinternal mfid_c_erf ; mfid_c_erf := scriptindex "c_erf" ; def c_erf = runscript mfid_c_erf enddef ; -newinternal mfid_c_erfc ; mfid_c_erfc := scriptindex "c_erfc" ; def c_erfc = runscript mfid_c_erfc enddef ; -newinternal mfid_c_erfcx ; mfid_c_erfcx := scriptindex "c_erfcx" ; def c_erfcx = runscript mfid_c_erfcx enddef ; -newinternal mfid_c_erfi ; mfid_c_erfi := scriptindex "c_erfi" ; def c_erfi = runscript mfid_c_erfi enddef ; - -% mfid_c_imag ; mfid_c_acos := scriptindex "c_imag" ; def c_imag = runscript mfid_c_imag enddef ; -% mfid_c_real ; mfid_c_acos := scriptindex "c_real" ; def c_real = runscript mfid_c_real enddef ; -% mfid_c_neg ; mfid_c_neg := scriptindex "c_neg" ; def c_neg = runscript mfid_c_neg enddef ; - -newinternal mfid_c_pow ; mfid_c_pow := scriptindex "c_pow" ; def c_pow (expr a,b) = runscript mfid_c_pow a b enddef ; -% mfid_c_add ; mfid_c_add := scriptindex "c_add" ; def c_add (expr a,b) = runscript mfid_c_add a b enddef ; -% mfid_c_sub ; mfid_c_sub := scriptindex "c_sub" ; def c_sub (expr a,b) = runscript mfid_c_sub a b enddef ; -newinternal mfid_c_mul ; mfid_c_mul := scriptindex "c_mul" ; def c_mul (expr a,b) = runscript mfid_c_mul a b enddef ; -newinternal mfid_c_div ; mfid_c_div := scriptindex "c_div" ; def c_div (expr a,b) = runscript mfid_c_div a b enddef ; - -newinternal mfid_c_voigt ; mfid_c_voigt := scriptindex "c_voigt" ; def c_voigt (expr a,b,c) = runscript mfid_c_voigt a b c enddef ; -newinternal mfid_c_voigt_hwhm ; mfid_c_voigt_hwhm := scriptindex "c_voigt_hwhm" ; def c_voigt_hwhm(expr a,b) = runscript mfid_c_voigt_hwhm a b enddef ; - -vardef c_add (expr a, b) = a + b enddef ; -vardef c_sub (expr a, b) = a + b enddef ; -vardef c_imag(expr a) = ypart a enddef ; -vardef c_real(expr a) = xpart a enddef ; -vardef c_neg (expr a) = -a enddef ; - -if (numbersystem == "scaled") or (numbersystem == "double") : - - % vardef sqrt primary x = m_sqrt x enddef ; - - % vardef sqr primary x = x*x enddef ; - % vardef log primary x = if x=0: 0 else: mlog(x)/mlog(10) fi enddef ; - % vardef ln primary x = if x=0: 0 else: mlog(x)/256 fi enddef ; - % vardef exp primary x = (mexp 256)**x enddef ; - % vardef inv primary x = if x=0: 0 else: x**-1 fi enddef ; - - vardef sin primary x = m_sin x enddef ; vardef sinh primary x = m_sinh x enddef ; - vardef cos primary x = m_cos x enddef ; vardef cosh primary x = m_cosh x enddef ; - vardef tan primary x = m_tan x enddef ; vardef tanh primary x = m_tanh x enddef ; - vardef asin primary x = m_asin x enddef ; vardef asinh primary x = m_asinh x enddef ; - vardef acos primary x = m_acos x enddef ; vardef acosh primary x = m_acosh x enddef ; - vardef atan primary x = m_atan x enddef ; vardef atanh primary x = m_atanh x enddef ; - - vardef invsin primary x = (m_asin(x))/radian enddef ; - vardef invcos primary x = (m_acos(x))/radian enddef ; - vardef invtan primary x = (m_atan(x))/radian enddef ; - - - % vardef sind primary x = angle(m_sin x) enddef ; - % vardef cosd primary x = angle(m_cos x) enddef ; - % vardef tand primary x = angle(m_tan x) enddef ; - - vardef asind primary x = angle(m_asin x) enddef ; - vardef acosd primary x = angle(m_acos x) enddef ; - vardef atand primary x = angle(m_atan x) enddef ; - - % vardef tand primary x = sind(x)/cosd(x) enddef ; - % vardef cotd primary x = cosd(x)/sind(x) enddef ; - -fi ; diff --git a/Master/texmf-dist/metapost/context/base/mpiv/mp-mlib.mpiv b/Master/texmf-dist/metapost/context/base/mpiv/mp-mlib.mpiv index 88bf566749a..fe00b55356d 100644 --- a/Master/texmf-dist/metapost/context/base/mpiv/mp-mlib.mpiv +++ b/Master/texmf-dist/metapost/context/base/mpiv/mp-mlib.mpiv @@ -112,12 +112,14 @@ def transparent(expr a, t)(text c) = % use withtransparency instead withcolor c enddef ; -% def withtransparency(expr a, t) = -% withprescript "tr_alternative=" & decimal transparency_alternative_to_number(a) -% withprescript "tr_transparency=" & decimal t -% enddef ; +def withtransparency(expr a, t) = + withprescript "tr_alternative=" & decimal transparency_alternative_to_number(a) + withprescript "tr_transparency=" & decimal t +enddef ; -let transparency = pair ; +% no, not compatible ... maybe only mpiv .. maybe withopacity + +% let opacity = pair ; % def withtransparency expr t = % withprescript "tr_alternative=" & decimal transparency_alternative_to_number(xpart t) @@ -126,22 +128,28 @@ let transparency = pair ; % % withtransparency (1,.5) % withtransparency ("normal",.5) +% +% withopacity (1,.5) +% withopacity (normaltransparency,.5) +% withopacity .5 -def withtransparency (expr t) (text rest) = +def withopacity expr t = if pair t : withprescript "tr_alternative=" & decimal transparency_alternative_to_number(xpart t) withprescript "tr_transparency=" & decimal ypart t else : - mfun_with_transparency (transparency_alternative_to_number(t)) - fi rest + mfun_with_opacity (transparency_alternative_to_number(t)) + fi enddef ; -def mfun_with_transparency (expr a) expr t = +def mfun_with_opacity (expr a) expr t = withprescript "tr_alternative=" & decimal a withprescript "tr_transparency=" & decimal t enddef ; -def cmyk(expr c, m, y, k) = % provided for downward compability +% Provided for downward compability: + +def cmyk(expr c, m, y, k) = (c,m,y,k) enddef ; @@ -198,6 +206,17 @@ enddef ; rgbcolor mfun_tt_r ; +newinternal inicatcoderegime ; inicatcoderegime := runscript("return catcodes.numbers.ctxcatcodes") ; +newinternal texcatcoderegime ; texcatcoderegime := runscript("return catcodes.numbers.texcatcodes") ; +newinternal luacatcoderegime ; luacatcoderegime := runscript("return catcodes.numbers.luacatcodes") ; +newinternal notcatcoderegime ; notcatcoderegime := runscript("return catcodes.numbers.notcatcodes") ; +newinternal vrbcatcoderegime ; vrbcatcoderegime := runscript("return catcodes.numbers.vrbcatcodes") ; +newinternal prtcatcoderegime ; prtcatcoderegime := runscript("return catcodes.numbers.prtcatcodes") ; +newinternal ctxcatcoderegime ; ctxcatcoderegime := runscript("return catcodes.numbers.ctxcatcodes") ; +newinternal txtcatcoderegime ; txtcatcoderegime := runscript("return catcodes.numbers.txtcatcodes") ; + +newinternal catcoderegime ; catcoderegime := ctxcatcoderegime ; + vardef rawtextext(expr s) = if s = "" : nullpicture @@ -206,7 +225,7 @@ vardef rawtextext(expr s) = mfun_tt_c := nullpicture ; mfun_tt_o := nullpicture ; addto mfun_tt_o doublepath origin _op_ ; % save drawoptions - mfun_tt_r := lua.mp.mf_some_text(mfun_tt_n,s) ; + mfun_tt_r := lua.mp.mf_some_text(mfun_tt_n,s,catcoderegime) ; addto mfun_tt_c doublepath unitsquare xscaled wdpart mfun_tt_r yscaled (htpart mfun_tt_r + dppart mfun_tt_r) diff --git a/Master/texmf-dist/metapost/context/base/mpiv/mp-page.mpxl b/Master/texmf-dist/metapost/context/base/mpiv/mp-page.mpxl deleted file mode 100644 index 8a4b735e016..00000000000 --- a/Master/texmf-dist/metapost/context/base/mpiv/mp-page.mpxl +++ /dev/null @@ -1,243 +0,0 @@ -%D \module -%D [ file=mp-page.mpiv, -%D version=1999.03.10, -%D title=\CONTEXT\ \METAPOST\ graphics, -%D subtitle=page enhancements, -%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. - -%D This module is rather preliminary and subjected to changes.In the process of -%D moving to \METAFUN2\ this might change. - -if known context_page : endinput ; fi ; - -boolean context_page ; context_page := true ; - -def LoadPageState = enddef ; % just in case some old style uses it - -% Next we implement the the page area model. First some constants. - -LeftEdge := -4 ; Top := -40 ; -LeftEdgeSeparator := -3 ; TopSeparator := -30 ; -LeftMargin := -2 ; Header := -20 ; -LeftMarginSeparator := -1 ; HeaderSeparator := -10 ; -Text := 0 ; Text := 0 ; -RightMarginSeparator := +1 ; FooterSeparator := +10 ; -RightMargin := +2 ; Footer := +20 ; -RightEdgeSeparator := +3 ; BottomSeparator := +30 ; -RightEdge := +4 ; Bottom := +40 ; - -numeric HorPos ; HorPos := 0 ; -numeric VerPos ; VerPos := 0 ; - -% Because metapost > 1.50 has dynamic memory management and is less efficient than -% before we now delay calculations ... (on a document with 150 pages the time spent -% in mp was close to 5 seconds which was only due to initialising the page related -% areas, something that was hardly noticeable before. At least now we're back to -% half a second for such a case. - -def SetPageVsize = - numeric Vsize[] ; - Vsize[Top] = TopHeight ; - Vsize[TopSeparator] = TopDistance ; - Vsize[Header] = HeaderHeight ; - Vsize[HeaderSeparator] = HeaderDistance ; - Vsize[Text] = TextHeight ; - Vsize[FooterSeparator] = FooterDistance ; - Vsize[Footer] = FooterHeight ; - Vsize[BottomSeparator] = BottomDistance ; - Vsize[Bottom] = BottomHeight ; -enddef ; - -def SetPageHsize = - numeric Hsize[] ; - Hsize[LeftEdge] = LeftEdgeWidth ; - Hsize[LeftEdgeSeparator] = LeftEdgeDistance ; - Hsize[LeftMargin] = LeftMarginWidth ; - Hsize[LeftMarginSeparator] = LeftMarginDistance ; - Hsize[Text] = MakeupWidth ; - Hsize[RightMarginSeparator] = RightMarginDistance ; - Hsize[RightMargin] = RightMarginWidth ; - Hsize[RightEdgeSeparator] = RightEdgeDistance ; - Hsize[RightEdge] = RightEdgeWidth ; -enddef ; - -def SetPageVstep = - numeric Vstep[] ; - Vstep[Top] = Vstep[TopSeparator] +Vsize[TopSeparator] ; - Vstep[TopSeparator] = PaperHeight-TopSpace ; - Vstep[Header] = Vstep[TopSeparator] -Vsize[Header] ; - Vstep[HeaderSeparator] = Vstep[Header] -Vsize[HeaderSeparator] ; - Vstep[Text] = Vstep[HeaderSeparator]-Vsize[Text] ; - Vstep[FooterSeparator] = Vstep[Text] -Vsize[FooterSeparator] ; - Vstep[Footer] = Vstep[FooterSeparator]-Vsize[Footer] ; - Vstep[BottomSeparator] = Vstep[Footer] -Vsize[BottomSeparator] ; - Vstep[Bottom] = Vstep[BottomSeparator]-Vsize[Bottom] ; -enddef ; - -def SetPageHstep = - numeric Hstep[] ; - Hstep[LeftEdge] = Hstep[LeftEdgeSeparator] -Hsize[LeftEdge] ; - Hstep[LeftEdgeSeparator] = Hstep[LeftMargin] -Hsize[LeftEdgeSeparator] ; - Hstep[LeftMargin] = Hstep[LeftMarginSeparator] -Hsize[LeftMargin] ; - Hstep[LeftMarginSeparator] = Hstep[Text] -Hsize[LeftMarginSeparator] ; - Hstep[Text] = BackSpace ; - Hstep[RightMarginSeparator] = Hstep[Text] +Hsize[Text] ; - Hstep[RightMargin] = Hstep[RightMarginSeparator]+Hsize[RightMarginSeparator] ; - Hstep[RightEdgeSeparator] = Hstep[RightMargin] +Hsize[RightMargin] ; - Hstep[RightEdge] = Hstep[RightEdgeSeparator] +Hsize[RightEdgeSeparator] ; -enddef ; - -def SetPageArea = - path Area[][] ; - for VerPos=Top step 10 until Bottom: - for HorPos=LeftEdge step 1 until RightEdge: - Area[HorPos][VerPos] := unitsquare xscaled Hsize[HorPos] yscaled Vsize[VerPos] ; - Area[VerPos][HorPos] := Area[HorPos][VerPos] ; - endfor ; - endfor ; -enddef ; - -def SetPageLocation = - pair Location[][] ; - for VerPos=Top step 10 until Bottom: - for HorPos=LeftEdge step 1 until RightEdge: - Location[HorPos][VerPos] := (Hstep[HorPos],Vstep[VerPos]) ; - Location[VerPos][HorPos] := Location[HorPos][VerPos] ; - endfor ; - endfor ; -enddef ; - -def SetPageField = - path Field[][] ; - for VerPos=Top step 10 until Bottom: - for HorPos=LeftEdge step 1 until RightEdge: - Field[HorPos][VerPos] := unitsquare xscaled Hsize[HorPos] yscaled Vsize[VerPos] shifted (Hstep[HorPos],Vstep[VerPos]) ; - Field[VerPos][HorPos] := Field[HorPos][VerPos] ; - endfor ; - endfor ; -enddef ; - -def Area = hide(SetPageArea ;) Area enddef ; -def Location = hide(SetPageLocation ;) Location enddef ; -def Field = hide(SetPageField ;) Field enddef ; -def Vsize = hide(SetPageVsize ;) Vsize enddef ; -def Hsize = hide(SetPageHsize ;) Hsize enddef ; -def Vstep = hide(SetPageVstep ;) Vstep enddef ; -def Hstep = hide(SetPageHstep ;) Hstep enddef ; - -vardef FrontPageWidth = PaperWidth enddef ; -vardef BackPageWidth = PaperWidth enddef ; -vardef CoverWidth = 2 * PaperWidth + SpineWidth enddef ; -vardef CoverHeight = PaperHeight enddef ; - -vardef FrontPageHeight = PaperHeight enddef ; -vardef BackPageHeight = PaperHeight enddef ; -vardef SpineHeight = PaperHeight enddef ; - -def SetPagePage = path Page ; Page := unitsquare xscaled PaperWidth yscaled PaperHeight ; enddef ; -def SetPageCoverPage = path CoverPage ; CoverPage := unitsquare xscaled CoverWidth yscaled CoverHeight ; enddef ; -def SetPageSpine = path Spine ; Spine := unitsquare xscaled SpineWidth yscaled CoverHeight shifted (BackPageWidth,0) ; enddef ; -def SetPageBackPage = path BackPage ; BackPage := unitsquare xscaled BackPageWidth yscaled CoverHeight ; enddef ; -def SetPageFrontPage = path FrontPage ; FrontPage := unitsquare xscaled FrontPageWidth yscaled CoverHeight shifted (BackPageWidth+SpineWidth,0) ; enddef ; - -def Page = hide(SetPagePage ;) Page enddef ; -def CoverPage = hide(SetPageCoverPage;) CoverPage enddef ; -def Spine = hide(SetPageSpine ;) Spine enddef ; -def BackPage = hide(SetPageBackPage ;) BackPage enddef ; -def FrontPage = hide(SetPageFrontPage;) FrontPage enddef ; - -% pages - -def StartPage = - begingroup ; - setbounds currentpicture to Page ; -enddef ; - -def StopPage = - setbounds currentpicture to Page ; - endgroup ; -enddef ; - -% cover pages - -def StartCover = - begingroup ; - setbounds currentpicture to CoverPage enlarged PaperBleed ; -enddef ; - -def StopCover = - setbounds currentpicture to CoverPage enlarged PaperBleed ; - endgroup ; -enddef ; - -% overlays: - -def OverlayBox = - (unitsquare xyscaled (OverlayWidth,OverlayHeight)) -enddef ; - -% handy - -def innerenlarged = - if OnRightPage : leftenlarged else : rightenlarged fi -enddef ; - -def outerenlarged = - if OnRightPage : rightenlarged else : leftenlarged fi -enddef ; - -% obsolete - -% def llEnlarged (expr p,d) = (llcorner p shifted (-d,-d)) enddef ; -% def lrEnlarged (expr p,d) = (lrcorner p shifted (+d,-d)) enddef ; -% def urEnlarged (expr p,d) = (urcorner p shifted (+d,+d)) enddef ; -% def ulEnlarged (expr p,d) = (ulcorner p shifted (-d,+d)) enddef ; - -% def Enlarged (expr p, d) = -% ( -% llEnlarged (p,d) -- -% lrEnlarged (p,d) -- -% urEnlarged (p,d) -- -% ulEnlarged (p,d) -- -% cycle -% ) -% enddef ; - -% for the moment we put these here: - -string RuleDirection ; RuleDirection := "" ; -string RuleOption ; RuleOption := "" ; -numeric RuleWidth ; RuleWidth := 0 ; -numeric RuleHeight ; RuleHeight := 0 ; -numeric RuleDepth ; RuleDepth := 0 ; -numeric RuleH ; RuleH := 0 ; -numeric RuleV ; RuleV := 0 ; -numeric RuleThickness ; RuleThickness := 0 ; -numeric RuleFactor ; RuleFactor := 0 ; -numeric RuleOffset ; RuleOffset := 0 ; - def RuleColor = (.5white) enddef ; - -def FakeWord(expr RuleWidth, RuleHeight, RuleDepth, RuleThickness) (text RuleColor) = - fill unitsquare - xscaled RuleWidth - yscaled (RuleDepth-RuleThickness/2) - withcolor RuleColor ; - fill unitsquare - xscaled RuleWidth - yscaled (RuleHeight-RuleDepth-RuleThickness/2) - shifted (0,RuleDepth+RuleThickness) - withcolor RuleColor ; -enddef ; - -def FakeRule(expr RuleWidth, RuleHeight, RuleDepth, RuleThickness) (text RuleColor) = - fill unitsquare - xscaled RuleWidth - yscaled RuleHeight - withcolor RuleColor ; -enddef ; diff --git a/Master/texmf-dist/metapost/context/base/mpiv/mp-tool.mpiv b/Master/texmf-dist/metapost/context/base/mpiv/mp-tool.mpiv index 3a5dfa81e62..c84d8dfbfbd 100644 --- a/Master/texmf-dist/metapost/context/base/mpiv/mp-tool.mpiv +++ b/Master/texmf-dist/metapost/context/base/mpiv/mp-tool.mpiv @@ -1164,7 +1164,7 @@ primarydef p randomized s = ( elseif pair p : p randomshifted s elseif cmykcolor p : - if color s : + if cmykcolor s : ((uniformdeviate cyanpart s) * cyanpart p, (uniformdeviate magentapart s) * magentapart p, (uniformdeviate yellowpart s) * yellowpart p, @@ -1175,7 +1175,7 @@ primarydef p randomized s = ( ((uniformdeviate s) * p) fi elseif rgbcolor p : - if color s : + if rgbcolor s : ((uniformdeviate redpart s) * redpart p, (uniformdeviate greenpart s) * greenpart p, (uniformdeviate bluepart s) * bluepart p) @@ -2205,7 +2205,9 @@ enddef ; primarydef p enlonged len = begingroup - if pair p : + if len == 0 : + p + elseif pair p : save q ; path q ; q := origin -- p ; save al ; al := arclength(q) ; if al > 0 : @@ -2228,8 +2230,12 @@ enddef ; % drawarrow p withcolor red ; % drawarrow p shortened 1cm withcolor green ; +% primarydef p shortened d = +% reverse ( ( reverse (p enlonged -d) ) enlonged -d ) +% enddef ; + primarydef p shortened d = - reverse ( ( reverse (p enlonged -d) ) enlonged -d ) + reverse ( ( reverse (p enlonged -xpart paired(d)) ) enlonged -ypart paired(d) ) enddef ; % yes or no, untested -) @@ -3153,6 +3159,15 @@ def endglyph = endfig ; enddef ; +def beginfont(expr name) = + begingroup; + passvariable("fontname",name) ; +enddef ; + +def endfont = + endgroup; +enddef ; + %D Dimensions have never been an issue as traditional MP can't make that large %D pictures, but with double mode we need a catch: @@ -3341,7 +3356,7 @@ let dump = relax ; def loadmodule expr name = % no vardef % input can't be used directly in a macro - if unknown scantokens("context_" & name) : + if (unknown scantokens("context_" & name)) and (unknown scantokens("metafun_loaded_" & name)) : save s ; string s ; % s := "mp-" & name & ".mpiv" ; % message("loading module",s) ; diff --git a/Master/texmf-dist/metapost/context/base/mpxl/metafun.mpxl b/Master/texmf-dist/metapost/context/base/mpxl/metafun.mpxl new file mode 100644 index 00000000000..7f953012037 --- /dev/null +++ b/Master/texmf-dist/metapost/context/base/mpxl/metafun.mpxl @@ -0,0 +1,62 @@ +%D \module +%D [ file=metafun.mp, +%D version=2000.07.15, +%D title=\CONTEXT\ \METAPOST\ graphics, +%D subtitle=format generation file, +%D author=Hans Hagen, +%D date=\currentdate, +%D copyright={PRAGMA / Hans Hagen \& Ton Otten}] +%C +%C This module is part of the \CONTEXT\ macro||package and is +%C therefore copyrighted by \PRAGMA. See mreadme.pdf for +%C details. + +%D First we input John Hobby's metapost plain file. However, because we want to +%D prevent dependency problems and in the end even may use a patched version, +%D we prefer to use a copy. + +% We only get a callback when the property > 0 + +def primitive = setproperty 1 : enddef; % not to be used +def permanent = setproperty 2 : enddef; +def immutable = setproperty 3 : enddef; +def frozen = setproperty 4 : enddef; % not yet used +def mutable = setproperty -3 : enddef; % not yet used + +permanent permanent, immutable, mutable, primitive, frozen ; % we reserve frozen + +newinternal boolean contextlmtxmode ; contextlmtxmode := true ; immutable contextlmtxmode ; + +% But it will move here: + +input "mp-base.mpxl" ; +input "mp-tool.mpxl" ; +input "mp-luas.mpxl" ; +input "mp-mlib.mpxl" ; +input "mp-math.mpxl" ; +input "mp-cont.mpxl" ; +input "mp-page.mpxl" ; +input "mp-butt.mpxl" ; +input "mp-shap.mpxl" ; +input "mp-grph.mpxl" ; +input "mp-grid.mpxl" ; +input "mp-form.mpxl" ; +input "mp-figs.mpxl" ; +input "mp-func.mpxl" ; +input "mp-node.mpxl" ; +input "mp-apos.mpxl" ; +input "mp-abck.mpxl" ; +input "mp-blob.mpxl" ; +input "mp-lmtx.mpxl" ; +input "mp-text.mpxl" ; + +newinternal string metafunversion ; metafunversion := "metafun xl " & mfun_timestamp; + +immutable metafunversion ; + +let normalend = end ; + +def end = ; message "" ; message metafunversion ; message "" ; endinput ; enddef ; +def bye = ; message "" ; message metafunversion ; message "" ; endinput ; enddef ; + +overloadmode := 1 ; diff --git a/Master/texmf-dist/metapost/context/base/mpiv/minifun.mpxl b/Master/texmf-dist/metapost/context/base/mpxl/minifun.mpxl index 6769d26e4a9..e1b1cda3650 100644 --- a/Master/texmf-dist/metapost/context/base/mpiv/minifun.mpxl +++ b/Master/texmf-dist/metapost/context/base/mpxl/minifun.mpxl @@ -14,20 +14,25 @@ %D This is a minimal \METAFUN\ instance which can be handy for isolated %D subruns. -boolean contextlmtxmode ; contextlmtxmode := if known fontmaking : false else: true fi; +def primitive = setproperty 1 : enddef; % not to be used +def permanent = setproperty 2 : enddef; +def immutable = setproperty 3 : enddef; +def frozen = setproperty 4 : enddef; % not yet used +def mutable = setproperty -3 : enddef; % not yet used -prologues := 0 ; -mpprocset := 1 ; +permanent permanent, immutable, mutable, primitive, frozen ; % we reserve frozen + +newinternal boolean contextlmtxmode ; contextlmtxmode := true ; immutable contextlmtxmode ; input "mp-base.mpiv" ; -input "mp-tool.mpiv" ; -input "mp-mlib.mpiv" ; +input "mp-tool.mpxl" ; +input "mp-mlib.mpxl" ; input "mp-luas.mpxl" ; input "mp-math.mpxl" ; input "mp-cont.mpxl" ; -input "mp-page.mpiv" ; +input "mp-page.mpxl" ; -string minifunversion ; minifunversion = "minifun xl " & mfun_timestamp; +newinternal string minifunversion ; minifunversion := "minifun xl " & mfun_timestamp; let normalend = end ; diff --git a/Master/texmf-dist/metapost/context/base/mpxl/mp-abck.mpxl b/Master/texmf-dist/metapost/context/base/mpxl/mp-abck.mpxl new file mode 100644 index 00000000000..c27758fa941 --- /dev/null +++ b/Master/texmf-dist/metapost/context/base/mpxl/mp-abck.mpxl @@ -0,0 +1,291 @@ +%D \module +%D [ file=mp-abck.mpiv, +%D version=2012.02.19, % was mp-core: 1999.08.01, anchoring +%D title=\CONTEXT\ \METAPOST\ graphics, +%D subtitle=anchored background macros, +%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_abck : endinput ; fi ; + +newinternal boolean metafun_loaded_abck ; metafun_loaded_abck := true ; immutable metafun_loaded_abck ; + +path multiregs[], % region used for multipar (tracing only) + multipars[], % effective area (shape) + multibox ; % main boundingbox (of main region) + +string multikind[] ; % region state: single | first | middle | last (new method) + +numeric multilocs[], % 1=begin 2=between 3=end (old method) + nofmultipars ; % number of calculated areas + +numeric par_strut_height, + par_strut_depth, + par_line_height ; + +nofmultipars := 0 ; +par_strut_height := 0 ; +par_strut_depth := 0 ; +par_line_height := 0 ; + +def boxgridoptions = withcolor .8red enddef ; +def boxlineoptions = withcolor .8blue enddef ; +def boxfilloptions = withcolor .8white enddef ; + +numeric boxgridtype ; boxgridtype := 0 ; +numeric boxlinetype ; boxlinetype := 1 ; +numeric boxfilltype ; boxfilltype := 1 ; +numeric boxdashtype ; boxdashtype := 0 ; +pair boxgriddirection ; boxgriddirection := up ; +numeric boxgridwidth ; boxgridwidth := 1pt ; +numeric boxlinewidth ; boxlinewidth := 1pt ; +numeric boxlineradius ; boxlineradius := 0 ; +numeric boxlineoffset ; boxlineoffset := 0 ; +numeric boxfilloffset ; boxfilloffset := 0 ; +numeric boxgriddistance ; boxgriddistance := .5cm ; +numeric boxgridshift ; boxgridshift := 0 ; + +permanent multipars, multiregs, multibox, multikind, multilocs, nofmultipars ; + +vardef abck_draw_path(expr p) = + if (length p > 2) and (bbwidth(p) > 1) and (bbheight(p) > 1) : + save pp ; path pp ; + pp := p if (boxlineradius>0) and (boxlinetype=2) : cornered boxlineradius fi ; + if boxfilltype > 0 : + if boxfilloffset > 0 : + interim linejoin := mitered ; + filldraw pp boxfilloptions withpen pencircle scaled (2*boxfilloffset) ; + else : + fill pp boxfilloptions ; + fi ; + fi ; + if boxlinetype > 0 : + draw pp boxlineoptions withpen pencircle scaled boxlinewidth ; + fi ; + fi ; +enddef ; + +def abck_grid_line(expr start, width) = + % 1 = normal, 2 = with background (i.e. no shine-through) + if boxdashtype = 2 : + draw start -- start shifted (width,0) + withpen pencircle scaled boxgridwidth + boxfilloptions ; + fi ; + draw start -- start shifted (width,0) + if boxdashtype > 0 : + dashed evenly + fi + withpen pencircle scaled boxgridwidth + boxgridoptions ; +enddef ; + +vardef abck_baseline_grid(expr pxy, pdir, at_baseline) = + save width ; width := bbwidth(pxy) ; + save height ; height := bbheight(pxy) ; + if (par_line_height > 0) and (height > 1) and (width > 1) and (boxgridwidth > 0) : + save i, grid, bb ; picture grid ; pair start ; path bb ; + grid := image ( % fails with inlinespace + if pdir = up : + for i = if at_baseline : par_strut_depth else : 0 fi step par_line_height until max(height,par_line_height) : + abck_grid_line(llcorner pxy shifted (0,+i),width) ; + endfor ; + else : + for i = if at_baseline : par_strut_height else : 0 fi step par_line_height until height : + abck_grid_line(ulcorner pxy shifted (0,-i),width) ; + endfor ; + fi ; + ) ; + clip grid to pxy ; + bb := boundingbox grid ; + grid := grid shifted (0,boxgridshift) ; + setbounds grid to bb ; + grid + else : + nullpicture + fi +enddef ; + +vardef abck_graphic_grid(expr pxy, dx, dy, x, y) = + if (bbheight(pxy) > dy) and (bbwidth(pxy) > dx) and (boxgridwidth > 0) : + save grid ; picture grid ; + grid := image ( + for i = xpart llcorner pxy step dx until xpart lrcorner pxy : + draw (i,ypart llcorner pxy) -- (i,ypart ulcorner pxy) withpen pencircle scaled boxgridwidth ; + endfor ; + for i = ypart llcorner pxy step dy until ypart ulcorner pxy : + draw (xpart llcorner pxy,i) -- (xpart lrcorner pxy,i) withpen pencircle scaled boxgridwidth ; + endfor + ) shifted (x,y) ; + clip grid to pxy ; + grid + else : + nullpicture + fi +enddef ; + +def draw_multi_pars = + for i=1 upto nofmultipars : + abck_draw_path(multipars[i]) ; + if boxgridtype = 1 : + draw abck_baseline_grid(multipars[i],if multilocs[i]=1: down else: up fi,true) ; + elseif boxgridtype = 2 : + draw abck_baseline_grid(multipars[i],if multilocs[i]=1: down else: up fi,false) ; + elseif boxgridtype = 3 : + draw abck_baseline_grid(multipars[i],if multilocs[i]=1: down else: up fi,true) ; + draw abck_baseline_grid(multipars[i],if multilocs[i]=1: down else: up fi,true) shifted (0,ExHeight) ; + elseif boxgridtype = 4 : + draw abck_baseline_grid(multipars[i],if multilocs[i]=1: down else: up fi,true) shifted (0,ExHeight/2) ; + elseif boxgridtype = 11 : + draw abck_graphic_grid(multipars[i],boxgriddistance,boxgriddistance,boxgriddistance/2,boxgriddistance/2) ; + elseif boxgridtype = 12 : + draw abck_graphic_grid(multipars[i],boxgriddistance,boxgriddistance,0,0) ; + fi ; + endfor ; +enddef ; + +def show_multi_pars = + for i=1 upto nofmultipars : + drawpathwithpoints multipars[i] withcolor .5blue ; + endfor ; +enddef ; + +def show_multi_kind = + for i=1 upto nofmultipars : + fill multipars[i] + withcolor + if multikind[i] = "single" : yellow + elseif multikind[i] = "first" : red + elseif multikind[i] = "middle" : green + elseif multikind[i] = "last" : blue + fi + withtransparency (1,.5) + ; + endfor ; +enddef ; + +def multi_side_draw_options = enddef ; + +def draw_multi_side = + begingroup ; save p ; picture p ; + for i=1 upto nofmultipars : + p := image ( fill leftboundary multipars[i] + shifted (-boxlineoffset,0) + rightenlarged boxlinewidth boxlineoptions ; + ) ; + setbounds p to multipars[i] ; + draw p ; + endfor ; + endgroup ; +enddef ; + +def draw_multi_side_path text t = + begingroup ; save p ; picture p ; + for i=1 upto nofmultipars : + p := image ( draw leftboundary multipars[i] + shifted (-boxlineoffset,0) + withpen pensquare scaled boxlinewidth boxlineoptions t ; + ) ; + setbounds p to multipars[i] ; + draw p ; + endfor ; + endgroup ; +enddef ; + +% some extras + +% For the moment we keep these as they can be in use but they will disappear. + +pair lxy[], rxy[], cxy[], llxy[], lrxy[], ulxy[], urxy[] ; +path pxy[] ; +numeric hxy[], wxy[], dxy[], nxy[] ; + +def box_found (expr n,x,y,w,h,d) = + not ((x=0) and (y=0) and (w=0) and (h=0) and (d=0)) +enddef ; + +def initialize_box_pos (expr pos,n,x,y,w,h,d) = + pair lxy, rxy, cxy, llxy, lrxy, ulxy, urxy ; + path pxy ; numeric hxy, wxy, dxy, nxy; + lxy := (x,y) ; + llxy := (x,y-d) ; + lrxy := (x+w,y-d) ; + urxy := (x+w,y+h) ; + ulxy := (x,y+h) ; + wxy := w ; + hxy := h ; + dxy := d ; + rxy := lxy shifted (wxy,0) ; + pxy := llxy--lrxy--urxy--ulxy--cycle ; + cxy := center pxy ; + nxy := n ; + freeze_box(pos) ; +enddef ; + +def freeze_box (expr pos) = + lxy[pos] := lxy ; + llxy[pos] := llxy ; + lrxy[pos] := lrxy ; + urxy[pos] := urxy ; + ulxy[pos] := ulxy ; + wxy[pos] := wxy ; + hxy[pos] := hxy ; + dxy[pos] := dxy ; + rxy[pos] := rxy ; + pxy[pos] := pxy ; + cxy[pos] := cxy ; + nxy[pos] := nxy ; +enddef ; + +def initialize_box (expr n,x,y,w,h,d) = + numeric bpos ; bpos := 0 ; initialize_box_pos(bpos,n,x,y,w,h,d) ; +enddef ; + +def anchor_box (expr n,x,y,w,h,d) = + currentpicture := currentpicture shifted (-x,-y) ; +enddef ; + +def draw_box = % for old times sake + draw pxy boxlineoptions withpen pencircle scaled boxlinewidth ; + draw lxy -- rxy boxlineoptions withpen pencircle scaled boxgridwidth ; +enddef ; + +def draw_free_region(expr width, height, depth, loffset, roffset, toffset, boffset) = + + begingroup ; save b, o, l ; path b, o, l[] ; save d ; + + b := fullsquare + xysized(width,height+depth) ; + o := b + topenlarged toffset + bottomenlarged boffset + leftenlarged loffset + rightenlarged roffset ; + d := max(PaperWidth,PaperHeight) ; + + fill o withcolor .5white ; + fill b withcolor .7white ; + + interim linecap := butt ; + + l[1] := topboundary (topboundary o leftenlarged d rightenlarged d) ; + l[2] := bottomboundary (bottomboundary o leftenlarged d rightenlarged d) ; + l[3] := leftboundary (leftboundary o topenlarged d bottomenlarged d) ; + l[4] := rightboundary (rightboundary o topenlarged d bottomenlarged d) ; + + for i=1 upto 4 : + draw l[i] withpen pencircle scaled 1bp withcolor white ; + draw l[i] withpen pencircle scaled 1bp dashed (evenly scaled 1bp) withcolor black ; + endfor ; + + setbounds currentpicture to b ; + + endgroup ; + +enddef ; + diff --git a/Master/texmf-dist/metapost/context/base/mpxl/mp-apos.mpxl b/Master/texmf-dist/metapost/context/base/mpxl/mp-apos.mpxl new file mode 100644 index 00000000000..e3746540f59 --- /dev/null +++ b/Master/texmf-dist/metapost/context/base/mpxl/mp-apos.mpxl @@ -0,0 +1,112 @@ +%D \module +%D [ file=mp-apos.mpiv, +%D version=2012.02.19, % was mp-core: 1999.08.01, anchoring +%D title=\CONTEXT\ \METAPOST\ graphics, +%D subtitle=anchored background macros, +%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_apos : endinput ; fi ; + +newinternal boolean metafun_loaded_apos ; metafun_loaded_apos := true ; immutable metafun_loaded_apos ; + +path posboxes[], + posregions[] ; + +numeric pospages[], + nofposboxes ; + +nofposboxes := 0 ; + +def boxlineoptions = withcolor .8blue enddef ; +def boxfilloptions = withcolor .8white enddef ; + +mutable posboxes, posregions, pospages, nofposboxes ; + +def connect_positions = + if nofposboxes = 2 : + pickup pencircle scaled boxlinewidth ; + path pa ; pa := posboxes[1] enlarged boxlineoffset ; + path pb ; pb := posboxes[2] enlarged boxlineoffset ; + if pospages[1] = pospages[2] : + draw posboxes[1] boxlineoptions ; + path pc ; pc := center pa {up} .. {down} center pb ; + pair cc ; cc := (pc intersection_point pa) ; + if intersection_found : + pc := pc cutbefore cc ; + cc := (pc intersection_point pb) ; + if intersection_found : + pc := pc cutafter cc ; + drawarrow pc boxlineoptions ; + drawarrow reverse pc boxlineoptions ; + fi ; + fi ; + elseif pospages[1] == RealPageNumber : + draw posboxes[1] boxlineoptions ; + path pc ; pc := center pa {up} ... {right} urcorner (posregions[1] enlarged (20pt,20pt)) ; + pair cc ; cc := (pc intersection_point pa) ; + if intersection_found : + pc := pc cutbefore cc ; + drawarrow pc boxlineoptions ; + fi ; + elseif pospages[2] == RealPageNumber : + draw posboxes[2] boxlineoptions ; + path pc ; pc := ulcorner (posregions[2] enlarged (20pt,20pt)) {right} ... {down} center pb ; + pair cc ; cc := (pc intersection_point pb) ; + if intersection_found : + pc := pc cutafter cc ; + drawarrow pc boxlineoptions ; + fi ; + fi ; + fi ; +enddef ; + +% anch-bar: + +def anch_sidebars_draw (expr firstpage, lastpage, yfirst, ylast, height, depth, + x, y, w, h, alternative, distance, linewidth, linecolor, topoffset, bottomoffset) = + % beware, we anchor at (x,y) + begingroup ; + if alternative = 1 : + interim linecap := rounded ; + else : + interim linecap := butt ; + fi ; + save a, b ; pair a, b ; + if firstpage = lastpage : + a := (-distance,yfirst+height-y) ; + b := (-distance,ylast-depth-y) ; + elseif RealPageNumber = firstpage : + a := (-distance,yfirst+height-y) ; + b := (-distance,0) ; + elseif RealPageNumber = lastpage : + a := (-distance,h) ; + b := (-distance,ylast-depth-y) ; + else : + a := (-distance,h) ; + b := (-distance,0) ; + fi ; + a := (xpart a, min(ypart a + topoffset, h)) ; + b := (xpart b, max(ypart b - bottomoffset,0)) ; + draw + a -- b + if alternative = 1 : + dashed (withdots scaled (linewidth/2)) + fi + withpen pencircle scaled linewidth + withcolor linecolor ; + endgroup ; +enddef ; + +% new interface + +newscriptindex mfid_getposboxes ; mfid_getposboxes := scriptindex "getposboxes" ; +newscriptindex mfid_getmultipars ; mfid_getmultipars := scriptindex "getmultipars" ; + +def getposboxes (expr tags, anchor) = runscript mfid_getposboxes tags anchor ; enddef ; +def getmultipars(expr tags, anchor) = runscript mfid_getmultipars tags anchor ; enddef ; diff --git a/Master/texmf-dist/metapost/context/base/mpxl/mp-base.mpxl b/Master/texmf-dist/metapost/context/base/mpxl/mp-base.mpxl new file mode 100644 index 00000000000..8086ee79974 --- /dev/null +++ b/Master/texmf-dist/metapost/context/base/mpxl/mp-base.mpxl @@ -0,0 +1,1049 @@ +% This is a reformatted copy of the plain.mp file. We use a copy +% because (1) we want to make sure that there are no unresolved +% dependencies, and (2) we may patch this file eventually. + +% This file gives the macros for plain MetaPost It contains all the +% features of plain METAFONT except those specific to font-making. +% There are also a number of macros for labeling figures, etc. + +% For practical reasons I have moved some new code here (and might +% remove some code as well). After all, there is no development in +% this format. + +message "loading metafun for lmtx, including the plain 1.004 base definitions"; + +if known metafun_loaded_base : endinput ; fi ; + +newinternal boolean metafun_loaded_base ; metafun_loaded_base := true ; immutable metafun_loaded_base ; + +delimiters () ; % this makes parentheses behave like parentheses + +def upto = step 1 until enddef ; +def downto = step -1 until enddef ; + +def exitunless expr c = + exitif not c +enddef ; + +let relax = \ ; % ignore the word relax, as in TeX +let \\ = \ ; % double relaxation is like single + +def [[ = [ [ enddef ; +def ]] = ] ] enddef ; + +def -- = {curl 1} .. {curl 1} enddef ; +def --- = .. tension infinity .. enddef ; +def ... = .. tension atleast 1 .. enddef ; + +def gobble primary g = enddef ; +primarydef g gobbled gg = enddef ; + +def hide(text t) = + exitif numeric begingroup t ; endgroup ; +enddef ; + +def ??? = + hide ( + interim showstopping := 1 ; + showdependencies + ) +enddef ; + +def stop expr s = + message s ; + gobble readstring +enddef ; + +% \\ and ??? can go + +permanent $, $$, (, ), upto, downto, exitunless, relax, \\, [[, ]], --, ---, ..., gobble, gobbled, stop, ??? ; +mutable ? ; + +% These need to be adapted to a library approach: + +warningcheck := 1 ; + +def interact = % sets up to make "show" commands stop + hide ( + showstopping := 1 ; + tracingonline := 1 ; + ) +enddef ; + +def loggingall = % puts tracing info into the log + tracingcommands := 3 ; + tracingtitles := 1 ; + tracingequations := 1 ; + tracingcapsules := 1 ; + tracingspecs := 2 ; + tracingchoices := 1 ; + tracingstats := 1 ; + tracingoutput := 1 ; + tracingmacros := 1 ; + tracingrestores := 1 ; +enddef ; + +def tracingall = % turns on every form of tracing + tracingonline := 1 ; + showstopping := 1 ; + loggingall ; +enddef ; + +def tracingnone = % turns off every form of tracing + tracingcommands := 0 ; + tracingtitles := 0 ; + tracingequations := 0 ; + tracingcapsules := 0 ; + tracingspecs := 0 ; + tracingchoices := 0 ; + tracingstats := 0 ; + tracingoutput := 0 ; + tracingmacros := 0 ; + tracingrestores := 0 ; +enddef ; + +permanent interact, loggingall, tracingall, tracingnone ; + +%% dash patterns + +vardef dashpattern(text t) = + save on, off, w ; + let on = _on_ ; + let off = _off_ ; + w = 0 ; + nullpicture t +enddef ; + +tertiarydef p _on_ d = + begingroup save pic ; + picture pic; + pic = p ; + addto pic doublepath (w,w) .. (w+d,w) ; + w := w + d ; + pic shifted (0,d) + endgroup +enddef ; + +tertiarydef p _off_ d = + begingroup w := w + d ; + p shifted (0,d) + endgroup +enddef ; + +permanent dashpattern, _on_, _off_, on, off ; % on and off are not primitives + +%% basic constants and mathematical macros + +% numeric constants + +newinternal eps, epsilon, infinity, _ ; + +eps := .00049 ; % this is a pretty small positive number +epsilon := 1/256/256 ; % but this is the smallest +infinity := 4095.99998 ; % and this is the largest +_ := -1 ; % internal constant to make macros unreadable but shorter + +immutable eps, epsilon, infinity, _ ; + +% linejoin and linecap types + +newinternal mitered, rounded, beveled, butt, squared ; + +mitered := 0 ; rounded := 1 ; beveled := 2 ; +butt := 0 ; rounded := 1 ; squared := 2 ; + +immutable mitered, rounded, beveled, butt, squared ; + +% pair constants + +pair right, left, up, down, origin; + +origin = (0,0) ; +up = -down = (0,1) ; +right = -left = (1,0) ; + +immutable right, left, up, down, origin ; + +% path constants + +path quartercircle, halfcircle, fullcircle, unitsquare ; + +fullcircle = makepath pencircle ; +halfcircle = subpath (0,4) of fullcircle ; +quartercircle = subpath (0,2) of fullcircle ; +unitsquare = (0,0) -- (1,0) -- (1,1) -- (0,1) -- cycle ; + +immutable quartercircle, halfcircle, fullcircle, unitsquare ; + +% transform constants + +transform identity ; + +for z=origin,right,up : + z transformed identity = z ; +endfor ; + +immutable identity ; + +% color constants (all in rgb color space) + +color black, white, red, green, blue, cyan, magenta, yellow, background; + +black := (0,0,0) ; +white := (1,1,1) ; +red := (1,0,0) ; +green := (0,1,0) ; +blue := (0,0,1) ; +cyan := (0,1,1) ; +magenta := (1,0,1) ; +yellow := (1,1,0) ; + +background := white ; % obsolete + +% should these be tagged with a property ? + +let graypart = greypart ; +let greycolor = numeric ; +let graycolor = numeric ; + +% color part (will be overloaded) + +def colorpart primary t = + if colormodel t = 7: + (cyanpart t, magentapart t, yellowpart t, blackpart t) + elseif colormodel t = 5 : + (redpart t, greenpart t, bluepart t) + elseif colormodel t = 3 : + (greypart t) + elseif colormodel t = 1 : + false + elseif defaultcolormodel = 7 : + (0,0,0,1) + elseif defaultcolormodel = 5 : + black + elseif defaultcolormodel = 3 : + 0 + else : + false + fi +enddef ; + +permanent graypart, greycolor, graycolor ; % colorpart + +% picture constants + +picture blankpicture, evenly, withdots ; + +blankpicture = nullpicture ; % display blankpicture... +evenly = dashpattern(on 3 off 3) ; % dashed evenly +withdots = dashpattern(off 2.5 on 0 off 2.5) ; % dashed withdots + +immutable blankpicture; +permanent evenly, withdots ; + +% string constants + +string ditto, EOF ; + +ditto = char 34 ; % ASCII double-quote mark +EOF = char 0 ; % end-of-file for readfrom and write..to + +immutable ditto, EOF ; + +% pen constants + +pen pensquare, penrazor, penspec ; + +pensquare = makepen(unitsquare shifted -(.5,.5)) ; +penrazor = makepen((-.5,0) -- (.5,0) -- cycle) ; +penspec = pensquare scaled eps ; + +immutable pensquare, penrazor, penspec ; + +% nullary operators + +vardef whatever = + save ? ; + ? +enddef ; + +permanent whatever ; + +% unary operators (with patched round) + +let abs = length ; + +vardef round primary u = + if numeric u : + floor(u+.5) + elseif pair u : + (floor(xpart u+.5), floor(ypart u+.5)) + elseif path u : + % added by HH + for i=0 upto length u-1 : + round(point i of u) .. + controls round(postcontrol i of u) and round(precontrol i+1 of u) .. + endfor + if cycle u : cycle else : point infinity of u fi + else : + u + fi +enddef ; + +vardef ceiling primary x = + -floor(-x) +enddef ; + +vardef byte primary s = + if string s : + ASCII + fi s +enddef ; + +vardef dir primary d = + right rotated d +enddef ; + +vardef unitvector primary z = + z/abs z +enddef ; + +vardef inverse primary t = + transform temp_transform ; + temp_transform transformed t = identity ; + temp_transform +enddef ; + +vardef counterclockwise primary c = + if turningnumber c <= 0 : + reverse + fi c +enddef ; + +vardef tensepath expr r = + for k=0 upto length r - 1 : + point k of r --- + endfor + if cycle r : + cycle + else : + point infinity of r + fi +enddef ; + +vardef center primary p = + .5[llcorner p, urcorner p] +enddef ; + +permanent abs, round, ceiling, byte, dir, unitvector, inverse, counterclockwise, tensepath, center ; + +% binary operators + +primarydef x mod y = + (x-y*floor(x/y)) +enddef ; + +primarydef x div y = + floor(x/y) +enddef ; + +primarydef w dotprod z = + (xpart w * xpart z + ypart w * ypart z) +enddef ; + +permanent mod, div, dotprod ; + +% primarydef x**y = +% if y = 2 : +% x*x +% else : +% takepower y of x +% fi +% enddef ; +% +% def takepower expr y of x = +% if x>0 : +% mexp(y*mlog x) +% elseif (x=0) and (y>0) : +% 0 +% else : +% 1 +% if y = floor y : +% if y >= 0 : +% for n=1 upto y : +% *x +% endfor +% else : +% for n=-1 downto y : +% /x +% endfor +% fi +% else : +% hide(errmessage "Undefined power: " & decimal x & "**" & decimal y) +% fi +% fi +% enddef ; + +% for big number systems: + +primarydef x**y = + if y = 0 : 1 + elseif x = 0 : 0 + elseif y < 0 : 1/(x**-y) + elseif y = 1 : x + elseif y = 2 : x*x + elseif y = 3 : x*x*x + else : takepower y of x + fi +enddef ; + +def takepower expr y of x = + if y=0 : % isn't x**0 = 1 even if x=0 ? + 1 + elseif x=0 : + 0 + else : + if y = floor y : + 1 + if y >= 0 : + for n=1 upto y : + *x + endfor + else : + for n=-1 downto y : + /x + endfor + fi + elseif x > 0 : + mexp(y*mlog x) + else : + -mexp(y*mlog -x) + fi + fi +enddef ; + +permanent **, takepower ; + +newinternal temp_internal_a, temp_internal_b ; +newinternal temp_numeric_x, temp_numeric_y ; +newinternal temp_internal_tx, temp_internal_ty, temp_internal_fx, temp_internal_fy ; +newinternal temp_internal_n ; +path temp_path_a, temp_path_b ; +pair temp_pair_dz, temp_pair_z[] ; + +vardef direction expr t of p = + postcontrol t of p - precontrol t of p +enddef ; + +vardef directionpoint expr z of p = + temp_internal_a := directiontime z of p ; + if temp_internal_a < 0 : + errmessage("The direction doesn't occur") ; + fi + point temp_internal_a of p +enddef ; + +secondarydef p intersectionpoint q = + begingroup + save temp_numeric_x, temp_numeric_y ; + (temp_numeric_x,temp_numeric_y) = p intersectiontimes q ; + if temp_numeric_x < 0 : + errmessage("The paths don't intersect") ; + origin + else : + .5[point temp_numeric_x of p, point temp_numeric_y of q] + fi + endgroup +enddef ; + +tertiarydef p softjoin q = + begingroup + temp_path_a := fullcircle scaled 2join_radius shifted point 0 of q ; + temp_internal_a := ypart(temp_path_a intersectiontimes p) ; + temp_internal_b := ypart(temp_path_a intersectiontimes q) ; + if temp_internal_a < 0 : + point 0 of p {direction 0 of p} + else : + subpath(0,temp_internal_a) of p + fi + ... + if temp_internal_b < 0 : + {direction infinity of q} point infinity of q + else : + subpath(temp_internal_b,infinity) of q + fi + endgroup +enddef ; + +permanent direction, directionpoint, intersectionpoint, softjoin ; + +newinternal join_radius ; +path cuttings ; % what got cut off + +tertiarydef a cutbefore b = % tries to cut as little as possible + begingroup + save t ; + (t, whatever) = a intersectiontimes b ; + if t < 0 : + cuttings := point 0 of a ; + a + else : + cuttings := subpath (0,t) of a ; + subpath (t,length a) of a + fi + endgroup +enddef ; + +tertiarydef a cutafter b = + reverse (reverse a cutbefore b) + hide(cuttings := reverse cuttings) +enddef ; + +permanent join_radius, cuttings, cutbefore, cutafter ; + +% special operators + +vardef incr suffix $ = $ := $ + 1 ; $ enddef ; +vardef decr suffix $ = $ := $ - 1 ; $ enddef ; + +permanent incr, decr ; + +def reflectedabout(expr w,z) = % reflects about the line w..z + transformed + begingroup + transform temp_transform ; + w transformed temp_transform = w ; + z transformed temp_transform = z ; + xxpart temp_transform = -yypart temp_transform ; + xypart temp_transform = yxpart temp_transform ; % temp_transform is a reflection + temp_transform + endgroup +enddef ; + +def rotatedaround(expr z, d) = % rotates d degrees around z + shifted -z rotated d shifted z +enddef ; + +let rotatedabout = rotatedaround ; % for roundabout people + +permanent reflectedabout, rotatedaround, rotatedabout ; + +vardef min(expr u)(text t) = % t is a list of numerics, pairs, or strings + save temp_any_u ; + if pair u : + pair temp_any_u + elseif string u : + string temp_any_u + fi ; + temp_any_u := u ; + for i = t : + if i < temp_any_u : + temp_any_u := i ; + fi + endfor + temp_any_u +enddef ; + +vardef max(expr u)(text t) = % t is a list of numerics, pairs, or strings + save temp_any_u ; + if pair u : + pair temp_any_u + elseif string u : + string temp_any_u + fi ; + temp_any_u := u ; + for i = t : + if i > temp_any_u : + temp_any_u := i ; + fi + endfor + temp_any_u +enddef ; + +def flex(text t) = % t is a list of pairs + hide ( + temp_internal_n := 0 ; + for z=t : + temp_pair_z[incr temp_internal_n] := z ; + endfor + temp_pair_dz := temp_pair_z[temp_internal_n]-temp_pair_z[1] + ) + temp_pair_z[1] for k=2 upto temp_internal_n - 1 : ... temp_pair_z[k]{temp_pair_dz} endfor ... temp_pair_z[temp_internal_n] +enddef ; + +permanent min, max, flex ; + +def superellipse(expr r, t, l, b, s) = + r { up } ... (s[xpart t,xpart r],s[ypart r,ypart t]) { t-r } ... + t { left } ... (s[xpart t,xpart l],s[ypart l,ypart t]) { l-t } ... + l { down } ... (s[xpart b,xpart l],s[ypart l,ypart b]) { b-l } ... + b { right } ... (s[xpart b,xpart r],s[ypart r,ypart b]) { r-b } ... cycle enddef ; + +vardef interpath(expr a,p,q) = + for t=0 upto length p-1 : + a[point t of p, point t of q] .. controls a[postcontrol t of p, postcontrol t of q] and a[precontrol t+1 of p, precontrol t+1 of q] .. + endfor + if cycle p : + cycle + else : + a[point infinity of p, point infinity of q] + fi +enddef ; + +permanent superellipse, interpath ; + +newinternal tolerance ; tolerance := .01 ; + +vardef solve@#(expr t, f)= % @#(t)=true, @#(f)=false + temp_internal_tx := t; + temp_internal_fx := f; + forever : + temp_numeric_x := .5[temp_internal_tx,temp_internal_fx] ; + exitif abs(temp_internal_tx - temp_internal_fx) <= tolerance ; + if @#(temp_numeric_x) : + temp_internal_tx + else : + temp_internal_fx + fi := temp_numeric_x ; + endfor + temp_numeric_x % now temp_numeric_x is near where @# changes from true to false +enddef ; + +vardef buildcycle(text ll) = + save temp_a, temp_b, temp_k, temp_i, temp_p ; path temp_p[] ; + temp_k = 0 ; + for q=ll : + temp_p[incr temp_k] = q ; + endfor + temp_i = temp_k ; + for i=1 upto temp_k : + (temp_a[i], length temp_p[temp_i]-temp_b[temp_i]) = temp_p[i] intersectiontimes reverse temp_p[temp_i] ; + if temp_a[i]<0 : + errmessage("Paths "& decimal i &" and "& decimal temp_i &" don't intersect") ; + fi + temp_i := i; + endfor + for i=1 upto temp_k : + subpath (temp_a[i],temp_b[i]) of temp_p[i] .. + endfor + cycle +enddef ; + +permanent interpath, solve, buildcycle, tolerance ; + +%% units of measure + +mm := 2.83464 ; +pt := 0.99626 ; +dd := 1.06601 ; +bp := 1 ; +cm := 28.34645 ; +pc := 11.95517 ; +cc := 12.79213 ; +in := 72 ; + +immutable mm, pt, bp, cm, in ; % we don't protect (yet): dd, pc cc (used as locals) + +% vardef magstep primary m = % obsolete +% mexp(46.67432m) +% enddef ; + +%% macros for drawing and filling + +def drawoptions(text t) = + def base_draw_options = t enddef +enddef ; + +% parameters that effect drawing + +linejoin := rounded ; +linecap := rounded ; +miterlimit := 10 ; + +drawoptions() ; + +pen currentpen ; +picture currentpicture ; + +def fill expr c = + addto currentpicture contour c base_draw_options +enddef ; + +def draw expr p = + addto currentpicture + if picture p : + also p + else : + doublepath p withpen currentpen + fi + base_draw_options +enddef ; + +def filldraw expr c = + addto currentpicture contour c withpen currentpen base_draw_options +enddef ; + +% def drawdot expr z = +% addto currentpicture contour makepath currentpen shifted z base_draw_options +% enddef ; +% +% testcase DEK: +% +% for j=1 upto 9 : +% pickup pencircle xscaled .4 yscaled .2 ; +% drawdot (10j,0) withpen pencircle xscaled .5j yscaled .25j rotated 45 ; +% pickup pencircle xscaled .5j yscaled .25j rotated 45 ; +% drawdot (10j,10); +% endfor ; +% +% or: +% +%\startMPpage +% +% def drawdot expr z = +% addto currentpicture contour (makepath currentpen shifted z) base_draw_options +% enddef; +% +% drawdot origin shifted (0,-3cm) withpen pencircle scaled 2cm ; +% pickup pencircle scaled 2cm ; drawdot origin withcolor red ; + +def drawdot expr p = + if pair p : + addto currentpicture doublepath p withpen currentpen base_draw_options + else : + errmessage("drawdot only accepts a pair expression") + fi +enddef ; + +permanent drawoptions, currentpen, filldraw, drawdot ; % redefined later: fill, draw + +% permanent currentpicture; % not yet + +% Kind of obsolete: + +def unfill expr c = fill c withcolor background enddef ; +def undraw expr p = draw p withcolor background enddef ; +def unfilldraw expr c = filldraw c withcolor background enddef ; +def undrawdot expr z = drawdot z withcolor background enddef ; + +def plain_erase = enddef ; + +def erase text t = + def plain_erase = + withcolor background hide(def plain_erase = enddef ;) + enddef ; + t plain_erase +enddef ; + +def cutdraw text t = + begingroup + interim linecap := butt ; + draw t plain_erase ; + endgroup +enddef ; + +permanent unfill, undraw, unfilldraw, undrawdot, erase, cutdraw ; + +% Popular: + +vardef image(text t) = + save currentpicture ; + picture currentpicture ; + currentpicture := nullpicture ; + t ; + currentpicture +enddef ; + +permanent image ; + +def pickup secondary q = + if numeric q : + plain_pickup_numeric + else : + plain_pickup_path + fi q +enddef ; + +% pens + +newinternal pen_lft, pen_rt, pen_top, pen_bot ; + +newinternal temp_pen_count ; +path temp_pen_result ; +path temp_pen_path.l, temp_pen_path.r ; +numeric temp_pen_l[], temp_pen_r[], temp_pen_t[], temp_pen_b[] ; +pen temp_pen_stack[] ; +path temp_pen_p[] ; + +pen currentpen ; + +temp_pen_count := 0 ; + +def plain_pickup_numeric primary q = + if unknown temp_pen_stack[q] : + errmessage "Unknown pen" ; + clearpen + else : + currentpen := temp_pen_stack[q] ; + pen_lft := temp_pen_l[q] ; + pen_rt := temp_pen_r[q] ; + pen_top := temp_pen_t[q] ; + pen_bot := temp_pen_b[q] ; + temp_pen_result := temp_pen_p[q] + fi ; +enddef ; + +def plain_pickup_path primary q = + currentpen := q ; + pen_lft := xpart penoffset down of currentpen ; + pen_rt := xpart penoffset up of currentpen ; + pen_top := ypart penoffset left of currentpen ; + pen_bot := ypart penoffset right of currentpen ; + path temp_pen_result ; +enddef ; + +vardef savepen = + temp_pen_stack[incr temp_pen_count] = currentpen ; + temp_pen_l[temp_pen_count] = pen_lft ; + temp_pen_r[temp_pen_count] = pen_rt ; + temp_pen_t[temp_pen_count] = pen_top ; + temp_pen_b[temp_pen_count] = pen_bot ; + temp_pen_p[temp_pen_count] = temp_pen_result ; + temp_pen_count +enddef ; + +def clearpen = + currentpen := nullpen; + pen_lft := pen_rt := pen_top := pen_bot := 0 ; + path temp_pen_result ; +enddef ; + +vardef lft primary x = x + if pair x: (pen_lft,0) else: pen_lft fi enddef ; +vardef rt primary x = x + if pair x: (pen_rt, 0) else: pen_rt fi enddef ; +vardef top primary y = y + if pair y: (0,pen_top) else: pen_top fi enddef ; +vardef bot primary y = y + if pair y: (0,pen_bot) else: pen_bot fi enddef ; + +vardef penpos@#(expr b,d) = + (x@#r-x@#l,y@#r-y@#l) = (b,0) rotated d ; + x@# = .5(x@#l+x@#r) ; + y@# = .5(y@#l+y@#r) ; % ; added HH +enddef ; + +def penstroke text t = + forsuffixes e = l, r : + temp_pen_path.e := t ; + endfor + fill temp_pen_path.l -- reverse temp_pen_path.r -- cycle +enddef ; + +permanent + pen_lft, pen_rt, pen_top, pen_bot, + lft, rt, top, bot, + pickup, penpos, clearpen, penstroke, savepen ; + +%% High level drawing commands + +newinternal ahlength, ahangle ; + +ahlength := 4 ; % default arrowhead length 4bp +ahangle := 45 ; % default head angle 45 degrees + +path temp_arrow_path ; + +vardef arrowhead expr p = + save q, e ; path q ; pair e ; + e = point length p of p ; + q = gobble(p shifted -e cutafter makepath(pencircle scaled 2ahlength)) cuttings ; + (q rotated .5ahangle & reverse q rotated -.5ahangle -- cycle) shifted e +enddef ; + +def drawarrow expr p = temp_arrow_path := p ; plain_arrow_finish enddef ; +def drawdblarrow expr p = temp_arrow_path := p ; plain_arrow_find enddef ; + +def plain_arrow_finish text t = + draw temp_arrow_path t ; + filldraw arrowhead temp_arrow_path t +enddef ; + +def plain_arrow_find text t = % this had fill in 0.63 (potential incompatibility) + draw temp_arrow_path t ; + filldraw arrowhead temp_arrow_path withpen currentpen t ; + filldraw arrowhead reverse temp_arrow_path withpen currentpen t ; % ; added HH +enddef ; + +permanent ahlength, ahangle, arrowhead, drawarrow, drawdblarrow ; + +%% macros for labels + +newinternal bboxmargin ; + +bboxmargin := 2bp ; % this can bite you, just don't use it in \METAFUN + +vardef bbox primary p = + llcorner p - ( bboxmargin, bboxmargin) -- + lrcorner p + ( bboxmargin,-bboxmargin) -- + urcorner p + ( bboxmargin, bboxmargin) -- + ulcorner p + (-bboxmargin, bboxmargin) -- cycle +enddef ; + +permanent bboxmargin, bbox ; + +string defaultfont ; newinternal defaultscale, labeloffset, dotlabeldiam ; + +defaultfont := "cmr10" ; +defaultscale := 1 ; +labeloffset := 3bp ; +dotlabeldiam := 3bp ; + +mutable defaultfont, defaultscale, labeloffset, dotlabeldiam ; + +vardef thelabel@#(expr s,z) = % Position s near z + save p ; picture p ; + if picture s : + p = s + else : + p = s infont defaultfont scaled defaultscale + fi ; + p shifted (z + labeloffset*laboff@# - ( labxf@#*lrcorner p + labyf@#*ulcorner p + (1-labxf@#-labyf@#)*llcorner p) ) +enddef ; + +def label = + draw thelabel +enddef ; + +vardef dotlabel@#(expr s,z) text t = + label@#(s,z) t ; + interim linecap := rounded ; + draw z withpen pencircle scaled dotlabeldiam t ; +enddef ; + +% def makelabel = +% dotlabel +% enddef ; + +permanent label, dotlabel ; + +% this will be overloaded + +pair laboff, laboff.lft, laboff.rt, laboff.top, laboff.bot ; +pair laboff.ulft, laboff.llft, laboff.urt, laboff.lrt ; + +laboff = (0,0) ; labxf = .5 ; labyf = .5 ; +laboff.lft = (-1,0) ; labxf.lft = 1 ; labyf.lft = .5 ; +laboff.rt = (1,0) ; labxf.rt = 0 ; labyf.rt = .5 ; +laboff.bot = (0,-1) ; labxf.bot = .5 ; labyf.bot = 1 ; +laboff.top = (0,1) ; labxf.top = .5 ; labyf.top = 0 ; +laboff.ulft = (-.7,.7) ; labxf.ulft = 1 ; labyf.ulft = 0 ; +laboff.urt = (.7,.7) ; labxf.urt = 0 ; labyf.urt = 0 ; +laboff.llft = -(.7,.7) ; labxf.llft = 1 ; labyf.llft = 1 ; +laboff.lrt = (.7,-.7) ; labxf.lrt = 0 ; labyf.lrt = 1 ; + +vardef labels@#(text t) = + forsuffixes $=t : + label@#(str$,z$) ; + endfor +enddef ; + +% till lhere + +vardef dotlabels@#(text t) = + forsuffixes $=t: + dotlabel@#(str$,z$) ; + endfor +enddef ; + +vardef penlabels@#(text t) = + forsuffixes $$=l,,r : + forsuffixes $=t : + dotlabel@#(str$.$$,z$.$$) ; + endfor + endfor +enddef ; + +permanent dotlabels, penlabels ; + +% range 4 thru 10 + +def plain_numtok suffix x = + x +enddef ; + +def range expr x = + plain_numtok[x] +enddef ; + +tertiarydef m thru n = + m for x=m+1 step 1 until n : + , plain_numtok[x] + endfor +enddef ; + +permanent range, thru ; + +%% Overall administration + +% Todo: make an add to this helper thet temporarily disables warning + +string extra_beginfig, extra_endfig ; + +extra_beginfig := "" ; +extra_endfig := "" ; + +def beginfig(expr c) = + begingroup + charcode := c ; + clearxy ; + clearit ; + clearpen ; + pickup defaultpen ; + drawoptions() ; + scantokens extra_beginfig ; +enddef ; + +def endfig = + ; % added by HH + scantokens extra_endfig ; + shipit ; + endgroup +enddef ; + +permanent + % extra_beginfig, extra_endfig, + beginfig, endfig ; + +%% last-minute items + +vardef z@# = + (x@#,y@#) +enddef ; + +def clearxy = + save x, y +enddef ; + +def clearit = + currentpicture := nullpicture +enddef ; + +clearit ; + +permanent z, clearit ; % redefined: clearxy + +def shipit = + shipout currentpicture +enddef ; + +let bye = end ; +outer end, bye ; + +permanent shipit, bye ; + +% set default line width + +newinternal defaultpen ; + +pickup pencircle scaled .5bp ; + +defaultpen := savepen ; + +permanent defaultpen ; diff --git a/Master/texmf-dist/metapost/context/base/mpxl/mp-blob.mpxl b/Master/texmf-dist/metapost/context/base/mpxl/mp-blob.mpxl new file mode 100644 index 00000000000..55557811496 --- /dev/null +++ b/Master/texmf-dist/metapost/context/base/mpxl/mp-blob.mpxl @@ -0,0 +1,120 @@ +%D \module +%D [ file=mp-blob.mpiv, +%D version=2018.04.08, +%D title=\CONTEXT\ \METAPOST\ graphics, +%D subtitle=Blobs, +%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. + +%D This is a follow up on good old \type {meta-imp-txt}. + +if known metafun_loaded_blob : endinput ; fi ; + +newinternal boolean metafun_loaded_blob ; metafun_loaded_blob := true ; immutable metafun_loaded_blob ; + +numeric mfun_blob_n ; mfun_blob_n := 0 ; +picture mfun_blob_c ; +color mfun_blob_b ; + +def mfun_reset_tex_blobs = + mfun_blob_n := 0 ; + mfun_blob_c := nullpicture ; +enddef ; + +extra_endfig := extra_endfig & "mfun_reset_tex_blobs ; " ; + +vardef mfun_inject_blob(expr n) = + mfun_blob_c := nullpicture ; + mfun_blob_b := lua.mp.mf_blob_dimensions(mfun_blob_n,n) ; + addto mfun_blob_c doublepath unitsquare + xscaled redpart mfun_blob_b + yscaled (greenpart mfun_blob_b + bluepart mfun_blob_b) + shifted (0,- bluepart mfun_blob_b) + withprescript "mf_object=texblob" + withprescript "tb_blob=" & decimal lua.mp.mf_blob_index(mfun_blob_n,n) ; + mfun_blob_c +enddef ; + +% An example of usage: + +newinternal followtextalternative ; followtextalternative := 1 ; +newinternal tracingfollowtext ; tracingfollowtext := 0 ; +newinternal autoscaleupfollowtext ; autoscaleupfollowtext := 2 ; +newinternal autoscaledownfollowtext ; autoscaledownfollowtext := 0 ; + +permanent tracingfollowtext ; + +vardef followtext(expr pth, txt) = + image ( + mfun_blob_n := mfun_blob_n + 1 ; + lua.mp.mf_inject_blob(mfun_blob_n,txt); + save pat, al, at, pl, pc, wid, pos, ap, ad, pic, len, n, b, sc, sb ; + path pat, b ; pat := pth ; + numeric al, at, pl, pc, wid, pos, len[], n, sc, sb ; + pair ap, ad ; + picture pic[] ; + len[0] := 0 ; + n := lua.mp.mf_blob_size(mfun_blob_n) ; + sc := 0 ; + sb := .25pt; + for i=1 upto n : + pic[i] := mfun_inject_blob(i) ; + pic[i] := pic[i] shifted - llcorner pic[i] ; + len[i] := len[i-1] + lua.mp.mf_blob_width(mfun_blob_n,i) ; + endfor ; + al := arclength pth ; + if al = 0 : + al := len[n] ; + pat := origin -- (al,0) ; + fi ; + if ((al < len[n]) and (autoscaleupfollowtext > 0)) or + ((al > len[n]) and (autoscaledownfollowtext > 0)) : + sc := len[n] /al ; + pat := pat scaled sc ; + al := arclength pat ; + fi ; + if followtextalternative = 1 : + pl := (al-len[n])/(if n>1 : (n-1) else : 1 fi) ; + pc := 0 ; + else : % centered / MP + pl := 0 ; + pc := arclength pat/2 - len[n]/2 ; + fi ; + if tracingfollowtext = 1 : + draw pat withpen pencircle scaled 1pt withcolor blue ; + fi ; + for i=1 upto n : + wid := lua.mp.mf_blob_width(mfun_blob_n,i) ; + pos := len[i]-wid/2 + (i-1)*pl + pc ; + at := arctime pos of pat ; + ap := point at of pat ; + ad := direction at of pat ; + pic[i] := pic[i] + shifted (-wid/2,0) + if ad <> origin : rotated(angle(ad)) fi + shifted ap ; + draw pic[i] ; + if tracingfollowtext = 1 : + draw boundingbox pic[i] withpen pencircle scaled .25pt withcolor red ; + draw ap withpen pencircle scaled .50pt withcolor green ; + fi ; + endfor ; + if ((autoscaleupfollowtext = 2) or (autoscaledownfollowtext = 2)) and (sc <> 0) and (sc <> 1): + currentpicture := currentpicture scaled (1/sc) ; + sb := 2 * sb / sc ; + fi ; + b := boundingbox currentpicture ; + if tracingfollowtext = 1 : + draw b withpen pencircle scaled sb withcolor blue ; + fi ; + draw fullcircle scaled 100bp + withprescript "mf_object=followtext" + withprescript "ft_category=" & decimal mfun_blob_n ; + setbounds currentpicture to b ; + ) +enddef ; diff --git a/Master/texmf-dist/metapost/context/base/mpxl/mp-butt.mpxl b/Master/texmf-dist/metapost/context/base/mpxl/mp-butt.mpxl new file mode 100644 index 00000000000..4db36c1c9db --- /dev/null +++ b/Master/texmf-dist/metapost/context/base/mpxl/mp-butt.mpxl @@ -0,0 +1,77 @@ +%D \module +%D [ file=mp-butt.mpiv, +%D version=2000.05.31, +%D title=\CONTEXT\ \METAPOST\ graphics, +%D subtitle=buttons, +%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 licen-en.pdf for +%C details. + +if known metafun_loaded_butt : endinput ; fi ; + +newinternal boolean metafun_loaded_butt ; metafun_loaded_butt := true ; immutable metafun_loaded_butt ; + +def predefinedbutton (expr button_type, button_size, button_linecolor, button_fillcolor) = + + begingroup ; + + save button_linewidth, p, d, l ; + + numeric button_linewidth ; button_linewidth := button_size/10 ; + + drawoptions (withpen pencircle scaled button_linewidth withcolor button_linecolor) ; + + path p ; p := unitsquare scaled button_size ; + numeric d ; d := button_size ; + numeric l ; l := button_linewidth ; + + fill p withcolor button_fillcolor ; + draw p ; + + if button_type = 101 : + draw (d-2l,2l)--(2l,.5d)--(d-2l,d-2l)--cycle ; + elseif button_type = 102 : + draw (2l,2l)--(d-2l,.5d)--(2l,d-2l)--cycle ; + elseif button_type = 103 : + for i=2l step 2l until d-2l : + draw (2l,i)--(2l ,i) ; + draw (4l,i)--(d-2l,i) ; + endfor ; + elseif button_type = 104 : + for i=2l step 2l until d-2l : + draw (2l ,i)--(d/2-l,i) ; + draw (d/2+l,i)--(d-2l ,i) ; + endfor ; + elseif button_type = 105 : + fill fullcircle scaled (.2d) shifted (.5d,.7d) ; + fill fullcircle xscaled (.6d) yscaled d shifted (.5d,0) ; + clip currentpicture to p ; + draw p ; + elseif button_type = 106 : + draw (2l,2l)--(d-2l,d-2l) ; + draw (d-2l,2l)--(2l,d-2l) ; + elseif button_type = 107 : + p := (3l,d-2l)--(d-3l,d-2l)--(.5d,4l)--cycle ; + fill p ; draw p ; + draw (.5d,2l) ; + elseif button_type = 108 : + draw (.5d,2l)--(d-2l,d-2l)--(2l,d-2l)--cycle ; + elseif button_type = 109 : + draw (.5d,d-2l)--(d-2l,2l)--(2l,2l)--cycle ; + elseif button_type = 110 : + button_linewidth := button_linewidth/2 ; + draw p enlarged (-2l,-l) ; + for i=2l step l until d-2l : + draw (3l,i)--(d-3l,i) ; + endfor ; + fi ; + + endgroup ; + +enddef ; + +let some_button = predefinedbutton diff --git a/Master/texmf-dist/metapost/context/base/mpxl/mp-cont.mpxl b/Master/texmf-dist/metapost/context/base/mpxl/mp-cont.mpxl new file mode 100644 index 00000000000..d153a9ccb6f --- /dev/null +++ b/Master/texmf-dist/metapost/context/base/mpxl/mp-cont.mpxl @@ -0,0 +1,198 @@ +%D \module +%D [ file=mp-cont.mpiv, +%D version=1999.03.10, +%D title=\CONTEXT\ \METAPOST\ graphics, +%D subtitle=Interfaces, +%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. + +%D This module is rather preliminary and subjected to changes. + +if known metafun_loaded_cont : endinput ; fi ; + +newinternal boolean metafun_loaded_cont ; metafun_loaded_cont := true ; immutable metafun_loaded_cont ; + +string CurrentLayout ; CurrentLayout := "default" ; + +boolean mfun_swapped ; + +def SwapPageState = + mfun_swapped := true ; % eventually this will go ! +enddef ; + +permanent CurrentLayout, SwapPageState ; + +extra_beginfig := extra_beginfig & "mfun_swapped := false ;" ; + +newscriptindex mfid_PaperHeight ; mfid_PaperHeight := scriptindex "PaperHeight" ; vardef PaperHeight = runscript mfid_PaperHeight enddef ; +newscriptindex mfid_PaperWidth ; mfid_PaperWidth := scriptindex "PaperWidth" ; vardef PaperWidth = runscript mfid_PaperWidth enddef ; +newscriptindex mfid_PrintPaperHeight ; mfid_PrintPaperHeight := scriptindex "PrintPaperHeight" ; vardef PrintPaperHeight = runscript mfid_PrintPaperHeight enddef ; +newscriptindex mfid_PrintPaperWidth ; mfid_PrintPaperWidth := scriptindex "PrintPaperWidth" ; vardef PrintPaperWidth = runscript mfid_PrintPaperWidth enddef ; +newscriptindex mfid_TopSpace ; mfid_TopSpace := scriptindex "TopSpace" ; vardef TopSpace = runscript mfid_TopSpace enddef ; +newscriptindex mfid_BottomSpace ; mfid_BottomSpace := scriptindex "BottomSpace" ; vardef BottomSpace = runscript mfid_BottomSpace enddef ; +newscriptindex mfid_BackSpace ; mfid_BackSpace := scriptindex "BackSpace" ; vardef BackSpace = runscript mfid_BackSpace enddef ; +newscriptindex mfid_CutSpace ; mfid_CutSpace := scriptindex "CutSpace" ; vardef CutSpace = runscript mfid_CutSpace enddef ; +newscriptindex mfid_MakeupHeight ; mfid_MakeupHeight := scriptindex "MakeupHeight" ; vardef MakeupHeight = runscript mfid_MakeupHeight enddef ; +newscriptindex mfid_MakeupWidth ; mfid_MakeupWidth := scriptindex "MakeupWidth" ; vardef MakeupWidth = runscript mfid_MakeupWidth enddef ; +newscriptindex mfid_TopHeight ; mfid_TopHeight := scriptindex "TopHeight" ; vardef TopHeight = runscript mfid_TopHeight enddef ; +newscriptindex mfid_TopDistance ; mfid_TopDistance := scriptindex "TopDistance" ; vardef TopDistance = runscript mfid_TopDistance enddef ; +newscriptindex mfid_HeaderHeight ; mfid_HeaderHeight := scriptindex "HeaderHeight" ; vardef HeaderHeight = runscript mfid_HeaderHeight enddef ; +newscriptindex mfid_HeaderDistance ; mfid_HeaderDistance := scriptindex "HeaderDistance" ; vardef HeaderDistance = runscript mfid_HeaderDistance enddef ; +newscriptindex mfid_TextHeight ; mfid_TextHeight := scriptindex "TextHeight" ; vardef TextHeight = runscript mfid_TextHeight enddef ; +newscriptindex mfid_FooterDistance ; mfid_FooterDistance := scriptindex "FooterDistance" ; vardef FooterDistance = runscript mfid_FooterDistance enddef ; +newscriptindex mfid_FooterHeight ; mfid_FooterHeight := scriptindex "FooterHeight" ; vardef FooterHeight = runscript mfid_FooterHeight enddef ; +newscriptindex mfid_BottomDistance ; mfid_BottomDistance := scriptindex "BottomDistance" ; vardef BottomDistance = runscript mfid_BottomDistance enddef ; +newscriptindex mfid_BottomHeight ; mfid_BottomHeight := scriptindex "BottomHeight" ; vardef BottomHeight = runscript mfid_BottomHeight enddef ; +newscriptindex mfid_LeftEdgeWidth ; mfid_LeftEdgeWidth := scriptindex "LeftEdgeWidth" ; vardef LeftEdgeWidth = runscript mfid_LeftEdgeWidth enddef ; +newscriptindex mfid_LeftEdgeDistance ; mfid_LeftEdgeDistance := scriptindex "LeftEdgeDistance" ; vardef LeftEdgeDistance = runscript mfid_LeftEdgeDistance enddef ; +newscriptindex mfid_LeftMarginWidth ; mfid_LeftMarginWidth := scriptindex "LeftMarginWidth" ; vardef LeftMarginWidth = runscript mfid_LeftMarginWidth enddef ; +newscriptindex mfid_LeftMarginDistance ; mfid_LeftMarginDistance := scriptindex "LeftMarginDistance" ; vardef LeftMarginDistance = runscript mfid_LeftMarginDistance enddef ; +newscriptindex mfid_TextWidth ; mfid_TextWidth := scriptindex "TextWidth" ; vardef TextWidth = runscript mfid_TextWidth enddef ; +newscriptindex mfid_RightMarginDistance ; mfid_RightMarginDistance := scriptindex "RightMarginDistance" ; vardef RightMarginDistance = runscript mfid_RightMarginDistance enddef ; +newscriptindex mfid_RightMarginWidth ; mfid_RightMarginWidth := scriptindex "RightMarginWidth" ; vardef RightMarginWidth = runscript mfid_RightMarginWidth enddef ; +newscriptindex mfid_RightEdgeDistance ; mfid_RightEdgeDistance := scriptindex "RightEdgeDistance" ; vardef RightEdgeDistance = runscript mfid_RightEdgeDistance enddef ; +newscriptindex mfid_RightEdgeWidth ; mfid_RightEdgeWidth := scriptindex "RightEdgeWidth" ; vardef RightEdgeWidth = runscript mfid_RightEdgeWidth enddef ; +newscriptindex mfid_InnerMarginDistance ; mfid_InnerMarginDistance := scriptindex "InnerMarginDistance" ; vardef InnerMarginDistance = runscript mfid_InnerMarginDistance enddef ; +newscriptindex mfid_InnerMarginWidth ; mfid_InnerMarginWidth := scriptindex "InnerMarginWidth" ; vardef InnerMarginWidth = runscript mfid_InnerMarginWidth enddef ; +newscriptindex mfid_OuterMarginDistance ; mfid_OuterMarginDistance := scriptindex "OuterMarginDistance" ; vardef OuterMarginDistance = runscript mfid_OuterMarginDistance enddef ; +newscriptindex mfid_OuterMarginWidth ; mfid_OuterMarginWidth := scriptindex "OuterMarginWidth" ; vardef OuterMarginWidth = runscript mfid_OuterMarginWidth enddef ; +newscriptindex mfid_InnerEdgeDistance ; mfid_InnerEdgeDistance := scriptindex "InnerEdgeDistance" ; vardef InnerEdgeDistance = runscript mfid_InnerEdgeDistance enddef ; +newscriptindex mfid_InnerEdgeWidth ; mfid_InnerEdgeWidth := scriptindex "InnerEdgeWidth" ; vardef InnerEdgeWidth = runscript mfid_InnerEdgeWidth enddef ; +newscriptindex mfid_OuterEdgeDistance ; mfid_OuterEdgeDistance := scriptindex "OuterEdgeDistance" ; vardef OuterEdgeDistance = runscript mfid_OuterEdgeDistance enddef ; +newscriptindex mfid_OuterEdgeWidth ; mfid_OuterEdgeWidth := scriptindex "OuterEdgeWidth" ; vardef OuterEdgeWidth = runscript mfid_OuterEdgeWidth enddef ; +newscriptindex mfid_PageOffset ; mfid_PageOffset := scriptindex "PageOffset" ; vardef PageOffset = runscript mfid_PageOffset enddef ; +newscriptindex mfid_PageDepth ; mfid_PageDepth := scriptindex "PageDepth" ; vardef PageDepth = runscript mfid_PageDepth enddef ; +newscriptindex mfid_LayoutColumns ; mfid_LayoutColumns := scriptindex "LayoutColumns" ; vardef LayoutColumns = runscript mfid_LayoutColumns enddef ; +newscriptindex mfid_LayoutColumnDistance ; mfid_LayoutColumnDistance := scriptindex "LayoutColumnDistance" ; vardef LayoutColumnDistance = runscript mfid_LayoutColumnDistance enddef ; +newscriptindex mfid_LayoutColumnWidth ; mfid_LayoutColumnWidth := scriptindex "LayoutColumnWidth" ; vardef LayoutColumnWidth = runscript mfid_LayoutColumnWidth enddef ; + +immutable % permanent + PaperHeight, PaperWidth, PrintPaperHeight, PrintPaperWidth, TopSpace, + BottomSpace, BackSpace, CutSpace, MakeupHeight, MakeupWidth, TopHeight, + TopDistance, HeaderHeight, HeaderDistance, TextHeight, FooterDistance, + FooterHeight, BottomDistance, BottomHeight, LeftEdgeWidth, LeftEdgeDistance, + LeftMarginWidth, LeftMarginDistance, TextWidth, RightMarginDistance, + RightMarginWidth, RightEdgeDistance, RightEdgeWidth, InnerMarginDistance, + InnerMarginWidth, OuterMarginDistance, OuterMarginWidth, InnerEdgeDistance, + InnerEdgeWidth, OuterEdgeDistance, OuterEdgeWidth, PageOffset, PageDepth, + LayoutColumns, LayoutColumnDistance, LayoutColumnWidth ; + +newscriptindex mfid_OnRightPage ; mfid_OnRightPage := scriptindex "OnRightPage" ; vardef OnRightPage = runscript mfid_OnRightPage enddef ; +newscriptindex mfid_OnOddPage ; mfid_OnOddPage := scriptindex "OnOddPage" ; vardef OnOddPage = runscript mfid_OnOddPage enddef ; +newscriptindex mfid_InPageBody ; mfid_InPageBody := scriptindex "InPageBody" ; vardef InPageBody = runscript mfid_InPageBody enddef ; +newscriptindex mfid_LayoutHasChanged ; mfid_LayoutHasChanged := scriptindex "LayoutHasChanged" ; vardef LayoutHasChanged = runscript mfid_LayoutHasChanged enddef ; + +immutable % permanent + OnRightPage, OnOddPage, InPageBody, LayoutHasChanged ; + +newscriptindex mfid_RealPageNumber ; mfid_RealPageNumber := scriptindex "RealPageNumber" ; vardef RealPageNumber= runscript mfid_RealPageNumber enddef ; +newscriptindex mfid_LastPageNumber ; mfid_LastPageNumber := scriptindex "LastPageNumber" ; vardef LastPageNumber= runscript mfid_LastPageNumber enddef ; + +newscriptindex mfid_PageNumber ; mfid_PageNumber := scriptindex "PageNumber" ; vardef PageNumber = runscript mfid_PageNumber enddef ; +newscriptindex mfid_NOfPages ; mfid_NOfPages := scriptindex "NOfPages" ; vardef NOfPages = runscript mfid_NOfPages enddef ; + +newscriptindex mfid_SubPageNumber ; mfid_SubPageNumber := scriptindex "SubPageNumber" ; vardef SubPageNumber = runscript mfid_SubPageNumber enddef ; +newscriptindex mfid_NOfSubPages ; mfid_NOfSubPages := scriptindex "NOfSubPages" ; vardef NOfSubPages = runscript mfid_NOfSubPages enddef ; + +newscriptindex mfid_CurrentColumn ; mfid_CurrentColumn := scriptindex "CurrentColumn" ; vardef CurrentColumn = runscript mfid_CurrentColumn enddef ; +newscriptindex mfid_NOfColumns ; mfid_NOfColumns := scriptindex "NOfColumns" ; vardef NOfColumns = runscript mfid_NOfColumns enddef ; + +immutable % permanent + RealPageNumber, LastPageNumber, PageNumber, + NOfPages, SubPageNumber, NOfSubPages, CurrentColumn, NOfColumns ; + +newscriptindex mfid_BaseLineSkip ; mfid_BaseLineSkip := scriptindex "BaseLineSkip" ; vardef BaseLineSkip = runscript mfid_BaseLineSkip enddef ; +newscriptindex mfid_LineHeight ; mfid_LineHeight := scriptindex "LineHeight" ; vardef LineHeight = runscript mfid_LineHeight enddef ; +newscriptindex mfid_BodyFontSize ; mfid_BodyFontSize := scriptindex "BodyFontSize" ; vardef BodyFontSize = runscript mfid_BodyFontSize enddef ; + +newscriptindex mfid_TopSkip ; mfid_TopSkip := scriptindex "TopSkip" ; vardef TopSkip = runscript mfid_TopSkip enddef ; +newscriptindex mfid_StrutHeight ; mfid_StrutHeight := scriptindex "StrutHeight" ; vardef StrutHeight = runscript mfid_StrutHeight enddef ; +newscriptindex mfid_StrutDepth ; mfid_StrutDepth := scriptindex "StrutDepth" ; vardef StrutDepth = runscript mfid_StrutDepth enddef ; + +newscriptindex mfid_CurrentWidth ; mfid_CurrentWidth := scriptindex "CurrentWidth" ; vardef CurrentWidth = runscript mfid_CurrentWidth enddef ; +newscriptindex mfid_CurrentHeight ; mfid_CurrentHeight := scriptindex "CurrentHeight" ; vardef CurrentHeight = runscript mfid_CurrentHeight enddef ; + +newscriptindex mfid_HSize ; mfid_HSize := scriptindex "HSize" ; vardef HSize = runscript mfid_HSize enddef ; +newscriptindex mfid_VSize ; mfid_VSize := scriptindex "VSize" ; vardef VSize = runscript mfid_VSize enddef ; + +newscriptindex mfid_EmWidth ; mfid_EmWidth := scriptindex "EmWidth" ; vardef EmWidth = runscript mfid_EmWidth enddef ; +newscriptindex mfid_ExHeight ; mfid_ExHeight := scriptindex "ExHeight" ; vardef ExHeight = runscript mfid_ExHeight enddef ; + +immutable % permanent + BaseLineSkip, LineHeight, BodyFontSize, TopSkip, StrutHeight, StrutDepth, + CurrentWidth, CurrentHeight, HSize, VSize, EmWidth, ExHeight ; + +newscriptindex mfid_PageFraction ; mfid_PageFraction := scriptindex "PageFraction" ; vardef PageFraction = runscript mfid_PageFraction enddef ; +newscriptindex mfid_SpineWidth ; mfid_SpineWidth := scriptindex "SpineWidth" ; vardef SpineWidth = runscript mfid_SpineWidth enddef ; +newscriptindex mfid_PaperBleed ; mfid_PaperBleed := scriptindex "PaperBleed" ; vardef PaperBleed = runscript mfid_PaperBleed enddef ; + +immutable % permanent + PageFraction, SpineWidth, PaperBleed ; + +% mfid_CurrentLayout ; mfid_CurrentLayout := scriptindex "CurrentLayout" ; vardef CurrentLayout = runscript mfid_CurrentLayout enddef ; +% mfid_OverlayLineColor ; mfid_OverlayLineColor := scriptindex "OverlayLineColor ; vardef OverlayLineColor = runscript mfid_OverlayLineColor enddef ; +% mfid_OverlayColor ; mfid_OverlayColor := scriptindex "OverlayColor ; vardef OverlayColor = runscript mfid_OverlayColor enddef ; +newscriptindex mfid_OverlayWidth ; mfid_OverlayWidth := scriptindex "OverlayWidth" ; vardef OverlayWidth = runscript mfid_OverlayWidth enddef ; +newscriptindex mfid_OverlayHeight ; mfid_OverlayHeight := scriptindex "OverlayHeight" ; vardef OverlayHeight = runscript mfid_OverlayHeight enddef ; +newscriptindex mfid_OverlayDepth ; mfid_OverlayDepth := scriptindex "OverlayDepth" ; vardef OverlayDepth = runscript mfid_OverlayDepth enddef ; +newscriptindex mfid_OverlayLineWidth ; mfid_OverlayLineWidth := scriptindex "OverlayLineWidth" ; vardef OverlayLineWidth = runscript mfid_OverlayLineWidth enddef ; +newscriptindex mfid_OverlayOffset ; mfid_OverlayOffset := scriptindex "OverlayOffset" ; vardef OverlayOffset = runscript mfid_OverlayOffset enddef ; +newscriptindex mfid_OverlayRegion ; mfid_OverlayRegion := scriptindex "OverlayRegion" ; vardef OverlayRegion = runscript mfid_OverlayRegion enddef ; + +immutable % permanent + % CurrentLayout, OverlayLineColor, OverlayColor, + OverlayWidth, OverlayHeight, OverlayDepth, OverlayLineWidth, OverlayOffset, OverlayRegion ; + +newscriptindex mfid_defaultcolormodel ; mfid_defaultcolormodel := scriptindex "defaultcolormodel" ; vardef defaultcolormodel = runscript mfid_defaultcolormodel enddef ; + +immutable % permanent + defaultcolormodel ; + +vardef LeftMarginWidth = if mfun_swapped and not OnRightPage : runscript mfid_RightMarginWidth else : runscript mfid_LeftMarginWidth fi enddef ; +vardef RightMarginWidth = if mfun_swapped and not OnRightPage : runscript mfid_LeftMarginWidth else : runscript mfid_RightMarginWidth fi enddef ; +vardef LeftMarginDistance = if mfun_swapped and not OnRightPage : runscript mfid_RightMarginDistance else : runscript mfid_LeftMarginDistance fi enddef ; +vardef RightMarginDistance = if mfun_swapped and not OnRightPage : runscript mfid_LeftMarginDistance else : runscript mfid_RightMarginDistance fi enddef ; + +vardef LeftEdgeWidth = if mfun_swapped and not OnRightPage : runscript mfid_RightEdgeWidth else : runscript mfid_LeftEdgeWidth fi enddef ; +vardef RightEdgeWidth = if mfun_swapped and not OnRightPage : runscript mfid_LeftEdgeWidth else : runscript mfid_RightEdgeWidth fi enddef ; +vardef LeftEdgeDistance = if mfun_swapped and not OnRightPage : runscript mfid_RightEdgeDistance else : runscript mfid_LeftEdgeDistance fi enddef ; +vardef RightEdgeDistance = if mfun_swapped and not OnRightPage : runscript mfid_LeftEdgeDistance else : runscript mfid_RightEdgeDistance fi enddef ; + +vardef BackSpace = if mfun_swapped and not OnRightPage : PaperWidth - MakeupWidth - fi runscript mfid_BackSpace enddef ; +vardef CutSpace = if mfun_swapped and not OnRightPage : PaperWidth - MakeupWidth - fi runscript mfid_CutSpace enddef ; + +% better use: + +vardef OuterMarginWidth = if not OnRightPage : runscript mfid_LeftMarginWidth else : runscript mfid_RightMarginWidth fi enddef ; +vardef InnerMarginWidth = if not OnRightPage : runscript mfid_RightMarginWidth else : runscript mfid_LeftMarginWidth fi enddef ; +vardef OuterMarginDistance = if not OnRightPage : runscript mfid_LeftMarginDistance else : runscript mfid_RightMarginDistance fi enddef ; +vardef InnerMarginDistance = if not OnRightPage : runscript mfid_RightMarginDistance else : runscript mfid_LeftMarginDistance fi enddef ; + +vardef OuterEdgeWidth = if not OnRightPage : runscript mfid_LeftEdgeWidth else : runscript mfid_RightEdgeWidth fi enddef ; +vardef InnerEdgeWidth = if not OnRightPage : runscript mfid_RightEdgeWidth else : runscript mfid_LeftEdgeWidth fi enddef ; +vardef OuterEdgeDistance = if not OnRightPage : runscript mfid_LeftEdgeDistance else : runscript mfid_RightEdgeDistance fi enddef ; +vardef InnerEdgeDistance = if not OnRightPage : runscript mfid_RightEdgeDistance else : runscript mfid_LeftEdgeDistance fi enddef ; + +vardef OuterSpaceWidth = if not OnRightPage : runscript mfid_BackSpace else : runscript mfid_CutSpace fi enddef ; +vardef InnerSpaceWidth = if not OnRightPage : runscript mfid_CutSpace else : runscript mfid_BackSpace fi enddef ; + +% indices + +vardef OuterMargin = if not OnRightPage : LeftMargin else : RightMargin fi enddef ; +vardef InnerMargin = if not OnRightPage : RightMargin else : LeftMargin fi enddef ; + +vardef OuterEdge = if not OnRightPage : LeftEdge else : RightEdge fi enddef ; +vardef InnerEdge = if not OnRightPage : RightEdge else : LeftEdge fi enddef ; + +immutable % permanent + LeftMarginWidth, RightMarginWidth, LeftMarginDistance, RightMarginDistance, + LeftEdgeWidth, RightEdgeWidth, LeftEdgeDistance, RightEdgeDistance, BackSpace, + CutSpace, OuterMarginWidth, InnerMarginWidth, OuterMarginDistance, + InnerMarginDistance, OuterEdgeWidth, InnerEdgeWidth, OuterEdgeDistance, + InnerEdgeDistance, OuterSpaceWidth, InnerSpaceWidth, OuterMargin, InnerMargin, + OuterEdge, InnerEdge ; diff --git a/Master/texmf-dist/metapost/context/base/mpxl/mp-figs.mpxl b/Master/texmf-dist/metapost/context/base/mpxl/mp-figs.mpxl new file mode 100644 index 00000000000..1a99c138a99 --- /dev/null +++ b/Master/texmf-dist/metapost/context/base/mpxl/mp-figs.mpxl @@ -0,0 +1,47 @@ +%D \module +%D [ file=mp-figs.mpiv, +%D version=2003.01.15, +%D title=\CONTEXT\ \METAPOST\ graphics, +%D subtitle=figures, +%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 licen-en.pdf for +%C details. + +if known metafun_loaded_figs : endinput ; fi ; + +newinternal boolean metafun_loaded_figs ; metafun_loaded_figs := true ; immutable metafun_loaded_figs ; + +% todo: check defined + +def registerfigure(expr name,width,height) = + begingroup ; + save s ; string s ; s := cleanstring(name) ; + scantokens( s & "_width := " & decimal(width )) ; + scantokens( s & "_height := " & decimal(height)) ; + endgroup ; +enddef ; + +vardef figuresize(expr name) = + save s, p ; string s ; pair p ; + s := cleanstring(name) ; + scantokens( "p := " & "(" & s & "_width" & "," & s & "_height" & ")" ) ; + p +enddef ; + +vardef figurewidth(expr name) = + xpart figuresize(name) +enddef ; + +vardef figureheight(expr name) = + ypart figuresize(name) +enddef ; + +let figuredimensions = figuresize ; % for old times sake + +def naturalfigure(expr name) = + externalfigure name xyscaled(figuresize(name)) +enddef ; diff --git a/Master/texmf-dist/metapost/context/base/mpxl/mp-form.mpxl b/Master/texmf-dist/metapost/context/base/mpxl/mp-form.mpxl new file mode 100644 index 00000000000..9bc02616d22 --- /dev/null +++ b/Master/texmf-dist/metapost/context/base/mpxl/mp-form.mpxl @@ -0,0 +1,28 @@ +%D \module +%D [ file=mp-form.mpiv, +%D version=2011.10.14, +%D title=\CONTEXT\ \METAPOST\ graphics, +%D subtitle=form support, +%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 licen-en.pdf for +%C details. + +% The graph package will be replaced by our own variant using +% MetaPost 2 features and textext. + +if known metafun_loaded_form : endinput ; fi ; + +newinternal boolean metafun_loaded_form ; metafun_loaded_form := true ; immutable metafun_loaded_form ; + +% The following function accept a number or string that can be +% converted to a number by \LUA. The first argument is a format +% where @ can be used instead of %. The number is typeset in math +% mode and @3e is converted into @.3e. + +vardef mfun_format_number(expr fmt, i) = + "\ctxlua{metapost.formatnumber('" & fmt & "'," & if string i : i else : decimal i fi & ")}" +enddef ; diff --git a/Master/texmf-dist/metapost/context/base/mpxl/mp-func.mpxl b/Master/texmf-dist/metapost/context/base/mpxl/mp-func.mpxl new file mode 100644 index 00000000000..8f3e8ba2039 --- /dev/null +++ b/Master/texmf-dist/metapost/context/base/mpxl/mp-func.mpxl @@ -0,0 +1,87 @@ +%D \module +%D [ file=mp-func.mpiv, +%D version=2001.12.29, +%D title=\CONTEXT\ \METAPOST\ graphics, +%D subtitle=function hacks, +%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 licen-en.pdf for +%C details. + +%D Under construction. + +if known metafun_loaded_func : endinput ; fi ; + +newinternal boolean metafun_loaded_func ; metafun_loaded_func := true ; immutable metafun_loaded_func ; + +string mfun_pathconnectors[] ; + +mfun_pathconnectors[0] := "," ; +mfun_pathconnectors[1] := "--" ; +mfun_pathconnectors[2] := ".." ; +mfun_pathconnectors[3] := "..." ; +mfun_pathconnectors[4] := "---" ; + +def pathconnectors = mfun_pathconnectors enddef ; + +vardef mfun_function (expr f) (expr u, t, b, e, s) = + save x ; numeric x ; + save c ; string c ; c := if string f : f else : mfun_pathconnectors[f] fi ; + for xx := b step s until e : + hide (x := xx ;) + if xx > b : + scantokens(c) + fi + (scantokens(u),scantokens(t)) + endfor +enddef ; + +def function = mfun_function enddef ; % let doesn't work here +def constructedfunction = mfun_function enddef ; +def straightfunction = mfun_function (1) enddef ; +def curvedfunction = mfun_function (2) enddef ; + +% def punkedfunction = mfun_function (1) enddef ; % same as straightfunction +% def tightfunction = mfun_function (3) enddef ; % same as curvedfunction + +vardef mfun_constructedpath (expr f) (text t) = + save ok ; boolean ok ; ok := false ; + save c ; string c ; c := if string f : f else : mfun_pathconnectors[f] fi ; + for i=t : + if ok : + scantokens(c) + else : + ok := true ; + fi + i + endfor +enddef ; + +def constructedpath = mfun_constructedpath enddef ; % let doesn't work here +def straightpath = mfun_constructedpath (1) enddef ; +def curvedpath = mfun_constructedpath (2) enddef ; + +% def punkedpath = mfun_constructedpath (1) enddef ; % same as straightpath +% def tightpath = mfun_constructedpath (3) enddef ; % same as curvedpath + +vardef mfun_constructedpairs (expr f) (text p) = + save i ; i := -1 ; + save c ; string c ; c := if string f : f else : mfun_pathconnectors[f] fi ; + forever : + exitif unknown p[incr(i)] ; + if i>0 : + scantokens(c) + fi + p[i] + endfor +enddef ; + +def constructedpairs = mfun_constructedpairs enddef ; % let doesn't work here +def straightpairs = mfun_constructedpairs (1) enddef ; +def curvedpairs = mfun_constructedpairs (2) enddef ; + +% def punkedpairs = mfun_constructedpairs (1) enddef ; % same as straightpairs +% def tightpairs = mfun_constructedpairs (3) enddef ; % same as curvedpairs diff --git a/Master/texmf-dist/metapost/context/base/mpxl/mp-grid.mpxl b/Master/texmf-dist/metapost/context/base/mpxl/mp-grid.mpxl new file mode 100644 index 00000000000..95bb0378662 --- /dev/null +++ b/Master/texmf-dist/metapost/context/base/mpxl/mp-grid.mpxl @@ -0,0 +1,127 @@ +%D \module +%D [ file=mp-grid.mpiv, +%D version=2000.07.10, +%D title=\CONTEXT\ \METAPOST\ graphics, +%D subtitle=grid support, +%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 licen-en.pdf for +%C details. + +%D Under construction. + +if known metafun_loaded_grid : endinput ; fi ; + +newinternal boolean metafun_loaded_grid ; metafun_loaded_grid := true ; immutable metafun_loaded_grid ; + +string fmt_separator ; fmt_separator := "@" ; +numeric fmt_precision ; fmt_precision := 3 ; +boolean fmt_initialize ; fmt_initialize := false ; +boolean fmt_zerocheck ; fmt_zerocheck := true ; + +if unknown fmt_loaded : input "mp-form.mpxl" ; fi ; + +boolean fmt_pictures ; fmt_pictures := true ; + +def do_format = if fmt_pictures : format else : formatstr fi enddef ; +def do_mformat = if fmt_pictures : Mformat else : Mformatstr fi enddef ; + +numeric grid_eps ; grid_eps = eps ; + +def hlingrid (expr asked_min, asked_max, asked_step, asked_length, asked_width) text t = + image ( + for i=asked_min step asked_step until asked_max+grid_eps : + draw (origin--(asked_width,0)) shifted (0,i*(asked_length/asked_max)) t ; + endfor ; + ) ; +enddef ; + +def vlingrid (expr asked_min, asked_max, asked_step, asked_length, asked_height) text t = + image ( + for i=asked_min step asked_step until asked_max+grid_eps : + draw (origin--(0,asked_height)) shifted (i*(asked_length/asked_max),0) t ; + endfor ; + ) ; +enddef ; + +def hloggrid (expr asked_min, asked_max, asked_step, asked_length, asked_width) text t = + image ( + for i=max(asked_min,1) step asked_step until min(asked_max,10)+grid_eps : + draw (origin--(asked_width,0)) shifted (0,asked_length*log(i)) t ; + endfor ; + ) ; +enddef ; + +def vloggrid (expr asked_min, asked_max, asked_step, asked_length, asked_height) text t = + image ( + for i=max(asked_min,1) step asked_step until min(asked_max,10)+grid_eps : + draw (origin--(0,asked_height)) shifted (asked_length*log(i),0) t ; + endfor ; + ) ; +enddef ; + +vardef hlintext@#(expr asked_min, asked_max, asked_step, asked_length, asked_format) text t = + image ( + for i=asked_min step asked_step until asked_max+grid_eps : + draw textext@#(mfun_format_number(asked_format,i)) shifted (0,i*(asked_length/asked_max)) t ; + endfor ; + ) +enddef ; + +vardef vlintext@#(expr asked_min, asked_max, asked_step, asked_length, asked_format) text t = + image ( + for i=asked_min step asked_step until asked_max+grid_eps : + draw textext@#(mfun_format_number(asked_format,i)) shifted (i*(asked_length/asked_max),0) t ; + endfor ; + ) +enddef ; + +vardef hlogtext@#(expr asked_min, asked_max, asked_step, asked_length, asked_format) text t = + image ( + for i=max(asked_min,1) step asked_step until min(asked_max,10)+grid_eps : + draw textext@#(mfun_format_number(asked_format,i)) shifted (0,asked_length*log(i)) t ; + endfor ; + ) +enddef ; + +vardef vlogtext@#(expr asked_min, asked_max, asked_step, asked_length, asked_format) text t = + image ( + for i=max(asked_min,1) step asked_step until min(asked_max,10)+grid_eps : + draw textext@#(mfun_format_number(asked_format,i)) shifted (asked_length*log(i),0) t ; + endfor ; + ) +enddef ; + +vardef hlinlabel@#(expr asked_min, asked_max, asked_step, asked_length) text t = + image ( + for i=asked_min step asked_step until asked_max+grid_eps : + draw thelabel@#(decimal i,(0,i*(asked_length/asked_max))) t ; + endfor ; + ) +enddef ; + +vardef vlinlabel@#(expr asked_min, asked_max, asked_step, asked_length) text t = + image ( + for i=asked_min step asked_step until asked_max+grid_eps : + draw thelabel@#(decimal i,(i*(asked_length/asked_max),0)) t ; + endfor ; + ) +enddef ; + +% these will be replace by lmt_* variants + +vardef linlog(expr xy) = ( xpart xy, log(ypart xy)) enddef ; +vardef loglin(expr xy) = (log(xpart xy), ypart xy) enddef ; +vardef loglog(expr xy) = (log(xpart xy), log(ypart xy)) enddef ; +vardef linlin(expr xy) = ( (xpart xy), (ypart xy)) enddef ; + +vardef loglinpath primary p = processpath (p) (loglin) enddef ; +vardef linlogpath primary p = processpath (p) (linlog) enddef ; +vardef loglogpath primary p = processpath (p) (loglog) enddef ; +vardef linlinpath primary p = processpath (p) (linlin) enddef ; + +permanent hlingrid, vlingrid, hloggrid, vloggrid, hlintext, vlintext, hlogtext, vlogtext, hlinlabel, vlinlabel ; +permanent linlog, loglin, loglog, linlin, loglinpath, linlogpath, loglogpath, linlinpath ; diff --git a/Master/texmf-dist/metapost/context/base/mpxl/mp-grph.mpxl b/Master/texmf-dist/metapost/context/base/mpxl/mp-grph.mpxl new file mode 100644 index 00000000000..8517293aa9a --- /dev/null +++ b/Master/texmf-dist/metapost/context/base/mpxl/mp-grph.mpxl @@ -0,0 +1,209 @@ +%D \module +%D [ file=mp-grph.mpiv, +%D version=2000.12.14, +%D title=\CONTEXT\ \METAPOST\ graphics, +%D subtitle=graphic text support, +%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 licen-en.pdf for +%C details. + +%D Under construction. + +if known metafun_loaded_grph : endinput ; fi ; + +newinternal boolean metafun_loaded_grph ; metafun_loaded_grph := true ; immutable metafun_loaded_grph ; + +numeric mfun_fig_nesting ; mfun_fig_nesting := 0 ; + +def beginfig (expr c) = + mfun_fig_nesting := mfun_fig_nesting + 1 ; + if mfun_fig_nesting = 1 : + begingroup + charcode := c ; + resetfig ; + scantokens extra_beginfig ; + fi ; +enddef ; + +def endfig = + ; % safeguard + if mfun_fig_nesting = 1 : + scantokens extra_endfig ; + shipit ; + endgroup ; + fi ; + mfun_fig_nesting := mfun_fig_nesting - 1 ; +enddef; + +def resetfig = + clearxy ; + clearit ; + clearpen ; + pickup defaultpen ; + interim linecap := linecap ; + interim linejoin := linejoin ; + interim miterlimit := miterlimit ; + % not really needed: + save temp_b ; color temp_b ; temp_b := background ; + save background ; color background ; background := temp_b ; + % + drawoptions () ; +enddef ; + +permanent beginfig, endfig, resetfig ; + +def protectgraphicmacros = + save showtext ; + save beginfig ; let beginfig = begingraphictextfig ; + save endfig ; let endfig = endgraphictextfig ; + save end ; let end = relax ; + resetfig ; % resets currentpicture +enddef ; + +numeric currentgraphictext ; currentgraphictext := 0 ; + +def begingraphictextfig (expr n) = + foundpicture := n ; + scratchpicture := nullpicture ; +enddef ; + +def endgraphictextfig = + if foundpicture = currentgraphictext : + expandafter endinput + else : + scratchpicture := nullpicture ; + fi ; +enddef ; + +def loadfigure primary filename = + mfun_load_figure(filename) +enddef ; + +def mfun_load_figure (expr filename) text figureattributes = + mutable beginfig, endfig ; + begingroup ; + save figurenumber, figurepicture, number, fixedplace ; + numeric figurenumber ; figurenumber := 0 ; + boolean figureshift ; figureshift := true ; + picture figurepicture ; figurepicture := currentpicture ; + def number primary n = hide(figurenumber := n) enddef ; + def fixedplace = hide(figureshift := false) enddef ; + protectgraphicmacros ; + % defaults + interim linecap := rounded ; + interim linejoin := rounded ; + interim miterlimit := 10 ; + % + currentpicture := nullpicture ; + draw fullcircle figureattributes ; % expand number + currentpicture := nullpicture ; + def beginfig (expr n) = + currentpicture := nullpicture ; + if (figurenumber=n) or (figurenumber=0) : + let endfig = endinput ; + fi ; + enddef ; + let endfig = relax ; + readfile(filename) ; + if figureshift : + currentpicture := currentpicture shifted -llcorner currentpicture ; + fi ; + addto figurepicture also currentpicture figureattributes ; + currentpicture := figurepicture ; + endgroup ; + permanent beginfig, endfig ; +enddef ; + +% We only use the new method now. + +boolean mfun_gt_color_fill ; +boolean mfun_gt_color_draw ; +boolean mfun_gt_shade_fill ; +boolean mfun_gt_reverse_fill ; +boolean mfun_gt_outline_fill ; +picture mfun_gt_picture ; + +def mfun_gt_default = % somewhat compatible + scaled 11.5 + withpen pencircle scaled .1 +enddef ; + +def graphictext primary t = % use outlinetext instead + begingroup ; + mfun_graphic_text_indeed(t) +enddef ; + +def mfun_graphic_text_indeed(expr t) text rest = + interim linecap := butt ; % normally rounded + interim linejoin := mitered ; % normally rounded + % interim miterlimit := 10 ; % todo + % + let normalwithshade = withshade ; + % + save reversefill, outlinefill, withshade, withfillcolor, withdrawcolor ; + % + def mfun_gt_fill = enddef ; + def mfun_gt_draw = enddef ; + def mfun_gt_shade = enddef ; + % + mfun_gt_color_fill := false ; + mfun_gt_color_draw := false ; + mfun_gt_shade_fill := false ; + mfun_gt_reverse_fill := false ; + % + def reversefill = hide(mfun_gt_reverse_fill := true) enddef ; + def outlinefill = enddef ; + def withshade primary c = hide(mfun_gt_shade_fill := true; def mfun_gt_shade = normalwithshade c enddef ;) enddef ; + def withfillcolor primary c = hide(mfun_gt_color_fill := true; def mfun_gt_fill = withcolor c enddef ;) enddef ; + def withdrawcolor primary c = hide(mfun_gt_color_draw := true; def mfun_gt_draw = withcolor c enddef ;) enddef ; + % + mfun_gt_picture := nullpicture ; + addto mfun_gt_picture doublepath origin rest ; % preroll + mfun_gt_picture := nullpicture ; + % + def reversefill = enddef ; + def outlinefill = enddef ; + def withshade primary c = enddef ; + def withfillcolor primary c = enddef ; + def withdrawcolor primary c = enddef ; + % + if mfun_gt_shade_fill : + draw outlinetext.f(t)(mfun_gt_shade) rest; + elseif mfun_gt_color_fill and mfun_gt_color_draw : + if mfun_gt_reverse_fill : + draw outlinetext.r(t)(mfun_gt_default mfun_gt_fill)(mfun_gt_default mfun_gt_draw) rest; + else : + draw outlinetext.b(t)(mfun_gt_default mfun_gt_draw)(mfun_gt_default mfun_gt_fill) rest; + fi ; + elseif mfun_gt_color_fill : + draw outlinetext.f(t)(mfun_gt_default mfun_gt_fill) rest; + elseif mfun_gt_color_draw : + draw outlinetext.d(t)(mfun_gt_default mfun_gt_draw) rest ; + else : + draw outlinetext.d(t)(mfun_gt_default) rest ; + fi ; + % + endgroup ; +enddef ; + +% example +% +% beginfig (1) ; +% graphictext +% "\vbox{\hsize10cm \input tufte }" +% scaled 8 +% withdrawcolor blue +% withfillcolor red +% withpen pencircle scaled 2pt ; +% endfig ; +% +% beginfig(1) ; +% loadfigure "gracht.mp" rotated 20 ; +% loadfigure "koe.mp" number 1 scaled 2 ; +% endfig ; +% +% end diff --git a/Master/texmf-dist/metapost/context/base/mpiv/mp-lmtx.mpxl b/Master/texmf-dist/metapost/context/base/mpxl/mp-lmtx.mpxl index cd4712ea8aa..ec21b150afd 100644 --- a/Master/texmf-dist/metapost/context/base/mpiv/mp-lmtx.mpxl +++ b/Master/texmf-dist/metapost/context/base/mpxl/mp-lmtx.mpxl @@ -14,9 +14,9 @@ % This is an experimental module where I test some new interface methods; % for real advanced graphics use the luapost module. -if known context_lmtx : endinput ; fi ; +if known metafun_loaded_lmtx : endinput ; fi ; -boolean context_lmtx ; context_lmtx := true ; +newinternal boolean metafun_loaded_lmtx ; metafun_loaded_lmtx := true ; immutable metafun_loaded_lmtx ; presetparameters "text" [ offset = 0, @@ -354,12 +354,13 @@ def lmt_followtext = applyparameters "followtext" "lmt_do_followtext" enddef ; vardef lmt_do_followtext = image ( pushparameters "followtext" ; - save s_u ; string s_u ; s_u := getparameter "autoscaleup" ; - save s_d ; string s_d ; s_d := getparameter "autoscaledown" ; + save scale_up ; string scale_up ; scale_up := getparameter "autoscaleup" ; + save scale_down ; string scale_down ; scale_down := getparameter "autoscaledown" ; save followtextalternative ; followtextalternative := if getparameter "spread" : 1 else : 0 fi ; - save tracingfollowtext ; tracingfollowtext := if getparameter "trace" : 1 else : 0 fi ; - save autoscaleupfollowtext ; autoscaleupfollowtext := if s_u = "yes" : 1 elseif s_u = "max" : 2 else : 0 fi ; - save autoscaledownfollowtext ; autoscaledownfollowtext := if s_d = "yes" : 1 elseif s_d = "max" : 2 else : 0 fi ; + save autoscaleupfollowtext ; autoscaleupfollowtext := if scale_up = "yes" : 1 elseif scale_up = "max" : 2 else : 0 fi ; + save autoscaledownfollowtext ; autoscaledownfollowtext := if scale_down = "yes" : 1 elseif scale_down = "max" : 2 else : 0 fi ; + % save tracingfollowtext ; tracingfollowtext := if getparameter "trace" : 1 else : 0 fi ; + interim tracingfollowtext := if getparameter "trace" : 1 else : 0 fi ; draw followtext ( if (getparameter "reverse") : reverse fi (getparameter "path"), getparameter "text" @@ -392,11 +393,11 @@ vardef lmt_do_arrow = save l ; string l ; l := getparameter "location" ; save k ; string k ; k := getparameter "kind" ; save p ; path p ; p := getparameter "path" ; - save ahvariant ; ahvariant := if a = "dimpled" : 1 elseif a = "curved" : 2 else : 0 fi ; - save ahdimple ; ahdimple := getparameter "dimple" ; - save ahscale ; ahscale := getparameter "scale" ; - save ahangle ; ahangle := getparameter "angle" ; - save ahlength ; ahlength := getparameter "length" ; + interim ahvariant := if a = "dimpled" : 1 elseif a = "curved" : 2 else : 0 fi ; + interim ahdimple := getparameter "dimple" ; + interim ahscale := getparameter "scale" ; + interim ahangle := getparameter "angle" ; + interim ahlength := getparameter "length" ; if not getparameter "headonly" : draw p ; fi ; @@ -992,6 +993,8 @@ vardef OverlayMesh(expr p, s) = lmt_mesh [ paths = { meshed(p,OverlayBox,s) } ] enddef ; +permanent meshed, OverlayMesh ; + % charts presetparameters "chart" [ @@ -1391,33 +1394,34 @@ vardef lmt_do_shade = color_b := getparameter "colors" 2 ; fi if hasparameter "direction" : - save a, b, bb ; path bb ; + save a, b, bb, temp_x, temp_y ; path bb ; + temp_x := temp_y := 0 ; bb := boundingbox(mfun_shade_path) ; a := b := -1 ; if string getparameter "direction" : s := getparameter "direction" ; if s = "up" : - p_a := xpart shadedup ; - p_b := ypart shadedup ; + temp_x := xpart shadedup ; + temp_y := ypart shadedup ; elseif s = "down" : - p_a := xpart shadeddown ; - p_b := ypart shadeddown ; + temp_x := xpart shadeddown ; + temp_y := ypart shadeddown ; elseif s = "left" : - p_a := xpart shadedleft ; - p_b := ypart shadedleft ; + temp_x := xpart shadedleft ; + temp_y := ypart shadedleft ; elseif s = "right" : - p_a := xpart shadedright ; - p_b := ypart shadedright ; + temp_x := xpart shadedright ; + temp_y := ypart shadedright ; fi else : - p_a := getparameter "direction" 1 ; - p_a := getparameter "direction" 2 ; + temp_x := getparameter "direction" 1 ; + temp_y := getparameter "direction" 2 ; fi - if p_a >= 0 : - center_a := point p_a of bb ; + if temp_x >= 0 : + center_a := point temp_x of bb ; fi - if p_b >= 0 : - center_b := point p_b of bb ; + if temp_y >= 0 : + center_b := point temp_y of bb ; fi fi ; if hasparameter "center" : @@ -2082,6 +2086,8 @@ vardef svggray(expr s) = s enddef ; +permanent svgforcecmyk, svgcolor, svgcmyk, svggray ; + presetparameters "svg" [ filename = "", fontname = "", @@ -2212,12 +2218,53 @@ presetparameters "mpsglyph" [ def lmt_registerglyphs = applyparameters "mpsglyphs" "lmt_do_registerglyphs" enddef ; def lmt_registerglyph = applyparameters "mpsglyph" "lmt_do_registerglyph" enddef ; -vardef lmt_do_registerglyphs = lua.mp.lmt_register_glyphs() ; enddef ; -vardef lmt_do_registerglyph = lua.mp.lmt_register_glyph () ; enddef ; +newscriptindex mfid_registerglyphs ; mfid_registerglyphs := scriptindex "registerglyphs" ; def lmt_do_registerglyphs = runscript mfid_registerglyphs enddef ; +newscriptindex mfid_registerglyph ; mfid_registerglyph := scriptindex "registerglyph" ; def lmt_do_registerglyph = runscript mfid_registerglyph enddef ; + +% An experimental macro: + +vardef registercomposedglyph (expr u) (suffix snippets) = + save s ; s := getparameterdefault "mpsfont" "scale" 1 ; + save llx, lly, urx, ury ; + llx := xpart llcorner snippets[u] ; + if llx <> 0 : + % this should be an option or we need a lsb + snippets[u] := snippets[u] shifted (-llx, 0) ; + llx := 0; + fi ; + lly := ypart llcorner snippets[u] / s ; + urx := xpart urcorner snippets[u] / s ; + ury := ypart urcorner snippets[u] / s ; + lmt_registerglyph [ + category = getparameter "mpsfont" "category", + unicode = u, + code = "draw " & str snippets & "[" & decimal u & "]", + height = ury, + depth = - lly, + width = urx - llx, + boundingbox = { llx, lly, urx, ury } + ] ; +enddef ; + +vardef composeglyph (suffix snippets) = + save u ; u := getparameter "mpsfont" "unicode" ; + save s ; s := getparameterdefault "mpsfont" "scale" 1 ; + snippets[u] := image ( + for i=1 upto getparametercount "mpsfont" "shapes" : + draw scantokens ( getparameter "mpsfont" "shapes" i "shape" ) + if hasparameter "mpsfont" "shapes" i "color" : + withcolor getparameter "mpsfont" "shapes" i "color" + fi ; + endfor ; + ) scaled s ; + registercomposedglyph(u, snippets) ; +enddef ; + +permanent registercomposeglyph, composeglyph ; % Again an experiment (todo: the faster method): -def lmt_remaptext = runscript("mp.lmt_do_remaptext()") enddef ; +newscriptindex mfid_remaptext ; mfid_remaptext := scriptindex "remaptext" ; def lmt_remaptext = runscript mfid_remaptext enddef ; triplet mfun_tt_s ; @@ -2225,9 +2272,9 @@ vardef rawmaptext(expr s) = mfun_tt_n := mfun_tt_n + 1 ; mfun_tt_c := nullpicture ; mfun_tt_o := nullpicture ; - addto mfun_tt_o doublepath origin _op_ ; % save drawoptions - mfun_tt_r := lua.mp.mf_map_text(mfun_tt_n,s) ; - mfun_tt_s := lua.mp.mf_map_move(mfun_tt_n) ; + addto mfun_tt_o doublepath origin base_draw_options ; + mfun_tt_r := lua.mp.mf_map_text(mfun_tt_n,s,catcoderegime) ; % can become mfid_maptext + mfun_tt_s := lua.mp.mf_map_move(mfun_tt_n) ; % can become mfid_mapmove addto mfun_tt_c doublepath unitsquare xscaled wdpart mfun_tt_r yscaled (htpart mfun_tt_r + dppart mfun_tt_r) @@ -2256,3 +2303,101 @@ vardef svgtext(expr t) = enddef ; vardef svg expr c = lmt_svg [ code = c ] enddef ; + +% Fun stuff: + +presetparameters "poisson" [ + width = 50, + height = 50, + initialx = 0, + initialy = 0, + distance = 1, + count = 20, + macro = "draw", + arguments = 2 +] ; + +def lmt_poisson = applyparameters "poisson" "lmt_do_poisson" enddef ; + +vardef lmt_do_poisson = + image ( + pushparameters "poisson" ; + lua.mp.lmt_poisson_generate(); + popparameters ; + ) +enddef ; + +permanent + lmt_text, lmt_grid, lmt_axis, lmt_outline, lmt_followtext, + lmt_arrow, lmt_placeholder, % lmt_path, + lmt_function, lmt_poisson, lmt_mesh, + lmt_chart_circle, lmt_chart_histogram, lmt_chart_bar, + lmt_shade, lmt_contour, lmt_svg, lmt_surface, + lmt_registerglyphs, lmt_registerglyph, + lmt_remaptext, rawmaptext, svgtext, svg, + OverlayMesh ; + +% nice hack + +newscriptindex mfid_scrutenized ; mfid_scrutenized := scriptindex "scrutenized" ; + +primarydef p scrutenized n = + runscript mfid_scrutenized p n +enddef ; + +permanent scrutenized ; + +% for now here + +% newscriptindex mfid_mpv_numeric ; mfid_mpv_numeric := scriptindex "mpv_numeric" ; +% newscriptindex mfid_mpv_dimension ; mfid_mpv_dimension := scriptindex "mpv_dimension" ; +% newscriptindex mfid_mpv_string ; mfid_mpv_string := scriptindex "mpv_string" ; +% +% def mpv_numeric = runscript mfid_mpv_numeric enddef ; +% def mpv_dimension = runscript mfid_mpv_dimension enddef ; +% def mpv_string = runscript mfid_mpv_string enddef ; +% +% permanent mpv_numeric, mpv_dimension, mpv_string ; + +newscriptindex mfid_mpvar ; mfid_mpvar := scriptindex "mpvar" ; + +def mpvar = runscript mfid_mpvar enddef ; + +permanent mpvar ; + +% for old times sake (metafun manual) + +vardef textual primary p = false enddef ; + +% also for the menafun manual: + +newscriptindex mfid_labtorgb ; mfid_labtorgb := scriptindex "labtorgb" ; + +def labtorgb(expr l, a, b) = runscript mfid_labtorgb l a b enddef ; + +permanent labtorgb ; + +presetparameters "labtorgb" [ + mina = -100, + maxa = 100, + minb = -100, + maxb = 100, + step = 5, + l = 50, +] ; + +def lmt_labtorgb = applyparameters "labtorgb" "lmt_do_labtorgb" enddef ; + +vardef lmt_do_labtorgb = + image ( + pushparameters "labtorgb" ; + save l ; l := getparameter "l" ; + for a = getparameter "mina" step getparameter "step" until getparameter "maxa" : + for b = getparameter "minb" step getparameter "step" until getparameter "maxb" : + % draw (a,b) withcolor labtorgb(l,a,b) ; + draw (a,b) withcolor runscript mfid_labtorgb l a b ; + endfor ; + endfor ; + popparameters ; + ) +enddef ; diff --git a/Master/texmf-dist/metapost/context/base/mpxl/mp-luas.mpxl b/Master/texmf-dist/metapost/context/base/mpxl/mp-luas.mpxl new file mode 100644 index 00000000000..b98305bba59 --- /dev/null +++ b/Master/texmf-dist/metapost/context/base/mpxl/mp-luas.mpxl @@ -0,0 +1,319 @@ +%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 ; + +def message expr t = + lua.mp.report(tostring(t)) ; +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: + +vardef texmode (expr s) = lua.mp("mode", s) enddef ; +vardef systemmode(expr s) = lua.mp("systemmode",s) enddef ; + +permanent texmode, systemmode ; + +% A few helpers + +vardef isarray suffix a = lua.mp.isarray (str a) enddef ; +vardef prefix suffix a = lua.mp.prefix (str a) enddef ; +vardef dimension suffix a = lua.mp.dimension(str a) enddef ; + +permanent isarray, prefix, dimension ; + +% 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 ; + +vardef positionpath (expr name) = lua.mp.positionpath (name) enddef ; +vardef positioncurve (expr name) = lua.mp.positioncurve (name) enddef ; +vardef positionxy (expr name) = lua.mp.positionxy (name) enddef ; +vardef positionpxy (expr name) = lua.mp.positionpxy (name) enddef ; +vardef positionwhd (expr name) = lua.mp.positionwhd (name) enddef ; +vardef positionpage (expr name) = lua.mp.positionpage (name) enddef ; +vardef positionregion(expr name) = lua.mp.positionregion(name) enddef ; +vardef positionbox (expr name) = lua.mp.positionbox (name) enddef ; +vardef positionanchor = lua.mp.positionanchor() enddef ; + +vardef positioninregion = + currentpicture := currentpicture shifted - positionxy(positionanchor) ; +enddef ; + +vardef positionatanchor(expr name) = + currentpicture := currentpicture shifted - positionxy(name) ; +enddef ; + +permanent positionpath, positioncurve, positionxy, positionpxy, positionwhd, positionpage, + positionregion, positionbox, positionanchor, positioninregion, positionatanchor ; + +let wdpart = redpart ; +let htpart = greenpart ; +let dppart = bluepart ; + +permanent wdpart, htpart, dppart; + +vardef texvar(expr name) = lua.mp.texvar(name) enddef ; +vardef texstr(expr name) = lua.mp.texstr(name) 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" ; + +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 ; + +permanent getparameters, presetparameters, hasparameter, hasoption, getparameter, getparameterdefault, + getparametercount, getmaxparametercount, getparameterpath, getparameterpen, getparametertext, % getparameteroption, + applyparameters, pushparameters, popparameters ; + +% 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 ; diff --git a/Master/texmf-dist/metapost/context/base/mpxl/mp-math.mpxl b/Master/texmf-dist/metapost/context/base/mpxl/mp-math.mpxl new file mode 100644 index 00000000000..cfe9e55e672 --- /dev/null +++ b/Master/texmf-dist/metapost/context/base/mpxl/mp-math.mpxl @@ -0,0 +1,183 @@ +%D \module +%D [ file=mp-math.mpiv, +%D version=2019.07.26, % was mp-core: 1999.08.01, anchoring +%D title=\CONTEXT\ \METAPOST\ graphics, +%D subtitle=extra math functions, +%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_math : endinput ; fi ; + +newinternal boolean metafun_loaded_math ; metafun_loaded_math := true ; immutable metafun_loaded_math ; + +% draw textext(decimal runscript("mp.numeric(xmath.gamma(.12))")) ; + +newscriptindex mfid_m_acos ; mfid_m_acos := scriptindex "m_acos" ; def m_acos = runscript mfid_m_acos enddef ; +newscriptindex mfid_m_acosh ; mfid_m_acosh := scriptindex "m_acosh" ; def m_acosh = runscript mfid_m_acosh enddef ; +newscriptindex mfid_m_asin ; mfid_m_asin := scriptindex "m_asin" ; def m_asin = runscript mfid_m_asin enddef ; +newscriptindex mfid_m_asinh ; mfid_m_asinh := scriptindex "m_asinh" ; def m_asinh = runscript mfid_m_asinh enddef ; +newscriptindex mfid_m_atan ; mfid_m_atan := scriptindex "m_atan" ; def m_atan = runscript mfid_m_atan enddef ; +newscriptindex mfid_m_atantwo ; mfid_m_atantwo := scriptindex "m_atan2" ; def m_atantwo = runscript mfid_m_atantwo enddef ; % atan2 +newscriptindex mfid_m_atanh ; mfid_m_atanh := scriptindex "m_atanh" ; def m_atanh = runscript mfid_m_atanh enddef ; +newscriptindex mfid_m_cbrt ; mfid_m_cbrt := scriptindex "m_cbrt" ; def m_cbrt = runscript mfid_m_cbrt enddef ; +newscriptindex mfid_m_ceil ; mfid_m_ceil := scriptindex "m_ceil" ; def m_ceil = runscript mfid_m_ceil enddef ; +newscriptindex mfid_m_copysign ; mfid_m_copysign := scriptindex "m_copysign" ; def m_copysign = runscript mfid_m_copysign enddef ; +newscriptindex mfid_m_cos ; mfid_m_cos := scriptindex "m_cos" ; def m_cos = runscript mfid_m_cos enddef ; +newscriptindex mfid_m_cosh ; mfid_m_cosh := scriptindex "m_cosh" ; def m_cosh = runscript mfid_m_cosh enddef ; +newscriptindex mfid_m_deg ; mfid_m_deg := scriptindex "m_deg" ; def m_deg = runscript mfid_m_deg enddef ; +newscriptindex mfid_m_erf ; mfid_m_erf := scriptindex "m_erf" ; def m_erf = runscript mfid_m_erf enddef ; +newscriptindex mfid_m_erfc ; mfid_m_erfc := scriptindex "m_erfc" ; def m_erfc = runscript mfid_m_erfc enddef ; +newscriptindex mfid_m_exp ; mfid_m_exp := scriptindex "m_exp" ; def m_exp = runscript mfid_m_exp enddef ; +newscriptindex mfid_m_exptwo ; mfid_m_exptwo := scriptindex "m_exp2" ; def m_exptwo = runscript mfid_m_exptwo enddef ; % exp2 +newscriptindex mfid_m_expm ; mfid_m_expm := scriptindex "m_expm1" ; def m_expm = runscript mfid_m_expm enddef ; % expm1 +newscriptindex mfid_m_fabs ; mfid_m_fabs := scriptindex "m_fabs" ; def m_fabs = runscript mfid_m_fabs enddef ; +newscriptindex mfid_m_fdim ; mfid_m_fdim := scriptindex "m_fdim" ; def m_fdim = runscript mfid_m_fdim enddef ; +newscriptindex mfid_m_floor ; mfid_m_floor := scriptindex "m_floor" ; def m_floor = runscript mfid_m_floor enddef ; +newscriptindex mfid_m_fma ; mfid_m_fma := scriptindex "m_fma" ; def m_fma = runscript mfid_m_fma enddef ; +newscriptindex mfid_m_fmax ; mfid_m_fmax := scriptindex "m_fmax" ; def m_fmax = runscript mfid_m_fmax enddef ; +newscriptindex mfid_m_fmin ; mfid_m_fmin := scriptindex "m_fmin" ; def m_fmin = runscript mfid_m_fmin enddef ; +newscriptindex mfid_m_fmod ; mfid_m_fmod := scriptindex "m_fmod" ; def m_fmod = runscript mfid_m_fmod enddef ; +newscriptindex mfid_m_frexp ; mfid_m_frexp := scriptindex "m_frexp" ; def m_frexp = runscript mfid_m_frexp enddef ; +newscriptindex mfid_m_gamma ; mfid_m_gamma := scriptindex "m_gamma" ; def m_gamma = runscript mfid_m_gamma enddef ; +newscriptindex mfid_m_hypot ; mfid_m_hypot := scriptindex "m_hypot" ; def m_hypot = runscript mfid_m_hypot enddef ; +newscriptindex mfid_m_isfinite ; mfid_m_isfinite := scriptindex "m_isfinite" ; def m_isfinite = runscript mfid_m_isfinite enddef ; +newscriptindex mfid_m_isinf ; mfid_m_isinf := scriptindex "m_isinf" ; def m_isinf = runscript mfid_m_isinf enddef ; +newscriptindex mfid_m_isnan ; mfid_m_isnan := scriptindex "m_isnan" ; def m_isnan = runscript mfid_m_isnan enddef ; +newscriptindex mfid_m_isnormal ; mfid_m_isnormal := scriptindex "m_isnormal" ; def m_isnormal = runscript mfid_m_isnormal enddef ; +newscriptindex mfid_m_jz ; mfid_m_jz := scriptindex "m_j0" ; def m_jz = runscript mfid_m_jz enddef ; % j0 +newscriptindex mfid_m_j ; mfid_m_j := scriptindex "m_j1" ; def m_j = runscript mfid_m_j enddef ; % j1 +newscriptindex mfid_m_jn ; mfid_m_jn := scriptindex "m_jn" ; def m_jn = runscript mfid_m_jn enddef ; +newscriptindex mfid_m_ldexp ; mfid_m_ldexp := scriptindex "m_ldexp" ; def m_ldexp = runscript mfid_m_ldexp enddef ; +newscriptindex mfid_m_lgamma ; mfid_m_lgamma := scriptindex "m_lgamma" ; def m_lgamma = runscript mfid_m_lgamma enddef ; +newscriptindex mfid_m_log ; mfid_m_log := scriptindex "m_log" ; def m_log = runscript mfid_m_log enddef ; +newscriptindex mfid_m_logten ; mfid_m_logten := scriptindex "m_log10" ; def m_logten = runscript mfid_m_logten enddef ; % log10 +newscriptindex mfid_m_logp ; mfid_m_logp := scriptindex "m_log1p" ; def m_logp = runscript mfid_m_logp enddef ; % log1p +newscriptindex mfid_m_logtwo ; mfid_m_logtwo := scriptindex "m_log2" ; def m_logtwo = runscript mfid_m_logtwo enddef ; % log2 +newscriptindex mfid_m_logb ; mfid_m_logb := scriptindex "m_logb" ; def m_logb = runscript mfid_m_logb enddef ; +newscriptindex mfid_m_modf ; mfid_m_modf := scriptindex "m_modf" ; def m_modf = runscript mfid_m_modf enddef ; +newscriptindex mfid_m_nearbyint ; mfid_m_nearbyint := scriptindex "m_nearbyint" ; def m_nearbyint = runscript mfid_m_nearbyint enddef ; +newscriptindex mfid_m_nextafter ; mfid_m_nextafter := scriptindex "m_nextafter" ; def m_nextafter = runscript mfid_m_nextafter enddef ; +newscriptindex mfid_m_pow ; mfid_m_pow := scriptindex "m_pow" ; def m_pow = runscript mfid_m_pow enddef ; +newscriptindex mfid_m_rad ; mfid_m_rad := scriptindex "m_rad" ; def m_rad = runscript mfid_m_rad enddef ; +newscriptindex mfid_m_remainder ; mfid_m_remainder := scriptindex "m_remainder" ; def m_remainder = runscript mfid_m_remainder enddef ; +newscriptindex mfid_m_remquo ; mfid_m_remquo := scriptindex "m_remquo" ; def m_remquo = runscript mfid_m_remquo enddef ; +newscriptindex mfid_m_round ; mfid_m_round := scriptindex "m_round" ; def m_round = runscript mfid_m_round enddef ; +newscriptindex mfid_m_scalbn ; mfid_m_scalbn := scriptindex "m_scalbn" ; def m_scalbn = runscript mfid_m_scalbn enddef ; +newscriptindex mfid_m_sin ; mfid_m_sin := scriptindex "m_sin" ; def m_sin = runscript mfid_m_sin enddef ; +newscriptindex mfid_m_sinh ; mfid_m_sinh := scriptindex "m_sinh" ; def m_sinh = runscript mfid_m_sinh enddef ; +newscriptindex mfid_m_sqrt ; mfid_m_sqrt := scriptindex "m_sqrt" ; def m_sqrt = runscript mfid_m_sqrt enddef ; +newscriptindex mfid_m_tan ; mfid_m_tan := scriptindex "m_tan" ; def m_tan = runscript mfid_m_tan enddef ; +newscriptindex mfid_m_tanh ; mfid_m_tanh := scriptindex "m_tanh" ; def m_tanh = runscript mfid_m_tanh enddef ; +newscriptindex mfid_m_tgamma ; mfid_m_tgamma := scriptindex "m_tgamma" ; def m_tgamma = runscript mfid_m_tgamma enddef ; +newscriptindex mfid_m_trunc ; mfid_m_trunc := scriptindex "m_trunc" ; def m_trunc = runscript mfid_m_trunc enddef ; +newscriptindex mfid_m_yz ; mfid_m_yz := scriptindex "m_y0" ; def m_yz = runscript mfid_m_yz enddef ; % y0 +newscriptindex mfid_m_y ; mfid_m_y := scriptindex "m_y1" ; def m_y = runscript mfid_m_y enddef ; % y1 +newscriptindex mfid_m_yn ; mfid_m_yn := scriptindex "m_yn" ; def m_yn = runscript mfid_m_yn enddef ; + +newscriptindex mfid_c_sin ; mfid_c_sin := scriptindex "c_sin" ; def c_sin = runscript mfid_c_sin enddef ; +newscriptindex mfid_c_cos ; mfid_c_cos := scriptindex "c_cos" ; def c_cos = runscript mfid_c_cos enddef ; +newscriptindex mfid_c_tan ; mfid_c_tan := scriptindex "c_tan" ; def c_tan = runscript mfid_c_tan enddef ; +newscriptindex mfid_c_sinh ; mfid_c_sinh := scriptindex "c_sinh" ; def c_sinh = runscript mfid_c_sinh enddef ; +newscriptindex mfid_c_cosh ; mfid_c_cosh := scriptindex "c_cosh" ; def c_cosh = runscript mfid_c_cosh enddef ; +newscriptindex mfid_c_tanh ; mfid_c_tanh := scriptindex "c_tanh" ; def c_tanh = runscript mfid_c_tanh enddef ; + +newscriptindex mfid_c_asin ; mfid_c_asin := scriptindex "c_asin" ; def c_asin = runscript mfid_c_asin enddef ; +newscriptindex mfid_c_acos ; mfid_c_acos := scriptindex "c_acos" ; def c_acos = runscript mfid_c_acos enddef ; +newscriptindex mfid_c_atan ; mfid_c_atan := scriptindex "c_atan" ; def c_atan = runscript mfid_c_atan enddef ; +newscriptindex mfid_c_asinh ; mfid_c_asinh := scriptindex "c_asinh" ; def c_asinh = runscript mfid_c_asinh enddef ; +newscriptindex mfid_c_acosh ; mfid_c_acosh := scriptindex "c_acosh" ; def c_acosh = runscript mfid_c_acosh enddef ; +newscriptindex mfid_c_atanh ; mfid_c_atanh := scriptindex "c_atanh" ; def c_atanh = runscript mfid_c_atanh enddef ; + +newscriptindex mfid_c_sqrt ; mfid_c_sqrt := scriptindex "c_sqrt" ; def c_sqrt = runscript mfid_c_sqrt enddef ; +newscriptindex mfid_c_abs ; mfid_c_abs := scriptindex "c_abs" ; def c_abs = runscript mfid_c_abs enddef ; +newscriptindex mfid_c_arg ; mfid_c_arg := scriptindex "c_arg" ; def c_arg = runscript mfid_c_arg enddef ; +newscriptindex mfid_c_conj ; mfid_c_conj := scriptindex "c_conj" ; def c_conj = runscript mfid_c_conj enddef ; +newscriptindex mfid_c_exp ; mfid_c_exp := scriptindex "c_exp" ; def c_exp = runscript mfid_c_exp enddef ; +newscriptindex mfid_c_log ; mfid_c_log := scriptindex "c_log" ; def c_log = runscript mfid_c_log enddef ; +newscriptindex mfid_c_proj ; mfid_c_proj := scriptindex "c_proj" ; def c_proj = runscript mfid_c_proj enddef ; + +newscriptindex mfid_c_erf ; mfid_c_erf := scriptindex "c_erf" ; def c_erf = runscript mfid_c_erf enddef ; +newscriptindex mfid_c_erfc ; mfid_c_erfc := scriptindex "c_erfc" ; def c_erfc = runscript mfid_c_erfc enddef ; +newscriptindex mfid_c_erfcx ; mfid_c_erfcx := scriptindex "c_erfcx" ; def c_erfcx = runscript mfid_c_erfcx enddef ; +newscriptindex mfid_c_erfi ; mfid_c_erfi := scriptindex "c_erfi" ; def c_erfi = runscript mfid_c_erfi enddef ; + +% mfid_c_imag ; mfid_c_acos := scriptindex "c_imag" ; def c_imag = runscript mfid_c_imag enddef ; +% mfid_c_real ; mfid_c_acos := scriptindex "c_real" ; def c_real = runscript mfid_c_real enddef ; +% mfid_c_neg ; mfid_c_neg := scriptindex "c_neg" ; def c_neg = runscript mfid_c_neg enddef ; + +newscriptindex mfid_c_pow ; mfid_c_pow := scriptindex "c_pow" ; def c_pow (expr a,b) = runscript mfid_c_pow a b enddef ; +% mfid_c_add ; mfid_c_add := scriptindex "c_add" ; def c_add (expr a,b) = runscript mfid_c_add a b enddef ; +% mfid_c_sub ; mfid_c_sub := scriptindex "c_sub" ; def c_sub (expr a,b) = runscript mfid_c_sub a b enddef ; +newscriptindex mfid_c_mul ; mfid_c_mul := scriptindex "c_mul" ; def c_mul (expr a,b) = runscript mfid_c_mul a b enddef ; +newscriptindex mfid_c_div ; mfid_c_div := scriptindex "c_div" ; def c_div (expr a,b) = runscript mfid_c_div a b enddef ; + +newscriptindex mfid_c_voigt ; mfid_c_voigt := scriptindex "c_voigt" ; def c_voigt (expr a,b,c) = runscript mfid_c_voigt a b c enddef ; +newscriptindex mfid_c_voigt_hwhm ; mfid_c_voigt_hwhm := scriptindex "c_voigt_hwhm" ; def c_voigt_hwhm(expr a,b) = runscript mfid_c_voigt_hwhm a b enddef ; + +vardef c_add (expr a, b) = a + b enddef ; +vardef c_sub (expr a, b) = a + b enddef ; +vardef c_imag(expr a) = ypart a enddef ; +vardef c_real(expr a) = xpart a enddef ; +vardef c_neg (expr a) = -a enddef ; + +if (numbersystem == "scaled") or (numbersystem == "double") : + + % vardef sqrt primary x = m_sqrt x enddef ; + + % vardef sqr primary x = x*x enddef ; + % vardef log primary x = if x=0: 0 else: mlog(x)/mlog(10) fi enddef ; + % vardef ln primary x = if x=0: 0 else: mlog(x)/256 fi enddef ; + % vardef exp primary x = (mexp 256)**x enddef ; + % vardef inv primary x = if x=0: 0 else: x**-1 fi enddef ; + + vardef sin primary x = m_sin x enddef ; vardef sinh primary x = m_sinh x enddef ; + vardef cos primary x = m_cos x enddef ; vardef cosh primary x = m_cosh x enddef ; + vardef tan primary x = m_tan x enddef ; vardef tanh primary x = m_tanh x enddef ; + vardef asin primary x = m_asin x enddef ; vardef asinh primary x = m_asinh x enddef ; + vardef acos primary x = m_acos x enddef ; vardef acosh primary x = m_acosh x enddef ; + vardef atan primary x = m_atan x enddef ; vardef atanh primary x = m_atanh x enddef ; + + vardef invsin primary x = (m_asin(x))/radian enddef ; + vardef invcos primary x = (m_acos(x))/radian enddef ; + vardef invtan primary x = (m_atan(x))/radian enddef ; + + % vardef sind primary x = angle(m_sin x) enddef ; + % vardef cosd primary x = angle(m_cos x) enddef ; + % vardef tand primary x = angle(m_tan x) enddef ; + + vardef asind primary x = angle(m_asin x) enddef ; + vardef acosd primary x = angle(m_acos x) enddef ; + vardef atand primary x = angle(m_atan x) enddef ; + + % vardef tand primary x = sind(x)/cosd(x) enddef ; + % vardef cotd primary x = cosd(x)/sind(x) enddef ; + + permanent sin, cos, tan, sinh, cosh, tanh, asin, acos, atan, asinh, acosh, atanh, invsin, invcos, invtan, asind, acosd, atand ; + +fi ; + +permanent + m_acos, m_acosh, m_asin, m_asinh, m_atan, m_atantwo, m_atanh, m_cbrt, m_ceil, + m_copysign, m_cos, m_cosh, m_deg, m_erf, m_erfc, m_exp, m_exptwo, m_expm, m_fabs, + m_fdim, m_floor, m_fma, m_fmax, m_fmin, m_fmod, m_frexp, m_gamma, m_hypot, + m_isfinite, m_isinf, m_isnan, m_isnormal, m_jz, m_j, m_jn, m_ldexp, m_lgamma, + m_log, m_logten, m_logp, m_logtwo, m_logb, m_modf, m_nearbyint, m_nextafter, + m_pow, m_rad, m_remainder, m_remquo, m_round, m_scalbn, m_sin, m_sinh, m_sqrt, + m_tan, m_tanh, m_tgamma, m_trunc, m_yz, m_y, m_yn, + + c_sin, c_cos, c_tan, c_sinh, c_cosh, c_tanh, c_asin, c_acos, c_atan, c_asinh, + c_acosh, c_atanh, c_sqrt, c_abs, c_arg, c_conj, c_exp, c_log, c_proj, c_erf, + c_erfc, c_erfcx, c_erfi, c_imag, c_real, c_neg, c_pow, c_add, c_sub, c_mul, + c_div, c_voigt, c_voigt_hwhm, c_add, c_sub, c_imag, c_real, c_neg, + + % sqrt, sind, cosd, % these are primitives + + sqr, log, ln, exp, inv, sin, cos, tan, asin, acos, atan, invsin, invcos, invtan, + tand, asind, acosd, atand, tand, cotd +; + diff --git a/Master/texmf-dist/metapost/context/base/mpxl/mp-miss.mpxl b/Master/texmf-dist/metapost/context/base/mpxl/mp-miss.mpxl new file mode 100644 index 00000000000..0788fece4ca --- /dev/null +++ b/Master/texmf-dist/metapost/context/base/mpxl/mp-miss.mpxl @@ -0,0 +1,68 @@ +%D \module +%D [ file=mp-miss.mpiv, +%D version=2021.02.01, +%D title=\CONTEXT\ \METAPOST\ graphics, +%D subtitle=missing glyphs, +%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_miss : endinput ; fi ; + +newinternal boolean metafun_loaded_miss ; metafun_loaded_miss := true ; immutable metafun_loaded_miss ; + +picture MissingSnippets[][]; + +vardef MissingGlyphSymbol(expr w, h, d) = + image ( + draw (0,-d)--(w,-d)--(w,h)--(0,h)--cycle ; + if d <> 0 : draw (0,0)--(w,0) ; + ) +enddef ; + +vardef MissingLowercase = image ( draw MissingGlyphSymbol(.45, .55, .20) scaled 1000 ; ) enddef ; +vardef MissingUppercase = image ( draw MissingGlyphSymbol(.65, .70, .25) scaled 1000 ; ) enddef ; +vardef MissingMark = image ( draw MissingGlyphSymbol(.15, .70, -.50) scaled 1000 ; ) enddef ; +vardef MissingPunctuation = image ( draw MissingGlyphSymbol(.15, .55, .20) scaled 1000 ; ) enddef ; +vardef MissingUnknown = image ( draw MissingGlyphSymbol(.45, .20, 0) scaled 1000 ; ) enddef ; + +% vardef MissingGlyph = +% pickup pencircle scaled 0.05 ; +% composeglyph(MissingSnippets[getparameterdefault "mpsfont" "namespace" 1]) ; +% enddef ; + +vardef MissingGlyph = + save u ; u := getparameterdefault "mpsfont" "unicode" 1; + save s ; s := getparameterdefault "mpsfont" "scale" 1 ; + save n ; n := getparameterdefault "mpsfont" "namespace" 1 ; + save i ; i := getparameterdefault "mpsfont" "slant" 0 ; + save w ; w := getparameterdefault "mpsfont" "weight" 1 ; + pickup pencircle scaled (0.05 * w) ; + MissingSnippets[n][u] := image ( + draw scantokens ( getparameter "mpsfont" "shapes" (1) "shape" ) + withcolor getparameter "mpsfont" "shapes" (1) "color" + ) scaled s slanted i ; + registercomposedglyph(u, MissingSnippets[n]) ; +enddef ; + +lmt_registerglyphs [ + name = "missing", + units = 1000, + width = 100, + height = 100, + depth = 0, +] ; + +% we need to set up some basics (signals to the backend and such) at definition +% time so we just force a bogus shape (zero) + +lmt_registerglyph [ + category = "missing", +] ; + +permanent MissingSnippets, MissingGlyphSymbol, MissingLowercase, MissingUppercase, + MissingMark, MissingPunctuation, MissingUnknown, MissingGlyph ; diff --git a/Master/texmf-dist/metapost/context/base/mpxl/mp-mlib.mpxl b/Master/texmf-dist/metapost/context/base/mpxl/mp-mlib.mpxl new file mode 100644 index 00000000000..ce0d14b411e --- /dev/null +++ b/Master/texmf-dist/metapost/context/base/mpxl/mp-mlib.mpxl @@ -0,0 +1,1830 @@ +%D \module +%D [ file=mp-mlib.mpiv, +%D version=2008.03.21, +%D title=\CONTEXT\ \METAPOST\ graphics, +%D subtitle=plugins, +%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 licen-en.pdf for +%C details. + +if known metafun_loaded_mlib : endinput ; fi ; + +newinternal boolean metafun_loaded_mlib ; metafun_loaded_mlib := true ; immutable metafun_loaded_mlib ; + +% numeric LUATEXFUNCTIONALITY ; LUATEXFUNCTIONALITY := runscript("mp.print(LUATEXFUNCTIONALITY or (status and status.development_id) or 6346)") ; + +%D Objects: + +vardef isobject expr p = + if picture p : + % lua.mp.isobject(prescriptpart p) + runscript("mp.isobject(" & prescriptpart p & ")") + else : + false + fi +enddef ; + +permanent isobject ; + +%D Color and transparency +%D +%D Separable: + +newinternal normaltransparent ; normaltransparent := 1 ; +newinternal multiplytransparent ; multiplytransparent := 2 ; +newinternal screentransparent ; screentransparent := 3 ; +newinternal overlaytransparent ; overlaytransparent := 4 ; +newinternal softlighttransparent ; softlighttransparent := 5 ; +newinternal hardlighttransparent ; hardlighttransparent := 6 ; +newinternal colordodgetransparent ; colordodgetransparent := 7 ; +newinternal colorburntransparent ; colorburntransparent := 8 ; +newinternal darkentransparent ; darkentransparent := 9 ; +newinternal lightentransparent ; lightentransparent := 10 ; +newinternal differencetransparent ; differencetransparent := 11 ; +newinternal exclusiontransparent ; exclusiontransparent := 12 ; + +%D Nonseparable: + +newinternal huetransparent ; huetransparent := 13 ; +newinternal saturationtransparent ; saturationtransparent := 14 ; +newinternal colortransparent ; colortransparent := 15 ; +newinternal luminositytransparent ; luminositytransparent := 16 ; + +permanent normaltransparent, multiplytransparent, screentransparent, overlaytransparent, + softlighttransparent, hardlighttransparent, colordodgetransparent, colorburntransparent, + darkentransparent, lightentransparent, differencetransparent, exclusiontransparent, + huetransparent, saturationtransparent, colortransparent, luminositytransparent ; + +vardef transparency_alternative_to_number(expr name) = + if string name : + if expandafter known scantokens(name & "transparent") : + scantokens(name & "transparent") + else : + 0 + fi + elseif name < 17 : + name + else : + 0 + fi +enddef ; + +def namedcolor expr n = + (1) + withprescript "sp_type=named" + withprescript "sp_name=" & n +enddef ; + +% def mfun_spotcolor(expr n, v) = +% 1 +% withprescript "sp_type=xspot" +% withprescript "sp_name=" & n +% withprescript "sp_value=" & (if numeric v : decimal v else : v fi) +% enddef ; + +% def mfun_multispotcolor(expr name, fractions, components, value) = +% 1 +% withprescript "sp_type=multispot" +% withprescript "sp_name=" & name +% withprescript "sp_fractions=" & decimal fractions +% withprescript "sp_components=" & components +% withprescript "sp_value=" & value +% enddef ; + +def spotcolor(expr name, v) = + (1) + withprescript "sp_type=spot" + withprescript "sp_name=" & name + withprescript "sp_value=" & colordecimals v +enddef ; + +% In this case a mixed color will be calculated: + +def multitonecolor(expr name)(text t) = + (1) + withprescript "sp_type=multitone" + withprescript "sp_name=" & name + withprescript "sp_value=" & colordecimalslist(t) +enddef ; + +def transparent(expr a, t)(text c) = % use withtransparency instead + (1) % this permits withcolor x intoshade y + withprescript "tr_alternative=" & decimal transparency_alternative_to_number(a) + withprescript "tr_transparency=" & decimal t + withcolor c +enddef ; + +def withtransparency(expr a, t) = + withprescript "tr_alternative=" & decimal transparency_alternative_to_number(a) + withprescript "tr_transparency=" & decimal t +enddef ; + +% no, not compatible ... maybe only mpiv .. maybe withopacity + +% let opacity = pair ; + +% def withtransparency expr t = +% withprescript "tr_alternative=" & decimal transparency_alternative_to_number(xpart t) +% withprescript "tr_transparency=" & decimal ypart t +% enddef ; +% +% withtransparency (1,.5) +% withtransparency ("normal",.5) +% +% withopacity (1,.5) +% withopacity (normaltransparency,.5) +% withopacity .5 + +def withopacity expr t = + if pair t : + withprescript "tr_alternative=" & decimal transparency_alternative_to_number(xpart t) + withprescript "tr_transparency=" & decimal ypart t + else : + mfun_with_opacity (transparency_alternative_to_number(t)) + fi +enddef ; + +def mfun_with_opacity (expr a) expr t = + withprescript "tr_alternative=" & decimal a + withprescript "tr_transparency=" & decimal t +enddef ; + +% Provided for downward compability: + +def cmyk(expr c, m, y, k) = + (c,m,y,k) +enddef ; + +permanent spotcolor, multitonecolor, transparent, withtransparency, namedcolor, withopacity, cmyk ; + +% Texts (todo: better strut ratio, now .7 hardcoded, should be passed) + +newinternal textextoffset ; textextoffset := 0 ; + +permanent textextoffset ; + +%%%%%%% mfun_tt_w[], mfun_tt_h[], mfun_tt_d[] ; % we can consider using colors (less hash space) +color mfun_tt_b ; +numeric mfun_tt_n ; mfun_tt_n := 0 ; +picture mfun_tt_p ; mfun_tt_p := nullpicture ; +picture mfun_tt_o ; mfun_tt_o := nullpicture ; +picture mfun_tt_c ; mfun_tt_c := nullpicture ; + +if unknown mfun_trial_run : + boolean mfun_trial_run ; + mfun_trial_run := false ; +else : + % already defined before the format is loaded +fi ; + +def mfun_reset_tex_texts = + mfun_tt_n := 0 ; + mfun_tt_p := nullpicture ; + mfun_tt_o := nullpicture ; % redundant + mfun_tt_c := nullpicture ; % redundant +enddef ; + +def mfun_flush_tex_texts = + addto currentpicture also mfun_tt_p +enddef ; + +extra_endfig := "mfun_flush_tex_texts ;" & extra_endfig ; +extra_beginfig := extra_beginfig & "mfun_reset_tex_texts ;" ; + +% We collect and flush them all, as we can also have temporary textexts +% that gets never really flushed but are used for calculations. So, we +% flush twice: once in location in order to pick up e.g. color properties, +% and once at the end because we need to flush missing ones. + +boolean mfun_onetime_textext ; mfun_onetime_textext := false ; +numeric mfun_global_textext ; mfun_global_textext := 0 ; + +def keepcached = + hide(mfun_global_textext := mfun_global_textext + 1;) + withprescript ("tx_cache=" & decimal mfun_global_textext) +enddef ; + +def notcached = + withprescript "tx_cache=no" +enddef ; + +permanent keepcached, notcached ; + +% todo: onetime + +rgbcolor mfun_tt_r ; + +newinternal inicatcoderegime ; inicatcoderegime := runscript("return catcodes.numbers.ctxcatcodes") ; +newinternal texcatcoderegime ; texcatcoderegime := runscript("return catcodes.numbers.texcatcodes") ; +newinternal luacatcoderegime ; luacatcoderegime := runscript("return catcodes.numbers.luacatcodes") ; +newinternal notcatcoderegime ; notcatcoderegime := runscript("return catcodes.numbers.notcatcodes") ; +newinternal vrbcatcoderegime ; vrbcatcoderegime := runscript("return catcodes.numbers.vrbcatcodes") ; +newinternal prtcatcoderegime ; prtcatcoderegime := runscript("return catcodes.numbers.prtcatcodes") ; +newinternal ctxcatcoderegime ; ctxcatcoderegime := runscript("return catcodes.numbers.ctxcatcodes") ; +newinternal txtcatcoderegime ; txtcatcoderegime := runscript("return catcodes.numbers.txtcatcodes") ; + +newinternal catcoderegime ; catcoderegime := ctxcatcoderegime ; + +immutable inicatcoderegime, texcatcoderegime, luacatcoderegime, notcatcoderegime, + vrbcatcoderegime, prtcatcoderegime, ctxcatcoderegime, txtcatcoderegime ; + +permanent catcoderegime ; + +newscriptindex mfid_sometextext ; mfid_sometextext := scriptindex "sometextext" ; +newscriptindex mfid_madetextext ; mfid_madetextext := scriptindex "madetextext" ; + +vardef rawtextext(expr s) = + if s = "" : + nullpicture + else : + mfun_tt_n := mfun_tt_n + 1 ; + mfun_tt_c := nullpicture ; + mfun_tt_o := nullpicture ; + addto mfun_tt_o doublepath origin base_draw_options ; + mfun_tt_r := runscript mfid_sometextext mfun_tt_n s catcoderegime ; + addto mfun_tt_c doublepath unitsquare + xscaled wdpart mfun_tt_r + yscaled (htpart mfun_tt_r + dppart mfun_tt_r) + shifted (0,-dppart mfun_tt_r) + withprescript "mf_object=text" + withprescript "tx_index=" & decimal mfun_tt_n + withprescript "tx_color=" & colordecimals colorpart mfun_tt_o + ; + mfun_tt_c + fi +enddef ; + +vardef rawmadetext = + mfun_tt_n := mfun_tt_n + 1 ; + mfun_tt_c := nullpicture ; + mfun_tt_o := nullpicture ; + addto mfun_tt_o doublepath origin base_draw_options ; + mfun_tt_r := runscript mfid_madetextext mfun_tt_n ; + addto mfun_tt_c doublepath unitsquare + xscaled wdpart mfun_tt_r + yscaled (htpart mfun_tt_r + dppart mfun_tt_r) + shifted (0,-dppart mfun_tt_r) + withprescript "mf_object=text" + withprescript "tx_index=" & decimal mfun_tt_n + withprescript "tx_color=" & colordecimals colorpart mfun_tt_o + ; + mfun_tt_c +enddef ; + +vardef validtexbox(expr category, name) = + if category == "" : + false + elseif string name : + name <> "" + elseif numeric name : + name > 0 + else : + true + fi +enddef ; + +vardef rawtexbox(expr category, name) = + mfun_tt_c := nullpicture ; + if validtexbox(category,name) : + mfun_tt_b := lua.mp.mf_tb_dimensions(category, name) ; + addto mfun_tt_c doublepath unitsquare + xscaled wdpart mfun_tt_b + yscaled (htpart mfun_tt_b + dppart mfun_tt_b) + shifted (0,- dppart mfun_tt_b) + withprescript "mf_object=box" + withprescript "bx_category=" & if numeric category : decimal fi category + withprescript "bx_name=" & if numeric name : decimal fi name ; + fi + mfun_tt_c +enddef ; + +% More text + +defaultfont := "Mono" ; +defaultscale := 1 ; + +extra_beginfig := extra_beginfig & "defaultscale:=1;" ; + +vardef fontsize expr name = + save size ; numeric size ; + size := bbwidth(textext("\MPfontsizehskip{" & name & "}")) ; + if size = 0 : + 12pt + else : + size + fi +enddef ; + +permanent fontsize ; + +pair mfun_laboff ; mfun_laboff := origin ; +pair mfun_laboff.lft ; mfun_laboff.lft := (-1,0) ; +pair mfun_laboff.rt ; mfun_laboff.rt := (1,0) ; +pair mfun_laboff.bot ; mfun_laboff.bot := (0,-1) ; +pair mfun_laboff.top ; mfun_laboff.top := (0,1) ; +pair mfun_laboff.ulft ; mfun_laboff.ulft := (-.7,.7) ; +pair mfun_laboff.urt ; mfun_laboff.urt := (.7,.7) ; +pair mfun_laboff.llft ; mfun_laboff.llft := -(.7,.7) ; +pair mfun_laboff.lrt ; mfun_laboff.lrt := (.7,-.7) ; + +pair mfun_laboff.d ; mfun_laboff.d := mfun_laboff ; +pair mfun_laboff.dflt ; mfun_laboff.dflt := mfun_laboff.lft ; +pair mfun_laboff.drt ; mfun_laboff.drt := mfun_laboff.rt ; +pair mfun_laboff.origin ; mfun_laboff.origin := mfun_laboff ; +pair mfun_laboff.raw ; mfun_laboff.raw := mfun_laboff ; + +pair mfun_laboff.l ; mfun_laboff.l := mfun_laboff.lft ; +pair mfun_laboff.r ; mfun_laboff.r := mfun_laboff.rt ; +pair mfun_laboff.b ; mfun_laboff.b := mfun_laboff.bot ; +pair mfun_laboff.t ; mfun_laboff.t := mfun_laboff.top ; +pair mfun_laboff.l_t ; mfun_laboff.l_t := mfun_laboff.ulft ; +pair mfun_laboff.r_t ; mfun_laboff.r_t := mfun_laboff.urt ; +pair mfun_laboff.l_b ; mfun_laboff.l_b := mfun_laboff.llft ; +pair mfun_laboff.r_b ; mfun_laboff.r_b := mfun_laboff.lrt ; +pair mfun_laboff.t_l ; mfun_laboff.t_l := mfun_laboff.ulft ; +pair mfun_laboff.t_r ; mfun_laboff.t_r := mfun_laboff.urt ; +pair mfun_laboff.b_l ; mfun_laboff.b_l := mfun_laboff.llft ; +pair mfun_laboff.b_r ; mfun_laboff.b_r := mfun_laboff.lrt ; + +mfun_labxf := 0.5 ; +mfun_labxf.lft := mfun_labxf.l := 1 ; +mfun_labxf.rt := mfun_labxf.r := 0 ; +mfun_labxf.bot := mfun_labxf.b := 0.5 ; +mfun_labxf.top := mfun_labxf.t := 0.5 ; +mfun_labxf.ulft := mfun_labxf.l_t := mfun_labxf.t_l := 1 ; +mfun_labxf.urt := mfun_labxf.r_t := mfun_labxf.t_r := 0 ; +mfun_labxf.llft := mfun_labxf.l_b := mfun_labxf.b_l := 1 ; +mfun_labxf.lrt := mfun_labxf.r_b := mfun_labxf.b_r := 0 ; + +mfun_labxf.d := mfun_labxf ; +mfun_labxf.dflt := mfun_labxf.lft ; +mfun_labxf.drt := mfun_labxf.rt ; +mfun_labxf.origin := 0 ; +mfun_labxf.raw := 0 ; + +mfun_labyf := 0.5 ; +mfun_labyf.lft := mfun_labyf.l := 0.5 ; +mfun_labyf.rt := mfun_labyf.r := 0.5 ; +mfun_labyf.bot := mfun_labyf.b := 1 ; +mfun_labyf.top := mfun_labyf.t := 0 ; +mfun_labyf.ulft := mfun_labyf.l_t := mfun_labyf.t_l := 0 ; +mfun_labyf.urt := mfun_labyf.r_t := mfun_labyf.t_r := 0 ; +mfun_labyf.llft := mfun_labyf.l_b := mfun_labyf.b_l := 1 ; +mfun_labyf.lrt := mfun_labyf.r_b := mfun_labyf.b_r := 1 ; + +mfun_labyf.d := mfun_labyf ; +mfun_labyf.dflt := mfun_labyf.lft ; +mfun_labyf.drt := mfun_labyf.rt ; +mfun_labyf.origin := 0 ; +mfun_labyf.raw := 0 ; + +mfun_labtype := 0 ; +mfun_labtype.lft := mfun_labtype.l := 1 ; +mfun_labtype.rt := mfun_labtype.r := 2 ; +mfun_labtype.bot := mfun_labtype.b := 3 ; +mfun_labtype.top := mfun_labtype.t := 4 ; +mfun_labtype.ulft := mfun_labtype.l_t := mfun_labtype.t_l := 5 ; +mfun_labtype.urt := mfun_labtype.r_t := mfun_labtype.t_r := 6 ; +mfun_labtype.llft := mfun_labtype.l_b := mfun_labtype.b_l := 7 ; +mfun_labtype.lrt := mfun_labtype.r_b := mfun_labtype.b_r := 8 ; +mfun_labtype.d := 10 ; +mfun_labtype.dflt := 11 ; +mfun_labtype.drt := 12 ; +mfun_labtype.origin := 0 ; +mfun_labtype.raw := 0 ; + +vardef installlabel@# (expr type, x, y, offset) = + numeric mfun_labtype@# ; mfun_labtype@# := type ; + pair mfun_laboff @# ; mfun_laboff @# := offset ; + numeric mfun_labxf @# ; mfun_labxf @# := x ; + numeric mfun_labyf @# ; mfun_labyf @# := y ; +enddef ; + +permanent installlabel ; + +installlabel.center (0, 0.5, 0.5, (0,0)) ; +installlabel.c (0, 0.5, 0.5, (0,0)) ; + +installlabel.hcenter(0, 0.5, 0.5, (1,0)) ; +installlabel.h (0, 0.5, 0.5, (1,0)) ; + +installlabel.vcenter(0, 0.5, 0.5, (0,1)) ; +installlabel.v (0, 0.5, 0.5, (0,1)) ; + +vardef mfun_labshift@#(expr p) = + (mfun_labxf@#*lrcorner p + + mfun_labyf@#*ulcorner p + + (1-mfun_labxf@#-mfun_labyf@#)*llcorner p) +enddef ; + +vardef mfun_picshift@#(expr p) = + (mfun_labxf@#*ulcorner p + + mfun_labyf@#*lrcorner p + + (1-mfun_labxf@#-mfun_labyf@#)*urcorner p) +enddef ; + +% we save the plain variant + +% vardef plain_thelabel@#(expr p,z) = +% if string p : +% plain_thelabel@#(rawtextext("\definedfont[" & defaultfont & "]" & p) scaled defaultscale,z) +% else : +% p shifted (z + labeloffset*laboff@# - mfun_labshift@#(p)) +% fi +% enddef; +% +% def plain_label = % takes two arguments, contrary to textext that takes one +% normaldraw plain_thelabel +% enddef ; +% +% let mfun_label = label ; +% let mfun_thelabel = thelabel ; +% +% def useplainlabels = % somehow let doesn't work for all code +% def label = plain_label enddef ; +% def thelabel = plain_thelabel enddef ; +% enddef ; +% +% def usemetafunlabels = +% let label = mfun_label ; +% let thelabel = mfun_thelabel ; +% enddef ; +% +% plain_compatibility_data := plain_compatibility_data & "save label, thelabel ;" & "useplainlabels ;" ; + +newinternal anchortextexts ; anchortextexts := 0 ; % disabled by default + +vardef thetextext@#(expr p,z) = + % interim labeloffset := textextoffset ; + if string p : + thetextext@#(rawtextext(p),z) + elseif numeric p : + thetextext@#(rawtextext(decimal p),z) + elseif pair p : + thetextext@#(rawtextext(ddecimal p),z) + else : + if anchortextexts > 0 : + image(draw p withprescript "tx_anchor=" & ddecimal z) + else : + p + fi + if (mfun_labtype@# >= 10) : + shifted (0,ypart center p) + fi + shifted (z + textextoffset*mfun_laboff@# - mfun_labshift@#(p)) + fi +enddef ; + +vardef textext@#(expr p) = % no draw here + thetextext@#(p,origin) +enddef ; + +vardef onetimetextext@#(expr p) = % no draw here + mfun_onetime_textext := true ; + thetextext@#(p,origin) +enddef ; + +permanent rawtextext, rawmadetext, validtexbox, rawtexbox, thetextext, textext, onetimetextext ; + +% formatted text + +pair mfun_tt_z ; + +vardef rawfmttext(text t) = + mfun_tt_n := mfun_tt_n + 1 ; + mfun_tt_c := nullpicture ; + mfun_tt_o := nullpicture ; + addto mfun_tt_o doublepath origin base_draw_options ; + mfun_tt_r := lua.mp.mf_formatted_text(mfun_tt_n,t) ; + addto mfun_tt_c doublepath unitsquare + xscaled wdpart mfun_tt_r + yscaled (htpart mfun_tt_r + dppart mfun_tt_r) + shifted (0,-dppart mfun_tt_r) + withprescript "mf_object=text" + withprescript "tx_index=" & decimal mfun_tt_n + withprescript "tx_color=" & colordecimals colorpart mfun_tt_o + ; + for s = t : + if pair s : mfun_tt_z := s ; fi + endfor ; + mfun_tt_c +enddef ; + +vardef thefmttext@#(text t) = + mfun_tt_z := origin ; % initialization + save p ; picture p ; p := rawfmttext(t) ; + if anchortextexts > 0 : + image(draw p withprescript "tx_anchor=" & ddecimal mfun_tt_z) + else : + p + fi + if (mfun_labtype@# >= 10) : + shifted (0,ypart center p) + fi + shifted (mfun_tt_z + textextoffset*mfun_laboff@# - mfun_labshift@#(p)) +enddef ; + +vardef fmttext@#(text t) = % no draw here + thefmttext@#(t,origin) +enddef ; + +% or just: def fmttext = thefmttext enddef ; + +vardef onetimefmttext@#(text t) = % no draw here + mfun_onetime_textext := true ; + thefmttext@#(t,origin) +enddef ; + +% so much for formatted text + +vardef thetexbox@#(expr category, name, z) = + save p ; picture p ; p := rawtexbox(category,name) ; + p + if (mfun_labtype@# >= 10) : + shifted (0,ypart center p) + fi + shifted (z + textextoffset*mfun_laboff@# - mfun_labshift@#(p)) +enddef ; + +vardef texbox@#(expr category, name) = % no draw here + thetexbox@#(category,name,origin) +enddef ; + +permanent rawfmttext, thefmttext, fmttext, onetimefmttext, thetexbox, texbox ; + +% vardef thelabel@#(expr p,z) = +% if string p : +% thelabel@#(rawtextext("\definedfont[" & defaultfont & "]" & p) scaled defaultscale,z) +% else : +% p shifted (z + labeloffset*mfun_laboff@# - (mfun_labxf@#*lrcorner p + mfun_labyf@#*ulcorner p + (1-mfun_labxf@#-mfun_labyf@#)*llcorner p)) +% fi +% enddef; + +vardef theoffset@#(expr z) = + if pair z : + z + elseif path z : + if mfun_laboff@# = origin : + center z + else : + ((center z)-- mfun_picshift@#(z)) intersectionpoint (z if not cycle z: --cycle fi) + fi + else : % picture + mfun_picshift@#(z) + fi +enddef; + +vardef thelabel@#(expr p,z) = + if string p : + thelabel@#(rawtextext("\definedfont[" & defaultfont & "]" & p) scaled defaultscale,z) + elseif numeric p : + thelabel@#(decimal p,z) + elseif pair p : + thelabel@#("(" & decimal(xpart p) & "," & decimal(ypart p) & ")",z) + else : + p shifted (theoffset@#(z) + labeloffset*mfun_laboff@# - mfun_labshift@#(p)) + fi +enddef; + +def label = % takes two arguments, contrary to textext that takes one + normaldraw thelabel +enddef ; + +vardef anchored@#(expr p, z) = % beware: no "+ mfun_laboff@#" here (never!) + p + if (mfun_labtype@# >= 10) : + shifted (0,ypart center p) + fi + shifted (z + mfun_labshift@#(p)) +enddef ; + +let normalinfont = infont ; + +primarydef s infont name = % nasty hack + if name = "" : + textext(s) + else : + textext("\definedfont[" & name & "]" & s) + fi +enddef ; + +permanent theoffset, thelabel, anchored ; +primitive infont ; % fake primitive + +% Helper + +string mfun_prescript_separator ; mfun_prescript_separator := char(13) ; + +% Shades + +% for while we had this: + +newinternal shadefactor ; shadefactor := 1 ; % currently obsolete +pair shadeoffset ; shadeoffset := origin ; % currently obsolete +boolean trace_shades ; trace_shades := false ; % still there + +permanent shadefactor, shadeoffset ; + +% def withlinearshading (expr a, b) = +% withprescript "sh_type=linear" +% withprescript "sh_domain=0 1" +% withprescript "sh_factor=" & decimal shadefactor +% withprescript "sh_center_a=" & ddecimal (a shifted shadeoffset) +% withprescript "sh_center_b=" & ddecimal (b shifted shadeoffset) +% enddef ; +% +% def withcircularshading (expr a, b, ra, rb) = +% withprescript "sh_type=circular" +% withprescript "sh_domain=0 1" +% withprescript "sh_factor=" & decimal shadefactor +% withprescript "sh_center_a=" & ddecimal (a shifted shadeoffset) +% withprescript "sh_center_b=" & ddecimal (b shifted shadeoffset) +% withprescript "sh_radius_a=" & decimal ra +% withprescript "sh_radius_b=" & decimal rb +% enddef ; +% +% def withshading (expr how)(text rest) = +% if how = "linear" : +% withlinearshading(rest) +% elseif how = "circular" : +% withcircularshading(rest) +% else : +% % nothing +% fi +% enddef ; +% +% def withfromshadecolor expr t = +% withprescript "sh_color=into" +% withprescript "sh_color_a=" & colordecimals t +% enddef ; + +% def withtoshadecolor expr t = +% withprescript "sh_color=into" +% withprescript "sh_color_b=" & colordecimals t +% enddef ; + +% but this is nicer + +% fill fullcircle scaled 10cm +% withshademethod "circular" +% withshadevector (5cm,1cm) +% withshadecenter (.1,.5) +% withshadedomain (.2,.6) +% withshadefactor 1.2 +% withshadecolors (red,green) +% ; + +path mfun_shade_path ; +numeric mfun_shade_step ; mfun_shade_step := 0 ; + +def withshadestep = + hide(mfun_shade_step := mfun_shade_step + 1 ;) + mfun_withshadestep +enddef ; + +def mfun_withshadestep (text t) = + withprescript "sh_step=" & decimal mfun_shade_step + t +enddef ; + +numeric mfun_shade_fx, mfun_shade_fy ; +numeric mfun_shade_lx, mfun_shade_ly ; +numeric mfun_shade_nx, mfun_shade_ny ; +numeric mfun_shade_dx, mfun_shade_dy ; +numeric mfun_shade_tx, mfun_shade_ty ; + +% first + +def mfun_with_shade_method_analyze(expr p) = + mfun_shade_path := p ; + mfun_shade_step := 1 ; + mfun_shade_fx := xpart point 0 of p ; + mfun_shade_fy := ypart point 0 of p ; + mfun_shade_lx := mfun_shade_fx ; + mfun_shade_ly := mfun_shade_fy ; + mfun_shade_nx := 0 ; + mfun_shade_ny := 0 ; + mfun_shade_dx := abs(mfun_shade_fx - mfun_shade_lx) ; + mfun_shade_dy := abs(mfun_shade_fy - mfun_shade_ly) ; + for i=1 upto length(p) : + mfun_shade_tx := abs(mfun_shade_fx - xpart point i of p) ; + mfun_shade_ty := abs(mfun_shade_fy - ypart point i of p) ; + if mfun_shade_tx > mfun_shade_dx : + mfun_shade_nx := i + 1 ; + mfun_shade_lx := xpart point i of p ; + mfun_shade_dx := mfun_shade_tx ; + fi ; + if mfun_shade_ty > mfun_shade_dy : + mfun_shade_ny := i + 1 ; + mfun_shade_ly := ypart point i of p ; + mfun_shade_dy := mfun_shade_ty ; + fi ; + endfor ; +enddef ; + +vardef mfun_max_radius(expr p) = + max ( + (xpart center p - xpart llcorner p) ++ (ypart center p - ypart llcorner p), + (xpart center p - xpart ulcorner p) ++ (ypart ulcorner p - ypart center p), + (xpart lrcorner p - xpart center p) ++ (ypart center p - ypart lrcorner p), + (xpart urcorner p - xpart center p) ++ (ypart urcorner p - ypart center p) + ) +enddef ; + +vardef mfun_min_radius(expr p) = + min ( + (xpart center p - xpart llcorner p) ++ (ypart center p - ypart llcorner p), + (xpart center p - xpart ulcorner p) ++ (ypart ulcorner p - ypart center p), + (xpart lrcorner p - xpart center p) ++ (ypart center p - ypart lrcorner p), + (xpart urcorner p - xpart center p) ++ (ypart urcorner p - ypart center p) + ) +enddef ; + +primarydef p withshademethod m = + hide(mfun_with_shade_method_analyze(p)) + p + withprescript "sh_domain=0 1" + withprescript "sh_transform=yes" + withprescript "sh_color=into" + withprescript "sh_color_a=" & colordecimals white + withprescript "sh_color_b=" & colordecimals black + withprescript "sh_first=" & ddecimal point 0 of p % used for support scaling + withprescript "sh_set_x=" & ddecimal (mfun_shade_nx,mfun_shade_lx) % + withprescript "sh_set_y=" & ddecimal (mfun_shade_ny,mfun_shade_ly) % + if m = "linear" : + withprescript "sh_type=linear" + withprescript "sh_factor=1" + withprescript "sh_center_a=" & ddecimal llcorner p + withprescript "sh_center_b=" & ddecimal urcorner p + else : + withprescript "sh_type=circular" + withprescript "sh_factor=1.2" + withprescript "sh_center_a=" & ddecimal center p + withprescript "sh_center_b=" & ddecimal center p + withprescript "sh_radius_a=" & decimal 0 + withprescript "sh_radius_b=" & decimal mfun_max_radius(p) + fi +enddef ; + +def withshaderadius expr a = + withprescript "sh_radius_a=" & decimal (xpart a) + withprescript "sh_radius_b=" & decimal (ypart a) +enddef ; + +def withshadeorigin expr a = + withprescript "sh_center_a=" & ddecimal a + withprescript "sh_center_b=" & ddecimal a +enddef ; + +def withshadevector expr a = + withprescript "sh_center_a=" & ddecimal (point xpart a of mfun_shade_path) + withprescript "sh_center_b=" & ddecimal (point ypart a of mfun_shade_path) +enddef ; + +def withshadedirection expr a = + withprescript "sh_center_a=" & ddecimal (point xpart a of boundingbox(mfun_shade_path)) + withprescript "sh_center_b=" & ddecimal (point ypart a of boundingbox(mfun_shade_path)) +enddef ; + +def withshadetransform expr a = % yes | no + withprescript "sh_transform=" & a +enddef ; + +pair shadedup ; shadedup := (0.5,2.5) ; +pair shadeddown ; shadeddown := (2.5,0.5) ; +pair shadedleft ; shadedleft := (1.5,3.5) ; +pair shadedright ; shadedright := (3.5,1.5) ; + +def withshadecenter expr a = + withprescript "sh_center_a=" & ddecimal ( + center mfun_shade_path shifted ( + xpart a * bbwidth (mfun_shade_path)/2, + ypart a * bbheight(mfun_shade_path)/2 + ) + ) +enddef ; + +def withshadedomain expr d = + withprescript "sh_domain=" & ddecimal d +enddef ; + +def withshadefactor expr f = + withprescript "sh_factor=" & decimal f +enddef ; + +% def withshadebound (expr a) = +% if mfun_shade_step > 0 : +% withprescript "sh_bound_" & decimal mfun_shade_step & "=" & decimal a +% fi +% enddef ; + +def withshadefraction expr a = + if mfun_shade_step > 0 : + withprescript "sh_fraction_" & decimal mfun_shade_step & "=" & decimal a + fi +enddef ; + +def withshadecolors (expr a, b) = + if mfun_shade_step > 0 : + withprescript "sh_color=into" + withprescript "sh_color_a_" & decimal mfun_shade_step & "=" & colordecimals a + withprescript "sh_color_b_" & decimal mfun_shade_step & "=" & colordecimals b + else : + withprescript "sh_color=into" + withprescript "sh_color_a=" & colordecimals a + withprescript "sh_color_b=" & colordecimals b + fi +enddef ; + +primarydef a shadedinto b = % withcolor red shadedinto green + 1 % does not work with transparency + withprescript "sh_color=into" + withprescript "sh_color_a=" & colordecimals a + withprescript "sh_color_b=" & colordecimals b +enddef ; + +primarydef p withshade sc = + p withprescript mfun_defined_cs_pre[sc] +enddef ; + +def defineshade suffix s = + mfun_defineshade(str s) +enddef ; + +def mfun_defineshade (expr s) text t = + expandafter def scantokens s = t enddef ; +enddef ; + +def shaded text s = + s +enddef ; + + +% For me. + +primarydef p shownshadevector v = + image ( + drawarrow (point xpart v of p) -- (point ypart v of p) ; + fill fullcircle scaled 2 shifted point xpart v of p ; + setbounds currentpicture to center currentpicture -- cycle ; + ) +enddef ; + +primarydef p shownshadedirection v = + image ( + drawarrow (point xpart v of boundingbox p) -- (point ypart v of boundingbox p) ; + fill fullcircle scaled 2 shifted (point xpart v of boundingbox p) ; + setbounds currentpicture to center currentpicture -- cycle ; + ) +enddef ; + +primarydef p shownshadecenter v = + image ( + fill fullcircle scaled 2 + shifted center p shifted ( + xpart v * bbwidth (p)/2, + ypart v * bbheight(p)/2 + ) ; + setbounds currentpicture to center currentpicture -- cycle ; + ) +enddef ; + +primarydef p shownshadeorigin v = + image ( + fill fullcircle scaled 2 shifted v ; + setbounds currentpicture to center currentpicture -- cycle ; + ) +enddef ; + +permanent withshademethod, withshaderadius, withshadeorigin, withshadevector, withshadedirection, + withshadetransform, withshadedomain, withshadefactor, withshadecenter, withshadefraction, withshadestep, + withshadecolors, shadedinto, withshade, shaded, shadedup, shadeddown, shadedleft, shadedright, + shownshadevector, shownshadedirection, shownshadecenter, shownshadeorigin ; + +% Old macros: + +def withcircularshade (expr a, b, ra, rb, ca, cb) = + withprescript "sh_type=circular" + withprescript "sh_transform=yes" + withprescript "sh_domain=0 1" + withprescript "sh_factor=1" + withprescript "sh_color_a=" & colordecimals ca + withprescript "sh_color_b=" & colordecimals cb + withprescript "sh_center_a=" & ddecimal a % (a shifted shadeoffset) + withprescript "sh_center_b=" & ddecimal b % (b shifted shadeoffset) + withprescript "sh_radius_a=" & decimal ra + withprescript "sh_radius_b=" & decimal rb +enddef ; + +def withlinearshade (expr a, b, ca, cb) = + withprescript "sh_type=linear" + withprescript "sh_transform=yes" + withprescript "sh_domain=0 1" + withprescript "sh_factor=1" + withprescript "sh_color_a=" & colordecimals ca + withprescript "sh_color_b=" & colordecimals cb + withprescript "sh_center_a=" & ddecimal a % (a shifted shadeoffset) + withprescript "sh_center_b=" & ddecimal b % (b shifted shadeoffset) +enddef ; + +permanent withcircularshade, withlinearshade ; + +% replaced (obsolete): + +def set_linear_vector (suffix a,b)(expr p,n) = + if (n=1) : a := llcorner p ; b := urcorner p ; + elseif (n=2) : a := lrcorner p ; b := ulcorner p ; + elseif (n=3) : a := urcorner p ; b := llcorner p ; + elseif (n=4) : a := ulcorner p ; b := lrcorner p ; + elseif (n=5) : a := .5[ulcorner p,llcorner p] ; b := .5[urcorner p,lrcorner p] ; + elseif (n=6) : a := .5[llcorner p,lrcorner p] ; b := .5[ulcorner p,urcorner p] ; + elseif (n=7) : a := .5[lrcorner p,urcorner p] ; b := .5[llcorner p,ulcorner p] ; + elseif (n=8) : a := .5[urcorner p,ulcorner p] ; b := .5[lrcorner p,llcorner p] ; + else : a := .5[ulcorner p,llcorner p] ; b := .5[urcorner p,lrcorner p] ; + fi ; +enddef ; + +def set_circular_vector (suffix ab,r)(expr p,n) = + if (n=1) : ab := llcorner p ; + elseif (n=2) : ab := lrcorner p ; + elseif (n=3) : ab := urcorner p ; + elseif (n=4) : ab := ulcorner p ; + else : ab := center p ; r := .5r ; + fi ; +enddef ; + +def circular_shade (expr p, n, ca, cb) = + begingroup ; + save ab, r ; pair ab ; numeric r ; + r := (xpart lrcorner p - xpart llcorner p) ++ (ypart urcorner p - ypart lrcorner p) ; + set_circular_vector(ab,r)(p,n) ; + fill p withcircularshade(ab,ab,0,r,ca,cb) ; + if trace_shades : + drawarrow ab -- ab shifted (0,r) withpen pencircle scaled 1pt withcolor .5white ; + fi ; + endgroup ; +enddef ; + +def linear_shade (expr p, n, ca, cb) = + begingroup ; + save a, b ; pair a, b ; + set_linear_vector(a,b)(p,n) ; + fill p withlinearshade(a,b,ca,cb) ; + if trace_shades : + drawarrow a -- b withpen pencircle scaled 1pt withcolor .5white ; + fi ; + endgroup ; +enddef ; + +string mfun_defined_cs_pre[] ; numeric mfun_defined_cs ; mfun_defined_cs := 0 ; + +vardef define_circular_shade (expr a, b, ra, rb, ca, cb) = + mfun_defined_cs := mfun_defined_cs + 1 ; + mfun_defined_cs_pre[mfun_defined_cs] := "sh_type=circular" + & mfun_prescript_separator & "sh_domain=0 1" + & mfun_prescript_separator & "sh_factor=1" + & mfun_prescript_separator & "sh_color_a=" & colordecimals ca + & mfun_prescript_separator & "sh_color_b=" & colordecimals cb + & mfun_prescript_separator & "sh_center_a=" & ddecimal a % (a shifted shadeoffset) + & mfun_prescript_separator & "sh_center_b=" & ddecimal b % (b shifted shadeoffset) + & mfun_prescript_separator & "sh_radius_a=" & decimal ra + & mfun_prescript_separator & "sh_radius_b=" & decimal rb + ; + mfun_defined_cs +enddef ; + +vardef define_linear_shade (expr a, b, ca, cb) = + mfun_defined_cs := mfun_defined_cs + 1 ; + mfun_defined_cs_pre[mfun_defined_cs] := "sh_type=linear" + & mfun_prescript_separator & "sh_domain=0 1" + & mfun_prescript_separator & "sh_factor=1" + & mfun_prescript_separator & "sh_color_a=" & colordecimals ca + & mfun_prescript_separator & "sh_color_b=" & colordecimals cb + & mfun_prescript_separator & "sh_center_a=" & ddecimal a % (a shifted shadeoffset) + & mfun_prescript_separator & "sh_center_b=" & ddecimal b % (b shifted shadeoffset) + ; + mfun_defined_cs +enddef ; + +% I lost the example code that uses this: +% +% vardef define_sampled_linear_shade(expr a,b,n)(text t) = +% mfun_defined_cs := mfun_defined_cs + 1 ; +% mfun_defined_cs_pre[mfun_defined_cs] := "ssh_type=linear" +% & mfun_prescript_separator & "ssh_center_a=" & ddecimal (a shifted shadeoffset) +% & mfun_prescript_separator & "ssh_center_b=" & ddecimal (b shifted shadeoffset) +% & mfun_prescript_separator & "ssh_nofcolors=" & decimal n +% & mfun_prescript_separator & "ssh_domain=" & domstr +% & mfun_prescript_separator & "ssh_extend=" & extstr +% & mfun_prescript_separator & "ssh_colors=" & colstr +% & mfun_prescript_separator & "ssh_bounds=" & bndstr +% & mfun_prescript_separator & "ssh_ranges=" & ranstr +% ; +% mfun_defined_cs +% enddef ; +% +% vardef define_sampled_circular_shade(expr a,b,ra,rb,n)(text t) = +% mfun_defined_cs := mfun_defined_cs + 1 ; +% mfun_defined_cs_pre[mfun_defined_cs] := "ssh_type=circular" +% & mfun_prescript_separator & "ssh_center_a=" & ddecimal (a shifted shadeoffset) +% & mfun_prescript_separator & "ssh_radius_a=" & decimal ra +% & mfun_prescript_separator & "ssh_center_b=" & ddecimal (b shifted shadeoffset) +% & mfun_prescript_separator & "ssh_radius_b=" & decimal rb +% & mfun_prescript_separator & "ssh_nofcolors=" & decimal n +% & mfun_prescript_separator & "ssh_domain=" & domstr +% & mfun_prescript_separator & "ssh_extend=" & extstr +% & mfun_prescript_separator & "ssh_colors=" & colstr +% & mfun_prescript_separator & "ssh_bounds=" & bndstr +% & mfun_prescript_separator & "ssh_ranges=" & ranstr +% ; +% mfun_defined_cs +% enddef ; + +% vardef predefined_linear_shade (expr p, n, ca, cb) = +% save a, b, sh ; pair a, b ; +% set_linear_vector(a,b)(p,n) ; +% define_linear_shade (a,b,ca,cb) +% enddef ; +% +% vardef predefined_circular_shade (expr p, n, ca, cb) = +% save ab, r ; pair ab ; numeric r ; +% r := (xpart lrcorner p - xpart llcorner p) ++ (ypart urcorner p - ypart lrcorner p) ; +% set_circular_vector(ab,r)(p,n) ; +% define_circular_shade(ab,ab,0,r,ca,cb) +% enddef ; + +% Layers + +def onlayer primary name = + withprescript "la_name=" & name +enddef ; + +permanent onlayer ; + +% Figures + +% def externalfigure primary filename = +% doexternalfigure (filename) +% enddef ; +% +% def doexternalfigure (expr filename) text transformation = +% if true : % a bit incompatible esp scaled 1cm now scaled the natural size +% draw rawtextext("\externalfigure[" & filename & "]") transformation ; +% else : +% draw unitsquare transformation withprescript "fg_name=" & filename ; +% fi ; +% enddef ; + +def withmask primary filename = + withprescript "fg_mask=" & filename +enddef ; + +vardef externalfigure primary filename = + mfun_tt_c := nullpicture ; + mfun_tt_r := lua.mp.mf_external_figure(filename) ; + addto mfun_tt_c doublepath unitsquare + xscaled wdpart mfun_tt_r + yscaled htpart mfun_tt_r + withprescript "mf_object=figure" + withprescript "fg_name=" & filename ; + ; + mfun_tt_c +enddef ; + +def figure primary filename = + rawtextext("\externalfigure[" & filename & "]") +enddef ; + +permanent withmask, externalfigure, figure ; + +% Positions + +def register (expr tag, width, height, offset) = +% draw image ( + addto currentpicture doublepath unitsquare xscaled width yscaled height shifted offset + withprescript "ps_label=" & tag ; +% ) ; % no transformations +enddef ; + +permanent register ; + +% outlines (todo: pass around less arguments) + +numeric currentoutlinetext ; currentoutlinetext := 0 ; + +vardef mfun_do_outline_text_flush (expr kind, n, x, y, c) (text t) = + if kind = "f" : + mfun_do_outline_text_f (n, x, y, c) (t) + elseif kind = "d" : + mfun_do_outline_text_d (n, x, y, c) (t) + elseif kind = "b" : + mfun_do_outline_text_b (n, x, y, c) (t) + elseif kind = "r" : + mfun_do_outline_text_r (n, x, y, c) (t) + elseif kind = "p" : + mfun_do_outline_text_p (n, x, y, c) (t) + elseif kind = "u" : + mfun_do_outline_text_u (n, x, y, c) (t) + else : + mfun_do_outline_text_n (n, x, y, c) (t) + fi ; +enddef ; + +vardef mfun_do_outline_rule_flush (expr kind, x, y, w, h) = + % mfun_do_outline_text_flush (kind, 1, x, y, "") (fullsquare xyscaled(w,h)) + mfun_do_outline_text_flush (kind, 1, x, y, "") (unitsquare xyscaled(w,h)) +enddef ; + +numeric mfun_do_outline_n ; mfun_do_outline_n := 0 ; + +vardef mfun_do_outline_text_f (expr n, x, y, c) (text t) = + mfun_do_outline_n := 0 ; + for i=t : + mfun_do_outline_n := mfun_do_outline_n + 1 ; + 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 ; + endfor ; +enddef ; + +vardef mfun_do_outline_text_u (expr n, x, y, c) (text t) = + mfun_do_outline_n := 0 ; + for i=t : + mfun_do_outline_n := mfun_do_outline_n + 1 ; + if mfun_do_outline_n = n : fillup else : nofill fi (i shifted(x,y)) mfun_do_outline_options_f withprescript c ; + endfor ; +enddef ; + +vardef mfun_do_outline_text_d (expr n, x, y, c) (text t) = + for i=t : + draw i shifted(x,y) mfun_do_outline_options_d ; + endfor ; +enddef ; + +vardef mfun_do_outline_text_p (expr n, x, y, c) (text t) = + for i=t : + draw i shifted(x,y) withprescript c ; + endfor ; +enddef ; + +vardef mfun_do_outline_text_b (expr n, x, y, c) (text t) = + mfun_do_outline_n := 0 ; + for i=t : + mfun_do_outline_n := mfun_do_outline_n + 1 ; + if mfun_do_outline_n = n : fill else : nofill fi (i shifted(x,y)) mfun_do_outline_options_f ; + endfor ; + for i=t : + draw i shifted(x,y) mfun_do_outline_options_d ; + endfor ; +enddef ; + +vardef mfun_do_outline_text_r (expr n, x, y, c) (text t) = + mfun_do_outline_n := 0 ; + for i=t : + draw i shifted(x,y) mfun_do_outline_options_d ; + endfor ; + for i=t : + mfun_do_outline_n := mfun_do_outline_n + 1 ; + if mfun_do_outline_n = n : fill else : nofill fi (i shifted(x,y)) mfun_do_outline_options_f; + endfor ; +enddef ; + +vardef mfun_do_outline_text_n (expr n, x, y, c) (text t) = + mfun_do_outline_n := 0 ; + for i=t : + mfun_do_outline_n := mfun_do_outline_n + 1 ; + if mfun_do_outline_n = n : fill else : nofill fi (i shifted(x,y)) ; + endfor ; +enddef ; + +vardef mfun_do_outline_text_set_f (text f) text r = + def mfun_do_outline_options_f = f enddef ; + def mfun_do_outline_options_r = r enddef ; +enddef ; + +vardef mfun_do_outline_text_set_u (text f) text r = + def mfun_do_outline_options_f = f enddef ; +enddef ; + +vardef mfun_do_outline_text_set_d (text d) text r = + def mfun_do_outline_options_d = d enddef ; + def mfun_do_outline_options_r = r enddef ; +enddef ; + +vardef mfun_do_outline_text_set_b (text f) (text d) text r = + def mfun_do_outline_options_f = f enddef ; + def mfun_do_outline_options_d = d enddef ; + def mfun_do_outline_options_r = r enddef ; +enddef ; + +vardef mfun_do_outline_text_set_r (text d) (text f) text r = + def mfun_do_outline_options_d = d enddef ; + def mfun_do_outline_options_f = f enddef ; + def mfun_do_outline_options_r = r enddef ; +enddef ; + +vardef mfun_do_outline_text_set_n text r = + def mfun_do_outline_options_r = r enddef ; +enddef ; + +vardef mfun_do_outline_text_set_p = +enddef ; + +def mfun_do_outline_options_d = enddef ; +def mfun_do_outline_options_f = enddef ; +def mfun_do_outline_options_r = enddef ; + +def outlinetexttopath (text o, p, n) = + scantokens("numeric " & str n & ";") ; + scantokens("path " & str p & "[];") ; + n := 0 ; + for i within o : p[incr(n)] := pathpart i ; endfor ; +enddef ; + +def filloutlinetext (expr o) = + draw image ( + save n, m ; numeric n, m ; n := m := 0 ; + for i within o : + n := n + 1 ; + endfor ; + for i within o : + m := m + 1 ; + if n = m : + eofill + else : + nofill + fi pathpart i ; + endfor ; + ) +enddef ; + +def drawoutlinetext (expr o) = + draw image ( + % nicer for properties + for i within o : + draw pathpart i ; + endfor ; + ) +enddef ; + +vardef outlinetext@# (expr t) text rest = + save kind ; string kind ; kind := str @# ; + currentoutlinetext := currentoutlinetext + 1 ; + def mfun_do_outline_options_d = enddef ; + def mfun_do_outline_options_f = enddef ; + def mfun_do_outline_options_r = enddef ; + image ( normaldraw image ( + % lua.mp.report("set outline text",currentoutlinetext); + lua.mp.mf_outline_text(currentoutlinetext,t,kind) ; + % lua.mp.report("get outline text",currentoutlinetext); + if kind = "f" : + mfun_do_outline_text_set_f rest ; + elseif kind = "d" : + mfun_do_outline_text_set_d rest ; + elseif kind = "b" : + mfun_do_outline_text_set_b rest ; + elseif kind = "u" : + mfun_do_outline_text_set_f rest ; + elseif kind = "r" : + mfun_do_outline_text_set_r rest ; + elseif kind = "p" : + mfun_do_outline_text_set_p ; + else : + mfun_do_outline_text_set_n rest ; + fi ; + lua.mp.mf_get_outline_text(currentoutlinetext) ; + ) mfun_do_outline_options_r ; ) +enddef ; + + +permanent outlinetexttopath, filloutlinetext, drawoutlinetext, outlinetext ; + +% A few helpers: + +numeric mfun_c_b_llx, mfun_c_b_h, mfun_c_b_w, mfun_c_b_l ; + +vardef checkedbounds(expr llx,lly,urx,ury) = + mfun_c_b_llx := min(xpart llcorner currentpicture,llx) ; + mfun_c_b_urx := max(xpart urcorner currentpicture,urx) ; + mfun_c_b_lly := min(ypart llcorner currentpicture,lly) ; + mfun_c_b_ury := max(ypart urcorner currentpicture,ury) ; + (mfun_c_b_llx,mfun_c_b_lly) -- + (mfun_c_b_urx,mfun_c_b_lly) -- + (mfun_c_b_urx,mfun_c_b_ury) -- + (mfun_c_b_llx,mfun_c_b_ury) -- cycle +enddef ; + +vardef checkbounds(expr llx,lly,urx,ury) = + setbounds currentpicture to checkedbounds(llx,lly,urx,ury) ; +enddef ; + +vardef strut(expr ht,dp) = + setbounds currentpicture to checkedbounds(0,0,ht,dp) ; +enddef ; + +vardef rule(expr wd,ht,dp) = + image (fill (0,-dp)--(wd,-dp)--(wd,ht)--(0,ht)--cycle) +enddef ; + +permanent checkedbounds, checkbounds, strut, rule ; + +% Housekeeping + +extra_beginfig := extra_beginfig & "currentgraphictext := 0 ; " ; +extra_beginfig := extra_beginfig & "currentoutlinetext := 0 ; " ; +extra_endfig := extra_endfig & "finishsavingdata ; " ; +extra_endfig := extra_endfig & "mfun_reset_tex_texts ; " ; + +% Bonus + +vardef verbatim(expr s) = + ditto & "\detokenize{" & s & "}" & ditto +enddef ; + +permanent verbatim ; + +% New + +def bitmapimage(expr xresolution, yresolution, data) = + image ( + addto currentpicture doublepath unitsquare + withprescript "bm_xresolution=" & decimal xresolution + withprescript "bm_yresolution=" & decimal yresolution + withpostscript data ; + ) +enddef ; + +permanent bitmapimage ; + +% Experimental: +% +% property p ; p = properties(withcolor (1,1,0,0)) ; +% fill fullcircle scaled 20cm withproperties p ; + +let property = picture ; permanent property ; + +vardef properties(text t) = + image(draw unitcircle t) +enddef ; + +def withproperties expr p = + if colormodel p = 3 : + withcolor greypart p + elseif colormodel p = 5 : + withcolor (redpart p,greenpart p,bluepart p) + elseif colormodel p = 7 : + withcolor (cyanpart p,magentapart p,yellowpart p,blackpart p) + fi + withpen penpart p + if length (dashpart p) > 0 : + dashed dashpart p + fi + withprescript prescriptpart p + withpostscript postscriptpart p +enddef ; + +permanent properties, withproperties ; + +% Experimental: + +primarydef t asgroup s = % s = isolated|knockout + begingroup + save temp_p, temp_q, temp_r ; + picture temp_p, temp_q ; path temp_r ; + temp_p := if picture t : t else : image(draw t) fi ; + temp_r := boundingbox temp_p ; + temp_q:= nullpicture ; + addto temp_q contour temp_r + withprescript "gr_state=start" + withprescript "gr_type=" & s ; + addto temp_q also temp_p ; + addto temp_q contour temp_r + withprescript "gr_state=stop" ; + temp_q + endgroup +enddef ; + +permanent asgroup ; + +% Also experimental ... needs to be made better ... so it can change! + +string mfun_auto_align[] ; + +mfun_auto_align[0] := "rt" ; +mfun_auto_align[1] := "urt" ; +mfun_auto_align[2] := "top" ; +mfun_auto_align[3] := "ulft" ; +mfun_auto_align[4] := "lft" ; +mfun_auto_align[5] := "llft" ; +mfun_auto_align[6] := "bot" ; +mfun_auto_align[7] := "lrt" ; +mfun_auto_align[8] := "rt" ; + +def autoalign(expr n) = + scantokens mfun_auto_align[round((n mod 360)/45)] +enddef ; + +% draw textext.autoalign(60) ("\strut oeps 1") ; +% draw textext.autoalign(160)("\strut oeps 2") ; +% draw textext.autoalign(260)("\strut oeps 3") ; +% draw textext.autoalign(360)("\strut oeps 4") ; + +% new +% +% passvariable("version","1.0") ; +% passvariable("number",123) ; +% passvariable("string","whatever") ; +% passvariable("point",(1,2)) ; +% passvariable("triplet",(1,2,3)) ; +% passvariable("quad",(1,2,3,4)) ; +% passvariable("boolean",false) ; +% passvariable("path",fullcircle scaled 1cm) ; + +% we could use the new lua interface but there is not that much gain i.e. +% we still need to serialize + +vardef mfun_point_to_string(expr p,i) = + decimal xpart (point i of p) & " " & + decimal ypart (point i of p) & " " & + decimal xpart (precontrol i of p) & " " & + decimal ypart (precontrol i of p) & " " & + decimal xpart (postcontrol i of p) & " " & + decimal ypart (postcontrol i of p) +enddef ; + +vardef mfun_transform_to_string(expr t) = + decimal xxpart t & " " & % rx + decimal xypart t & " " & % sx + decimal yxpart t & " " & % sy + decimal yypart t & " " & % ry + decimal xpart t & " " & % tx + decimal ypart t % ty +enddef ; + +vardef mfun_numeric_to_string(expr n) = + decimal n +enddef ; + +vardef mfun_pair_to_string(expr p) = + decimal xpart p & " " & + decimal ypart p +enddef ; + +vardef mfun_rgbcolor_to_string(expr c) = + decimal redpart c & " " & + decimal greenpart c & " " & + decimal bluepart c +enddef ; + +vardef mfun_cmykcolor_to_string(expr c) = + decimal cyanpart c & " " & + decimal magentapart c & " " & + decimal yellowpart c & " " & + decimal blackpart c +enddef ; + +vardef mfun_pair_to_table(expr p) = + "{" & decimal xpart p & + "," & decimal ypart p & + "}" +enddef ; + +vardef mfun_point_to_table(expr p,i) = + "{" & decimal xpart (point i of p) & + "," & decimal ypart (point i of p) & + "," & decimal xpart (precontrol i of p) & + "," & decimal ypart (precontrol i of p) & + "," & decimal xpart (postcontrol i of p) & + "," & decimal ypart (postcontrol i of p) & + "}" +enddef ; + +vardef mfun_path_to_table(expr p) = + "{" & mfun_point_to_table(p,0) for i=1 upto length(p) : & "," & mfun_point_to_table(p,i) endfor & "}" +enddef ; + +vardef mfun_rgb_to_table(expr c) = + "{" & decimal redpart c & + "," & decimal greenpart c & + "," & decimal bluepart c & + "}" +enddef ; + +vardef mfun_cmyk_to_table(expr c) = + "{" & decimal cyanpart c & + "," & decimal magentapart c & + "," & decimal yellowpart c & + "," & decimal blackpart c & + "}" +enddef ; + +vardef mfun_grey_to_string(expr n) = + decimal n +enddef ; + +vardef mfun_path_to_string(expr p) = + mfun_point_to_string(p,0) for i=1 upto length(p) : & " " & mfun_point_to_string(p,i) endfor +enddef ; + +vardef mfun_boolean_to_string(expr b) = + if b : "true" else : "false" fi +enddef ; + +vardef tostring primary v = + if numeric v : mfun_numeric_to_string(v) + elseif pair v : mfun_pair_to_string(v) + elseif rgbcolor v : mfun_rgbcolor_to_string(v) + elseif cmykcolor v : mfun_cmykcolor_to_string(v) + elseif greycolor v : mfun_greycolor_to_string(v) + elseif boolean v : mfun_boolean_to_string(v) + elseif path v : mfun_path_to_string(v) + elseif transform v : mfun_transform_to_string(v) + else : v + fi +enddef ; + +vardef topair primary p = + if pair p : "(" & decimal xpart p & "," & decimal ypart p & ")" + elseif numeric p : "(" & decimal p & "," & decimal p & ")" + else : "" fi +enddef ; + +string dq ; dq := char 92 & char 34 ; +string sq ; sq := char 92 & char 39 ; + +permanent dq, sq ; + +vardef quote primary s = sq & tostring(s) & sq enddef; +vardef quotation primary s = dq & tostring(s) & dq enddef; + +vardef mfun_tagged_string(expr value) = + if numeric value : "1:" & mfun_numeric_to_string(value) + elseif pair value : "4:" & mfun_pair_to_string(value) + elseif rgbcolor value : "5:" & mfun_rgbcolor_to_string(value) + elseif cmykcolor value : "6:" & mfun_cmykcolor_to_string(value) + elseif boolean value : "3:" & mfun_boolean_to_string(value) + elseif path value : "7:" & mfun_path_to_string(value) + elseif transform value : "8:" & mfun_transform_to_string(value) + else : "2:" & value + fi +enddef ; + +permanent tostring, topair, quote, quotation ; + +% A more flexible variant for passing data to context. We used to construct strings +% but running lua is fast enough so we can gain on string construction in metapost +% which is also not that efficient. + +vardef mfun_key_to_lua(expr k) = + if numeric k : decimal k else : "'" & k & "'" fi +enddef ; + +vardef mfun_point_to_lua(expr k,p,i) = + runscript( "metapost.setvariable(" & mfun_key_to_lua(k) & ",{" & + decimal xpart (point i of p) & "," & + decimal ypart (point i of p) & "," & + decimal xpart (precontrol i of p) & "," & + decimal ypart (precontrol i of p) & "," & + decimal xpart (postcontrol i of p) & "," & + decimal ypart (postcontrol i of p) + & "})" ) ; +enddef ; + +vardef mfun_transform_to_lua(expr k,t) = + runscript( "metapost.setvariable(" & mfun_key_to_lua(k) & ",{" & + decimal xxpart t & "," & % rx + decimal xypart t & "," & % sx + decimal yxpart t & "," & % sy + decimal yypart t & "," & % ry + decimal xpart t & "," & % tx + decimal ypart t % ty + & "})" ) ; +enddef ; + +vardef mfun_numeric_to_lua(expr k,n) = + runscript( "metapost.setvariable(" & mfun_key_to_lua(k) & "," & decimal n & ")" ) ; +enddef ; + +vardef mfun_pair_to_lua(expr k,p) = + runscript( "metapost.setvariable(" & mfun_key_to_lua(k) & ",{" & + decimal xpart p & "," & + decimal ypart p + & "})" ) ; +enddef ; + +vardef mfun_rgbcolor_to_lua(expr k,c) = + runscript( "metapost.setvariable(" & mfun_key_to_lua(k) & ",{" & + decimal redpart c & "," & + decimal greenpart c & "," & + decimal bluepart c + & "})" ) ; +enddef ; + +vardef mfun_cmykcolor_to_lua(expr k,c) = + runscript( "metapost.setvariable(" & mfun_key_to_lua(k) & ",{" & + decimal cyanpart c & "," & + decimal magentapart c & "," & + decimal yellowpart c & "," & + decimal blackpart c + & "})" ) ; +enddef ; + +vardef mfun_path_to_lua(expr k,p) = + runscript("metapost.pushvariable(" & mfun_key_to_lua(k) & ")") ; + for i=0 upto length(p) : + mfun_point_to_lua(i+1,p,i) ; + endfor ; + runscript("metapost.popvariable()") ; +enddef ; + +vardef mfun_boolean_to_lua(expr k,b) = + runscript( "metapost.setvariable(" & mfun_key_to_lua(k) & if b : ",true)" else : ",false)" fi ) ; +enddef ; + +vardef mfun_string_to_lua(expr k,s) = + runscript( "metapost.setvariable(" & mfun_key_to_lua(k) & ",[==[" & s & "]==])" ) ; +enddef ; + +def passvariable(expr key, value) = + if numeric value : mfun_numeric_to_lua (key,value) ; + elseif pair value : mfun_pair_to_lua (key,value) ; + elseif string value : mfun_string_to_lua (key,value) ; + elseif boolean value : mfun_boolean_to_lua (key,value) ; + elseif path value : mfun_path_to_lua (key,value) ; + elseif rgbcolor value : mfun_rgbcolor_to_lua (key,value) ; + elseif cmykcolor value : mfun_cmykcolor_to_lua(key,value) ; + elseif transform value : mfun_transform_to_lua(key,value) ; + fi ; +enddef ; + +def passarrayvariable(expr key)(suffix values)(expr first, last, stp) = + runscript("metapost.pushvariable(" & mfun_key_to_lua(key) & ")") ; + for i=first step stp until last : + passvariable(i, values[i]) ; + endfor + runscript("metapost.popvariable()") ; +enddef ; + +def startpassingvariable(expr k) = + runscript("metapost.pushvariable(" & mfun_key_to_lua(k) & ")") ; +enddef ; + +def stoppassingvariable = + runscript("metapost.popvariable()") ; +enddef ; + +permanent passvariable, passarrayvariable, startpassingvariable, stoppassingvariable ; + +% moved here from mp-grap.mpiv + +% vardef escaped_format(expr s) = +% "" for n=0 upto length(s) : & +% if ASCII substring (n,n+1) of s = 37 : +% "@" +% else : +% substring (n,n+1) of s +% fi +% endfor +% enddef ; + +numeric mfun_esc_b ; % begin +numeric mfun_esc_l ; % length +string mfun_esc_s ; % character + +mfun_esc_s := "%" ; % or: char(37) + +% this one is the fastest when we have a match + +% vardef escaped_format(expr s) = +% "" for n=0 upto length(s)-1 : & +% % if ASCII substring (n,n+1) of s = 37 : +% if substring (n,n+1) of s = mfun_esc_s : +% "@" +% else : +% substring (n,n+1) of s +% fi +% endfor +% enddef ; + +% this one wins when we have no match + +vardef escaped_format(expr s) = + mfun_esc_b := 0 ; + mfun_esc_l := length(s) ; + for n=0 upto mfun_esc_l-1 : + % if ASCII substring (n,n+1) of s = 37 : + if substring (n,n+1) of s = mfun_esc_s : + if mfun_esc_b = 0 : + "" + fi + if n >= mfun_esc_b : + & (substring (mfun_esc_b,n) of s) + exitif numeric begingroup mfun_esc_b := n+1 endgroup ; % hide + fi + & "@" + fi + endfor + if mfun_esc_b = 0 : + s + % elseif mfun_esc_b > 0 : + elseif mfun_esc_b < mfun_esc_l : + & (substring (mfun_esc_b,mfun_esc_l) of s) + fi +enddef ; + +vardef strfmt(expr f, x) = "\MPgraphformat{" & escaped_format(f) & "}{" & mfun_tagged_string(x) & "}" enddef ; +vardef varfmt(expr f, x) = "\MPformatted{" & escaped_format(f) & "}{" & mfun_tagged_string(x) & "}" enddef ; + +vardef format@# (expr f, x) = textext@#(strfmt(f, x)) enddef ; +vardef formatted@#(expr f, x) = textext@#(varfmt(f, x)) enddef ; + +permanent format, formatted ; + +% could be this (something to discuss with alan as it involves graph): +% +% vardef format (expr f,x) = lua.mp.graphformat(f,mfun_tagged_string(x) enddef ; +% vardef formatted(expr f,x) = lua.mp.format (f, x) enddef ; +% +% def strfmt = format enddef ; % old +% def varfmt = formatted enddef ; % old + + +% def fmttext = lua.mp.formatted enddef ; + +% new + +def fillup text t = draw t withpostscript "both" enddef ; % we use draw because we need the proper boundingbox +def eofillup text t = draw t withpostscript "eoboth" enddef ; % we use draw because we need the proper boundingbox +def eofill text t = fill t withpostscript "evenodd" enddef ; +def nofill text t = fill t withpostscript "collect" enddef ; +def nodraw text t = draw t withpostscript "collect" enddef ; +def dodraw text t = draw t withpostscript "flush" enddef ; +% eodraw text t = draw t withpostscript "evenodd" enddef ; +def dofill text t = fill t withpostscript "flush" enddef ; +def eoclip text t = clip t withpostscript "evenodd" enddef ; + +permanent fillup, eofillup, eofill, nofill, nodraw, dodraw, dofill, eoclip ; + +% maybe (saves a bogus path but the problem is that it can influence the dimensions): + +% def dodraw text t = draw center currentpicture withpostscript "flush" enddef ; +% def dofill text t = fill center currentpicture --cycle withpostscript "flush" enddef ; + +% def withrule expr r = +% if (t = "even-odd") or (t = "evenodd") : withpostscript "evenodd" fi +% enddef ; + +% A comment will end up on top of the graphic in the output. This can be handy for +% locating a graphic: comment("test graphic"). + +% This can be a prescript to currentpicture ... we can actually make +% +% setprescript str to picture/path ; +% setpostscript str to picture/path ; + +def special text t = enddef ; + +def comment expr str = + special "metapost.comment[[" & str & "]]" ; +enddef ; + +vardef report(text t) = + lua.mp.report(t) +enddef ; + +permanent comment, report ; + +% This overloads a dummy: + +% todo: use mfid_* cum suis + +vardef uniquelist(suffix list) = + % this can be optimized by passing all values at once and returning + % a result but for now this is ok .. we need an undef foo + save i, j, h ; + if known lis[0] : + i := 0 ; + j := -1 ; + else : + i := 1 ; + j := 0 ; + fi ; + h := lua.mp.newhash() ; + forever : + exitif unknown list[i] ; + if not lua.mp.inhash(h,list[i]) : + j := j + 1 ; + list[j] := list[i] ; + lua.mp.tohash(h,list[i]) ; + fi ; + i := i + 1 ; + endfor ; + for n = j+1 step 1 until i-1 : + dispose(list[n]) + endfor ; + lua.mp.disposehash(h) ; +enddef ; + +permanent uniquelist ; diff --git a/Master/texmf-dist/metapost/context/base/mpxl/mp-node.mpxl b/Master/texmf-dist/metapost/context/base/mpxl/mp-node.mpxl new file mode 100644 index 00000000000..7d6b9dd055b --- /dev/null +++ b/Master/texmf-dist/metapost/context/base/mpxl/mp-node.mpxl @@ -0,0 +1,275 @@ +%D \module +%D [ file=mp-node.mpiv, +%D version=1998.02.15, +%D title=\CONTEXT\ \METAPOST\ graphics, +%D subtitle=Node Based Graphics, +%D author=Alan Braslau, +%D date=\currentdate, +%D copyright={Alan Braslau & \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. + +%D The crossing macros were written as part of this module but as they +%D can be of use elsewhere they are defined in mp-tool. + +if known metafun_loaded_node : endinput ; fi ; + +newinternal boolean metafun_loaded_node ; metafun_loaded_node := true ; immutable metafun_loaded_node ; + +% Build a path from the node positions. +% Must be integer and continuous in index starting at 0. + +vardef makenodepath(suffix p) = + if unknown p : + if not path p : + d := dimension p ; + if d>0 : + scantokens("path " & prefix p & for i=1 upto d : "[]" & endfor " ;") ; + else : + path p ; + fi + fi + save i ; i = -1 ; + p = forever : exitif unknown p.pos[incr i] ; + p.pos[i] -- + endfor cycle ; + fi +enddef ; + +% can take a list: + +def clearpath text t = + save t ; path t ; +enddef ; + +def clearnodepath = clearpath nodepath enddef ; + +clearnodepath ; + +% the trailing "," below handles when number of t<3 + +vardef makenode@#(text t) = + for a = t : + if (path a) or (unknown a) : + mfun_makenode@#(t,) + elseif (string a) and (length(a) = 0) : + mfun_makenode@#(t,) + else : + mfun_makenode@#(nodepath, t,) + fi + exitif true ; + endfor +enddef ; + +vardef node@#(text t) = + for a = t : + if (path a) or (unknown a) : + mfun_node@#(t,) + elseif (string a) and (length(a) = 0) : + mfun_node@#(t,) + else : + mfun_node@#(nodepath, t,) + fi + exitif true ; + endfor +enddef ; + +vardef nodeboundingpoint@#(text t) = + for a = t : + if (path a) or (unknown a) : + mfun_nodeboundingpoint@#(t) + elseif (string a) and (length(a) = 0) : + mfun_nodeboundingpoint@#(t) + else : + mfun_nodeboundingpoint@#(nodepath,a) + fi + exitif true ; + endfor +enddef ; + +vardef fromto@#(expr d, f)(text t) = + fromtopaths@#(d,nodepath,f,nodepath,t) +enddef ; + +% returns a pair suffix if the path is unknown + +vardef mfun_makenode@#(suffix p)(expr i)(text t) = + save d, b ; string b ; + d = dimension p ; + if d > 0 : + b := prefix p ; + if not picture p.pic[i] : scantokens("picture " & b & + for j=1 upto d : "[]" & endfor + "pic[] ;") ; fi + if not pair p.pos[i] : scantokens("pair " & b & + for j=1 upto d : "[]" & endfor + "pos[] ;") ; fi + else : + if not picture p.pic[i] : picture p.pic[] ; fi + if not pair p.pos[i] : pair p.pos[] ; fi + fi + for a = t : + if known p.pic[i] : + addto p.pic[i] also + else : + p.pic[i] = + fi + if picture a : a + elseif string a : if (length(a) > 0) : textext@#(a) else : nullpicture fi + elseif numeric a : textext@#(decimal a) + elseif ((boolean a) and a) : image(draw origin withpen currentpen scaled 4) + else : nullpicture + fi ; + endfor + p.pos[i] if known p : := point i of p ; fi +enddef ; + +% returns a picture + +vardef mfun_node@#(suffix p)(expr i)(text t) = + if pair mfun_makenode@#(p,i,t) : + % nop: enclose in "if ... fi" to gobble the function return. + fi + if (unknown p) and (known p.pos[i]) : + makenodepath(p) ; + fi + if known p.pic[i] : + p.pic[i] if known p : shifted point i of p fi + else : + nullpicture + fi +enddef ; + +newinternal node_loopback_yscale ; node_loopback_yscale := 1 ; + +% returns a path + +vardef fromtopaths@#(expr d)(suffix p)(expr f)(suffix q)(text s) = + save r, t, l ; + path r[] ; picture l ; + for a = s : + if unknown t : + t = a ; + if (unknown p) and (known p.pos[f]) : + makenodepath(p) ; + fi + if (unknown q) and (known q.pos[t]) : + makenodepath(q) ; + fi + r0 = if ((not numeric d) and + (point f of p = point f of q) and + (point t of p = point t of q)) : + subpath (f,t) of p + else : + point f of p -- point t of q + fi ; + save deviation ; + deviation := if numeric d: d else: 0 fi ; + r1 = if (point 0 of r0) = (point length r0 of r0) : + (fullcircle yscaled node_loopback_yscale rotated 180 + if mfun_laboff@# <> origin : + rotated angle mfun_laboff@# + shifted .5mfun_laboff@# + fi) + scaled deviation + shifted point 0 of r0 + elseif deviation=0 : + r0 + else : + point 0 of r0 .. + unitvector direction .5length r0 of r0 rotated 90 + scaled deviation * arclength r0 + shifted point .5length r0 of r0 .. + point length r0 of r0 + fi ; + else : + if known l : + addto l also + else : + l := + fi + if picture a : a + elseif string a : if (length(a) > 0) : textext@#(a) else : nullpicture fi + elseif numeric a : textext@#(decimal a) + elseif ((boolean a) and a) : image(draw origin withpen currentpen scaled 4) + else : nullpicture + fi ; + fi + endfor + r2 = r1 + if known p.pic[f if cycle p: mod length p fi] : + cutbefore boundingbox (p.pic[f if cycle p: mod length p fi] shifted point f of p) + fi + if known q.pic[t if cycle q: mod length q fi] : + cutafter boundingbox (q.pic[t if cycle q: mod length q fi] shifted point t of q) + fi + ; + if known l : + l := l shifted point .5length r2 of r2 ; + draw l ; + (r2 if str @# = "" : crossingunder l fi) + else : + r2 + fi +enddef ; + +% returns pair: bounding point of the node picture + +vardef mfun_nodeboundingpoint@#(suffix p)(expr i) = + if known p.pic[i] : + boundingpoint@#(p.pic[i]) + else : + origin + fi +enddef ; + +% returns pair: scaled laboff direction + +vardef relative@#(expr s) = + (mfun_laboff@# scaled s) +enddef ; + +% returns pair: vector between nodes (+ optional scale) + +vardef betweennodes@#(suffix p)(expr f)(suffix q)(text s) = + save t ; + for a = s : + if unknown t : + t = a ; + mfun_nodeboundingpoint@#(q,t) + mfun_nodeboundingpoint@#(p,f) + else : + + relative@#(a) + fi + endfor +enddef ; + +% helpers that save passing tokens + +def mfun_node_init(expr dx, dy, da) = + save nodelattice ; pair nodelattice[] ; + nodelattice0 = (dx,0) ; + nodelattice1 = dy * dir(da) ; + clearnodepath ; + save nodecount ; nodecount = -1; +enddef ; + +def mfun_node_make(expr x, y, s) = + nodecount := nodecount + 1 ; + makenode(nodecount,s) = x * nodelattice0 + y * nodelattice1 ; +enddef ; + +def mfun_node_flush = + for i=0 upto nodecount: + draw node(i) ; + endfor +enddef ; + +vardef mfun_nodes_fromto@#(expr d, f)(text t) = + fromtopaths@#(d,nodepath,f,nodepath,t) +enddef ; + +permanent makenodepath, clearpath, clearnodepath, makenode, node, nodeboundingpoint, fromto, fromtopaths, relative, betweennodes ; +permanent node_loopback_yscale ; + diff --git a/Master/texmf-dist/metapost/context/base/mpxl/mp-page.mpxl b/Master/texmf-dist/metapost/context/base/mpxl/mp-page.mpxl new file mode 100644 index 00000000000..72831e92708 --- /dev/null +++ b/Master/texmf-dist/metapost/context/base/mpxl/mp-page.mpxl @@ -0,0 +1,296 @@ +%D \module +%D [ file=mp-page.mpiv, +%D version=1999.03.10, +%D title=\CONTEXT\ \METAPOST\ graphics, +%D subtitle=page enhancements, +%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. + +%D This module is rather preliminary and subjected to changes.In the process of +%D moving to \METAFUN2\ this might change. + +if known metafun_loaded_page : endinput ; fi ; + +newinternal boolean metafun_loaded_page ; metafun_loaded_page := true ; immutable metafun_loaded_page ; + +def LoadPageState = enddef ; % just in case some old style uses it + +% Next we implement the the page area model. First some constants. We use a +% matrix approach as we do at the TeX end but we could have gone for a period +% separated variant. Too late. + +LeftEdge := -4 ; Top := -40 ; +LeftEdgeSeparator := -3 ; TopSeparator := -30 ; +LeftMargin := -2 ; Header := -20 ; +LeftMarginSeparator := -1 ; HeaderSeparator := -10 ; +Text := 0 ; Text := 0 ; +RightMarginSeparator := +1 ; FooterSeparator := +10 ; +RightMargin := +2 ; Footer := +20 ; +RightEdgeSeparator := +3 ; BottomSeparator := +30 ; +RightEdge := +4 ; Bottom := +40 ; + +numeric HorPos ; HorPos := 0 ; +numeric VerPos ; VerPos := 0 ; + +immutable % permanent + Text, HorPos, VerPos, + LeftEdge, LeftEdgeSeparator, LeftMargin, LeftMarginSeparator, + RightMarginSeparator, RightMargin, RightEdgeSeparator, RightEdge, + Top, TopSeparator, Header, HeaderSeparator, + FooterSeparator, Footer, BottomSeparator, Bottom ; + +% Because metapost > 1.50 has dynamic memory management and is less efficient than +% before we now delay calculations ... (on a document with 150 pages the time spent +% in mp was close to 5 seconds which was only due to initialising the page related +% areas, something that was hardly noticeable before. At least now we're back to +% half a second for such a case. + +% We could go for just setting them (:=): + +path mfun_page_area[][] ; +pair mfun_page_location[][] ; +path mfun_page_field[][] ; +numeric mfun_page_vsize[] ; +numeric mfun_page_hsize[] ; +numeric mfun_page_vstep[] ; +numeric mfun_page_hstep[] ; + +newinternal mfun_page_done ; mfun_page_done := 0 ; + +def mfun_page_check_vsize = + mfun_page_vsize[Top] := TopHeight ; + mfun_page_vsize[TopSeparator] := TopDistance ; + mfun_page_vsize[Header] := HeaderHeight ; + mfun_page_vsize[HeaderSeparator] := HeaderDistance ; + mfun_page_vsize[Text] := TextHeight ; + mfun_page_vsize[FooterSeparator] := FooterDistance ; + mfun_page_vsize[Footer] := FooterHeight ; + mfun_page_vsize[BottomSeparator] := BottomDistance ; + mfun_page_vsize[Bottom] := BottomHeight ; +enddef ; + +def mfun_page_check_hsize = + mfun_page_hsize[LeftEdge] := LeftEdgeWidth ; + mfun_page_hsize[LeftEdgeSeparator] := LeftEdgeDistance ; + mfun_page_hsize[LeftMargin] := LeftMarginWidth ; + mfun_page_hsize[LeftMarginSeparator] := LeftMarginDistance ; + mfun_page_hsize[Text] := MakeupWidth ; + mfun_page_hsize[RightMarginSeparator] := RightMarginDistance ; + mfun_page_hsize[RightMargin] := RightMarginWidth ; + mfun_page_hsize[RightEdgeSeparator] := RightEdgeDistance ; + mfun_page_hsize[RightEdge] := RightEdgeWidth ; +enddef ; + +def mfun_page_check_vstep = + mfun_page_vstep[TopSeparator] := PaperHeight-TopSpace ; + mfun_page_vstep[Top] := mfun_page_vstep[TopSeparator] +mfun_page_vsize[TopSeparator] ; + mfun_page_vstep[Header] := mfun_page_vstep[TopSeparator] -mfun_page_vsize[Header] ; + mfun_page_vstep[HeaderSeparator] := mfun_page_vstep[Header] -mfun_page_vsize[HeaderSeparator] ; + mfun_page_vstep[Text] := mfun_page_vstep[HeaderSeparator]-mfun_page_vsize[Text] ; + mfun_page_vstep[FooterSeparator] := mfun_page_vstep[Text] -mfun_page_vsize[FooterSeparator] ; + mfun_page_vstep[Footer] := mfun_page_vstep[FooterSeparator]-mfun_page_vsize[Footer] ; + mfun_page_vstep[BottomSeparator] := mfun_page_vstep[Footer] -mfun_page_vsize[BottomSeparator] ; + mfun_page_vstep[Bottom] := mfun_page_vstep[BottomSeparator]-mfun_page_vsize[Bottom] ; +enddef ; + +def mfun_page_check_hstep = + mfun_page_hstep[Text] := BackSpace ; + mfun_page_hstep[LeftMarginSeparator] := mfun_page_hstep[Text] -mfun_page_hsize[LeftMarginSeparator] ; + mfun_page_hstep[RightMarginSeparator] := mfun_page_hstep[Text] +mfun_page_hsize[Text] ; + mfun_page_hstep[LeftMargin] := mfun_page_hstep[LeftMarginSeparator] -mfun_page_hsize[LeftMargin] ; + mfun_page_hstep[RightMargin] := mfun_page_hstep[RightMarginSeparator]+mfun_page_hsize[RightMarginSeparator] ; + mfun_page_hstep[LeftEdgeSeparator] := mfun_page_hstep[LeftMargin] -mfun_page_hsize[LeftEdgeSeparator] ; + mfun_page_hstep[LeftEdge] := mfun_page_hstep[LeftEdgeSeparator] -mfun_page_hsize[LeftEdge] ; + mfun_page_hstep[RightEdgeSeparator] := mfun_page_hstep[RightMargin] +mfun_page_hsize[RightMargin] ; + mfun_page_hstep[RightEdge] := mfun_page_hstep[RightEdgeSeparator] +mfun_page_hsize[RightEdgeSeparator] ; +enddef ; + +def mfun_check_page_dimensions = + if mfun_page_done <> RealPageNumber : + if LayoutHasChanged : + mfun_page_check_vsize ; + mfun_page_check_hsize ; + mfun_page_check_vstep ; + mfun_page_check_hstep ; + fi ; + mfun_page_done := RealPageNumber ; + fi ; +enddef; + + +def mfun_check_page_area = + mfun_check_page_dimensions ; + for VerPos=Top step 10 until Bottom: + for HorPos=LeftEdge step 1 until RightEdge: + mfun_page_area[HorPos][VerPos] := unitsquare xscaled mfun_page_hsize[HorPos] yscaled mfun_page_vsize[VerPos] ; + mfun_page_area[VerPos][HorPos] := mfun_page_area[HorPos][VerPos] ; + endfor ; + endfor ; +enddef ; + +def mfun_check_page_location = + mfun_check_page_dimensions ; + for VerPos=Top step 10 until Bottom: + for HorPos=LeftEdge step 1 until RightEdge: + mfun_page_location[HorPos][VerPos] := (mfun_page_hstep[HorPos],mfun_page_vstep[VerPos]) ; + mfun_page_location[VerPos][HorPos] := mfun_page_location[HorPos][VerPos] ; + endfor ; + endfor ; +enddef ; + +def mfun_check_page_field = + mfun_check_page_dimensions ; + for VerPos=Top step 10 until Bottom: + for HorPos=LeftEdge step 1 until RightEdge: + mfun_page_field[HorPos][VerPos] := unitsquare xscaled mfun_page_hsize[HorPos] yscaled mfun_page_vsize[VerPos] shifted (mfun_page_hstep[HorPos],mfun_page_vstep[VerPos]) ; + mfun_page_field[VerPos][HorPos] := mfun_page_field[HorPos][VerPos] ; + endfor ; + endfor ; +enddef ; + +def Area = hide(mfun_check_page_area ;) mfun_page_area enddef ; +def Location = hide(mfun_check_page_location ;) mfun_page_location enddef ; +def Field = hide(mfun_check_page_field ;) mfun_page_field enddef ; +def Vsize = hide(mfun_check_page_dimensions ;) mfun_page_vsize enddef ; +def Hsize = hide(mfun_check_page_dimensions ;) mfun_page_hsize enddef ; +def Vstep = hide(mfun_check_page_dimensions ;) mfun_page_vstep enddef ; +def Hstep = hide(mfun_check_page_dimensions ;) mfun_page_hstep enddef ; + +immutable % permanent + Area, Location, Field, Vsize, Hsize, Vstep, Hstep ; + +vardef FrontPageWidth = PaperWidth enddef ; +vardef BackPageWidth = PaperWidth enddef ; +vardef CoverWidth = 2 * PaperWidth + SpineWidth enddef ; +vardef CoverHeight = PaperHeight enddef ; + +vardef FrontPageHeight = PaperHeight enddef ; +vardef BackPageHeight = PaperHeight enddef ; +vardef SpineHeight = PaperHeight enddef ; + +path mfun_page_page, mfun_page_cover, mfun_page_spine, mfun_page_back, mfun_page_front ; + +def mfun_check_page = mfun_page_page := unitsquare xscaled PaperWidth yscaled PaperHeight ; enddef ; +def mfun_check_cover = mfun_page_cover := unitsquare xscaled CoverWidth yscaled CoverHeight ; enddef ; +def mfun_check_spine = mfun_page_spine := unitsquare xscaled SpineWidth yscaled CoverHeight shifted (BackPageWidth,0) ; enddef ; +def mfun_check_back = mfun_page_back := unitsquare xscaled BackPageWidth yscaled CoverHeight ; enddef ; +def mfun_check_front = mfun_page_front := unitsquare xscaled FrontPageWidth yscaled CoverHeight shifted (BackPageWidth+SpineWidth,0) ; enddef ; + +def Page = hide(mfun_check_page ;) mfun_page_page enddef ; +def CoverPage = hide(mfun_check_cover ;) mfun_page_cover enddef ; +def Spine = hide(mfun_check_spine ;) mfun_page_spine enddef ; +def BackPage = hide(mfun_check_back ;) mfun_page_back enddef ; +def FrontPage = hide(mfun_check_front ;) mfun_page_front enddef ; + +% pages + +def StartPage = + begingroup ; + setbounds currentpicture to Page ; +enddef ; + +def StopPage = + setbounds currentpicture to Page ; + endgroup ; +enddef ; + +% cover pages + +def StartCover = + begingroup ; + setbounds currentpicture to CoverPage enlarged PaperBleed ; +enddef ; + +def StopCover = + setbounds currentpicture to CoverPage enlarged PaperBleed ; + endgroup ; +enddef ; + +immutable % permanent + FrontPageWidth, BackPageWidth, CoverWidth, FrontPageHeight, BackPageHeight, CoverHeight, + SpineHeight, Page, CoverPage, Spine, BackPage, FrontPage, + StartPage, StopPage, StartCover, StopCover ; + +% overlays: + +def OverlayBox = + (unitsquare xyscaled (OverlayWidth,OverlayHeight)) +enddef ; + +immutable % permanent + OverlayBox ; + +% handy + +def innerenlarged = + if OnRightPage : leftenlarged else : rightenlarged fi +enddef ; + +def outerenlarged = + if OnRightPage : rightenlarged else : leftenlarged fi +enddef ; + +permanent + innerenlarged, outerenlarged ; + +% obsolete + +% def llEnlarged (expr p,d) = (llcorner p shifted (-d,-d)) enddef ; +% def lrEnlarged (expr p,d) = (lrcorner p shifted (+d,-d)) enddef ; +% def urEnlarged (expr p,d) = (urcorner p shifted (+d,+d)) enddef ; +% def ulEnlarged (expr p,d) = (ulcorner p shifted (-d,+d)) enddef ; + +% def Enlarged (expr p, d) = +% ( +% llEnlarged (p,d) -- +% lrEnlarged (p,d) -- +% urEnlarged (p,d) -- +% ulEnlarged (p,d) -- +% cycle +% ) +% enddef ; + +% for the moment we put these here: + +string RuleDirection ; RuleDirection := "" ; +string RuleOption ; RuleOption := "" ; +numeric RuleWidth ; RuleWidth := 0 ; +numeric RuleHeight ; RuleHeight := 0 ; +numeric RuleDepth ; RuleDepth := 0 ; +numeric RuleH ; RuleH := 0 ; +numeric RuleV ; RuleV := 0 ; +numeric RuleThickness ; RuleThickness := 0 ; +numeric RuleFactor ; RuleFactor := 0 ; +numeric RuleOffset ; RuleOffset := 0 ; + def RuleColor = (.5white) enddef ; % yet undecided, might become a string + +def FakeWord(expr RuleWidth, RuleHeight, RuleDepth, RuleThickness) (text RuleColor) = + fill unitsquare + xscaled RuleWidth + yscaled (RuleDepth-RuleThickness/2) + withcolor RuleColor ; + fill unitsquare + xscaled RuleWidth + yscaled (RuleHeight-RuleDepth-RuleThickness/2) + shifted (0,RuleDepth+RuleThickness) + withcolor RuleColor ; +enddef ; + +def FakeRule(expr RuleWidth, RuleHeight, RuleDepth, RuleThickness) (text RuleColor) = + fill unitsquare + xscaled RuleWidth + yscaled RuleHeight + withcolor RuleColor ; +enddef ; + +mutable + RuleDirection, RuleOption, RuleWidth, RuleHeight, RuleDepth, RuleH, RuleV, RuleThickness, + RuleFactor, RuleOffset, RuleColor; + +permanent + FakeWord, FakeRule ; diff --git a/Master/texmf-dist/metapost/context/base/mpxl/mp-shap.mpxl b/Master/texmf-dist/metapost/context/base/mpxl/mp-shap.mpxl new file mode 100644 index 00000000000..e43b8128021 --- /dev/null +++ b/Master/texmf-dist/metapost/context/base/mpxl/mp-shap.mpxl @@ -0,0 +1,228 @@ +%D \module +%D [ file=mp-shap.mpiv, +%D version=2000.05.31, +%D title=\CONTEXT\ \METAPOST\ graphics, +%D subtitle=shapes, +%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 licen-en.pdf for +%C details. + +if known metafun_loaded_shap : endinput ; fi ; + +newinternal boolean metafun_loaded_shap ; metafun_loaded_shap := true ; immutable metafun_loaded_shap ; + +path predefined_shapes[] ; + +def start_predefined_shape_definition = + + begingroup ; + + save xradius, yradius, xxradius, yyradius ; + save ll, lr, ur, ul, llx, lly, lrx, lry, urx, ury, ulx, uly, llxx, llyy, lrxx, lryy, urxx, uryy, ulxx, ulyy, lc, rc, tc, bc ; + + numeric xradius, yradius, xxradius, yyradius ; + pair ll, lr, ur, ul, llx, lly, lrx, lry, urx, ury, ulx, uly, llxx, llyy, lrxx, lryy, urxx, uryy, ulxx, ulyy, lc, rc, tc, bc ; + + xradius := .15 ; + yradius := .15 ; + xxradius := .10 ; + yyradius := .10 ; + + ll := llcorner (unitsquare shifted (-.5,-.5)) ; + lr := lrcorner (unitsquare shifted (-.5,-.5)) ; + ur := urcorner (unitsquare shifted (-.5,-.5)) ; + ul := ulcorner (unitsquare shifted (-.5,-.5)) ; + + llx := ll shifted (xradius,0) ; + lly := ll shifted (0,yradius) ; + + lrx := lr shifted (-xradius,0) ; + lry := lr shifted (0,yradius) ; + + urx := ur shifted (-xradius,0) ; + ury := ur shifted (0,-yradius) ; + + ulx := ul shifted (xradius,0) ; + uly := ul shifted (0,-yradius) ; + + llxx := ll shifted (xxradius,0) ; + llyy := ll shifted (0,yyradius) ; + + lrxx := lr shifted (-xxradius,0) ; + lryy := lr shifted (0,yyradius) ; + + urxx := ur shifted (-xxradius,0) ; + uryy := ur shifted (0,-yyradius) ; + + ulxx := ul shifted (xxradius,0) ; + ulyy := ul shifted (0,-yyradius) ; + + lc := ll shifted (0,.5) ; + rc := lr shifted (0,.5) ; + tc := ul shifted (.5,0) ; + bc := ll shifted (.5,0) ; + +enddef ; + +def stop_predefined_shape_definition = + + endgroup ; + +enddef ; + +% this can be delayed + +start_predefined_shape_definition ; + + predefined_shapes[ 0] := (origin--cycle) ; + predefined_shapes[ 5] := (llx--lrx{right}...rc...{left}urx--ulx{left}...lc...{right}cycle) ; + predefined_shapes[ 6] := (ll--lrx{right}...rc...{left}urx--ul--cycle) ; + predefined_shapes[ 7] := (ll--lrx{right}...rc...{left}urx--ul--cycle) rotatedaround(origin,180) ; + predefined_shapes[ 8] := (lr--ury{up}...tc...{down}uly--ll--cycle) ; + predefined_shapes[ 9] := (lr--ury{up}...tc...{down}uly--ll--cycle) rotatedaround(origin,180) ; + predefined_shapes[10] := (ll--lr--ur--ul--ll--ur--ul--ll--cycle) ; + predefined_shapes[11] := (ll--lr--ur--ul--ll--lr--ul--ll--cycle) ; + predefined_shapes[12] := (ll--lrx--ur--ulx--cycle) ; + predefined_shapes[13] := (llx--lr--urx--ul--cycle) ; + predefined_shapes[14] := (lly--bc--lry--ury--tc--uly--cycle) ; + predefined_shapes[15] := (llx--lrx--rc--urx--ulx--lc--cycle) ; + predefined_shapes[16] := (ll--lrx--rc--urx--ul--cycle) ; + predefined_shapes[17] := (ll--lrx--rc--urx--ul--cycle) rotatedaround(origin,180) ; + predefined_shapes[18] := (lr--ury--tc--uly--ll--cycle) ; + predefined_shapes[19] := (lr--ury--tc--uly--ll--cycle) rotatedaround(origin,180) ; + predefined_shapes[20] := (ll--lr--ur--ul--ll--llxx--ulxx--ul--ll--lr--ur--urxx--lrxx--cycle) ; + predefined_shapes[21] := (ul--ll--lr--ur--ul--ulyy--uryy--ur--ul--ll--lr--lryy--llyy--cycle) ; + predefined_shapes[22] := (ll--lrx--lry--ur--ulx--uly--cycle) ; + predefined_shapes[23] := (llx--lr--ury--urx--ul--lly--cycle) ; + predefined_shapes[24] := (ll--lr--ur--ul--cycle) ; + predefined_shapes[25] := (llx--lrx--lry--ury--urx--ulx--uly--lly--cycle) ; + predefined_shapes[26] := (ll--lrx--lry--ur--ul--cycle) ; + predefined_shapes[27] := (ll--lr--ury--urx--ul--cycle) rotatedaround(origin,180) ; + predefined_shapes[28] := (ll--lr--ury--urx--ul--cycle) ; + predefined_shapes[29] := (ll--lrx--lry--ur--ul--cycle) rotatedaround(origin,180) ; + predefined_shapes[30] := (bc{right}...{up}rc...tc{left}...{down}lc...{right}bc & bc--tc & tc{left}..{down}lc & lc--rc & rc{up}..tc{left}...{down}lc...{right}bc & cycle) rotated 45; + predefined_shapes[31] := (bc{right}...{up}rc...tc{left}...{down}lc...{right}bc & bc--tc & tc{left}..{down}lc & lc--rc & rc{up}..tc{left}...{down}lc...{right}bc & cycle) ; + predefined_shapes[32] := (ll{right}...{right}lry--ur--ul--ll--cycle) ; + predefined_shapes[33] := (ll{right}...{right}lry--ur--ul--ll--cycle--ul--ulx--ulx shifted(0,yyradius)--ur shifted(yyradius,yyradius)--lry shifted(yyradius,yyradius)--lry shifted(0,yyradius)--ur--ul--cycle ) ; + predefined_shapes[34] := (uly..tc..ury & ury..tc shifted (0,-2yradius)..uly & uly--lly & lly..bc..lry & lry--ury & ury..tc shifted (0,-2yradius)..uly & cycle ) ; + predefined_shapes[35] := (bc{right}...rc{up}...tc{left}...lc{down}...cycle) ; + predefined_shapes[36] := (ul--tc{right}..rc{down}..{left}bc--ll & ll..(xpart llx, ypart lc)..ul & cycle) ; + predefined_shapes[37] := (ul--tc{right}..rc{down}..{left}bc--ll & ll..(xpart llx, ypart lc)..ul & cycle) rotatedaround(origin,180) ; + predefined_shapes[38] := (ll--lc{up}..tc{right}..{down}rc--lr & lr..(xpart bc, ypart lly)..ll & cycle) ; + predefined_shapes[39] := (ll--lc{up}..tc{right}..{down}rc--lr & lr..(xpart bc, ypart lly)..ll & cycle) rotatedaround(origin,180) ; + predefined_shapes[40] := (ll--lr--ur--ul--ll--ur--ul--ll--lr--ul--ll--cycle) ; + predefined_shapes[41] := (ll--lr--ur--ul--ll--lr--rc--lc--ll--bc--tc--ul--ll & cycle) ; + predefined_shapes[42] := (ll--lr--origin shifted (+epsilon,0)--ur--ul--origin shifted (-epsilon,0)--cycle) ; + predefined_shapes[43] := (ll--ul--origin shifted (0,+epsilon)--ur--lr--origin shifted (0,-epsilon)--cycle) ; + predefined_shapes[45] := (bc--rc--tc--lc--cycle) ; + predefined_shapes[46] := (ll--ul--rc--cycle) ; + predefined_shapes[47] := (ll--ul--rc--cycle) rotatedaround(origin,180) ; + predefined_shapes[48] := (ul--ur--bc--cycle) rotatedaround(origin,180) ; + predefined_shapes[49] := (ul--ur--bc--cycle) ; + predefined_shapes[56] := (ll--lry--ury--ul--cycle) ; + predefined_shapes[57] := (ll--lry--ury--ul--cycle) rotatedaround(origin,180) ; + predefined_shapes[58] := (ll--ulx--urx--lr--cycle) ; + predefined_shapes[59] := (ll--ulx--urx--lr--cycle) rotatedaround(origin,180); + predefined_shapes[66] := (rc--origin shifted ( epsilon,0) --cycle & rc--origin--cycle ) ; + predefined_shapes[67] := (lc--origin shifted (-epsilon,0) --cycle & lc--origin--cycle ) ; + predefined_shapes[68] := (tc--origin shifted (0, epsilon) --cycle & tc--origin--cycle ) ; + predefined_shapes[69] := (bc--origin shifted (0,-epsilon) --cycle & bc--origin--cycle ) ; + predefined_shapes[75] := (lly--lry--ury--uly--cycle) rotatedaround(origin,180) ; + predefined_shapes[76] := (ll--lr--ur--uly--cycle) rotatedaround(origin,180) ; + predefined_shapes[77] := (ll--lr--ury--ul--cycle) rotatedaround(origin,180) ; + predefined_shapes[78] := (lly--lr--ur--ul--cycle) rotatedaround(origin,180) ; + predefined_shapes[79] := (ll--lry--ur--ul--cycle) rotatedaround(origin,180) ; + + numeric predefined_shapes_xradius ; predefined_shapes_xradius := xradius ; + numeric predefined_shapes_yradius ; predefined_shapes_yradius := yradius ; + numeric predefined_shapes_xxradius ; predefined_shapes_xxradius := xxradius ; + numeric predefined_shapes_yyradius ; predefined_shapes_yyradius := yyradius ; + +stop_predefined_shape_definition ; + +vardef some_shape_path (expr type) = + if known predefined_shapes[type] : predefined_shapes[type] else : predefined_shapes[24] fi +enddef ; + +def some_shape (expr shape_type, shape_width, shape_height, shape_linewidth, shape_linecolor, shape_fillcolor) = + begingroup ; + save p ; path p ; + p := some_shape_path (shape_type) xscaled shape_width yscaled shape_height ; + pickup pencircle scaled shape_linewidth ; + fill p withcolor shape_fillcolor ; + draw p withcolor shape_linecolor ; + endgroup ; +enddef ; + +% maybe: +% +% if t>1 : % normal shape +% path pp ; pp := some_shape_path(t) xyscaled(bbwidth(p), bbheight(p)) ; +% pp := pp shifted - center pp shifted center p ; +% fill pp withcolor fc ; +% draw pp withpen pencircle scaled lw withcolor lc ; + +vardef drawpredefinedshape (expr t, p, lw, lc, fc) = + save pp ; + if t > 1 : % normal shape + path pp ; + pp := some_shape_path(t) xyscaled(bbwidth(p), bbheight(p)) shifted center p ; + fill pp withcolor fc ; + draw pp withpen pencircle scaled lw withcolor lc ; + elseif t = 1 : % background only + path pp ; + pp := fullsquare xyscaled(bbwidth(p), bbheight(p)) shifted center p ; + fill pp withcolor fc ; + else : % dimensions only + picture pp ; pp := nullpicture ; + setbounds pp to fullsquare xyscaled(bbwidth(p), bbheight(p)) shifted center p ; + draw pp ; + fi ; +enddef ; + +vardef drawpredefinedline (expr t, p, lw, lc) = + if (t>0) and (length(p)>1) : + saveoptions ; + drawoptions(withpen pencircle scaled lw withcolor lc) ; + draw p ; + if t = 1 : + draw arrowheadonpath(p,1) ; + elseif t = 2 : + draw arrowheadonpath(reverse p,1) ; + elseif t = 3 : + for $ = p,reverse p : + draw arrowheadonpath($,1) ; + endfor ; + elseif t = 11 : + draw arrowheadonpath(p,1/2) ; + elseif t = 12 : + draw arrowheadonpath(reverse p,1/2) ; + elseif t = 13 : + for $=p,reverse p : + draw arrowheadonpath($,1) ; + endfor ; + for $=p,reverse p : + draw arrowheadonpath($,3/4) ; + endfor ; + elseif t = 21 : + for $=1/5,1/2,4/5 : + draw arrowheadonpath(p,$) ; + endfor ; + elseif t = 22 : + for $=1/5,1/2,4/5 : + draw arrowheadonpath(reverse p,$) ; + endfor ; + elseif t = 23 : + for $=p,reverse p : + draw arrowheadonpath($,1/4) ; + endfor ; + fi ; + fi ; +enddef ; + +let drawshape = drawpredefinedshape ; +let drawline = drawpredefinedline ; diff --git a/Master/texmf-dist/metapost/context/base/mpxl/mp-text.mpxl b/Master/texmf-dist/metapost/context/base/mpxl/mp-text.mpxl new file mode 100644 index 00000000000..c18647baf32 --- /dev/null +++ b/Master/texmf-dist/metapost/context/base/mpxl/mp-text.mpxl @@ -0,0 +1,217 @@ +%D \module +%D [ file=mp-text.mpiv, +%D version=2000.07.10, +%D title=\CONTEXT\ \METAPOST\ graphics, +%D subtitle=text support, +%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 licen-en.pdf for +%C details. + +%D This one is only used in metafun so it will become a module. + +if known metafun_loaded_text : endinput ; fi ; + +newinternal boolean metafun_loaded_text ; metafun_loaded_text := true ; immutable metafun_loaded_text ; + +% This is still mostly the same as the one discussed in the good old \METAFUN\ +% example code but modernized abit to suit \LMTX. + +newscriptindex mfid_setparshapeproperty ; mfid_setparshapeproperty := scriptindex "setparshapeproperty" ; + +% this is the old name + +presetparameters "parshape" [ + % offset = 0, + % path = fullsquare, + % dx = 0, + % dy = 0, + % strutheight = StrutHeight, + % strutdepth = StutDepth, + % lineheight = LineHeight, + % topskip = StrutHeight, + % trace = false, +] ; + +def lmt_parshape = applyparameters "parshape" "lmt_do_parshape" enddef ; + +def lmt_do_parshape = % todo: check and improve this rather oldie + + begingroup ; pushparameters "parshape" ; + + save + p, q, l, r, line, tt, bb, + dx, dy, baselineskip, strutheight, strutdepth, topskip, bottomskip, offset, trace, + n, hsize, vsize, vvsize, voffset, hoffset, width, indent, + ll, lll, rr, rrr, cp, cq, t, b, + found_point ; + + path + p, q, l, r, line, tt, bb ; + numeric + dx, dy, baselineskip, strutheight, strutdepth, topskip, offset, + n, hsize, vsize, vvsize, voffset, hoffset, width[], indent[] ; + pair + ll, lll, rr, rrr, cp, cq, t, b ; + boolean + trace ; + + % specification: + + p := getparameterdefault "path" fullsquare ; + dx := getparameterdefault "dx" 0 ; + dy := getparameterdefault "dy" 0 ; + baselineskip := getparameterdefault "baselineskip" LineHeight ; + strutheight := getparameterdefault "strutheight" StrutHeight ; + strutdepth := getparameterdefault "strutdepth" StrutDepth ; + topskip := getparameterdefault "topskip" StrutHeight ; + bottomskip := getparameterdefault "bottomskip" 0 ; + offset := getparameterdefault "offset" 0 ; + trace := getparameterdefault "trace" false ; + + % + + n := 0 ; + cp := center p ; + + if hasparameter "offsetpath" : + q := getparameter "offsetpath" ; + voffset := dy ; + hoffset := dx ; + else : + q := p ; + hoffset := offset + dx ; + voffset := offset + dy ; + fi ; + + cq := center q ; + + hsize := xpart lrcorner q - xpart llcorner q ; + vsize := ypart urcorner q - ypart lrcorner q ; + + q := p shifted - cp ; + + runscript mfid_setparshapeproperty "voffset" voffset ; + runscript mfid_setparshapeproperty "hoffset" hoffset ; + runscript mfid_setparshapeproperty "width" hsize ; + runscript mfid_setparshapeproperty "height" vsize ; + + if hasparameter "offsetpath" : + q := q xscaled ((hsize-2hoffset)/hsize) yscaled ((vsize-2voffset)/vsize) ; + fi ; + + hsize := xpart lrcorner q - xpart llcorner q ; + vsize := ypart urcorner q - ypart lrcorner q ; + + t := (ulcorner q -- urcorner q) intersection_point q ; + b := (llcorner q -- lrcorner q) intersection_point q ; + + if xpart directionpoint t of q < 0 : + q := reverse q ; + fi ; + + l := q cutbefore t ; + l := l if xpart point 0 of q < 0 : & q fi cutafter b ; + + r := q cutbefore b ; + r := r if xpart point 0 of q > 0 : & q fi cutafter t ; + + vardef found_point (expr lin, pat, sig) = + save a, b; pair a, b ; + a := pat intersection_point (lin shifted (0,strutheight)) ; + if intersection_found : + a := a shifted (0,-strutheight) ; + else : + a := pat intersection_point lin ; + fi ; + b := pat intersection_point (lin shifted (0,-strutdepth)) ; + if intersection_found : + if sig : + if xpart b > xpart a : a := b shifted (0,strutdepth) fi ; + else : + if xpart b < xpart a : a := b shifted (0,strutdepth) fi ; + fi ; + fi ; + a + enddef ; + + if (strutheight + strutdepth < baselineskip) : + vvsize := vsize ; + else : + vvsize := (vsize div baselineskip) * baselineskip ; + fi ; + + runscript mfid_setparshapeproperty "first" false ; + + for i = topskip step baselineskip until (vvsize + bottomskip) : + + line := (ulcorner q -- urcorner q) shifted (0,-i-eps) ; + + ll := found_point(line,l,true ) ; + rr := found_point(line,r,false) ; + + if trace : + fill (ll -- rr -- rr shifted (0,strutheight) -- ll shifted (0,strutheight) -- cycle) shifted cp withcolor .6white ; + fill (ll -- rr -- rr shifted (0,-strutdepth) -- ll shifted (0,-strutdepth) -- cycle) shifted cp withcolor .8white ; + draw ll shifted cp withpen pencircle scaled 2pt ; + draw rr shifted cp withpen pencircle scaled 2pt ; + draw (ll -- rr) shifted cp withpen pencircle scaled .5pt ; + fi ; + + n := n + 1 ; + indent[n] := abs(xpart ll - xpart llcorner q) ; + width[n] := abs(xpart rr - xpart ll) ; + + if (i = strutheight) and (width[n] < baselineskip) : + n := n - 1 ; + runscript mfid_setparshapeproperty "first" true ; + fi ; + + endfor ; + + if trace : + drawarrow p withpen pencircle scaled 2pt withcolor red ; + drawarrow l shifted cp withpen pencircle scaled 1pt withcolor green ; + drawarrow r shifted cp withpen pencircle scaled 1pt withcolor blue ; + fi ; + + runscript mfid_setparshapeproperty "lines" n ; + + for i=1 upto n: + runscript mfid_setparshapeproperty "line" i (indent[i]) (width[i]) ; + endfor ; + + popparameters ; endgroup ; + +enddef ; + +def build_parshape (expr p, offset_or_path, dx, dy, baselineskip, strutheight, strutdepth, topskip) = + if path offset_or_path : + lmt_parshape [ + path = p, + offsetpath = offset_or_path, + dx = dx, + dy = dy, + strutheight = strutheight, + strutdepth = strutdepth, + lineheight = lineheight, + topskip = topskip, + trace = (if unknown trace_parshape : false else : trace_parshape fi), + ] + else : + lmt_parshape [ + path = p, + offset = offset_or_path, + dx = dx, + dy = dy, + strutheight = strutheight, + strutdepth = strutdepth, + lineheight = lineheight, + topskip = topskip, + trace = (if unknown trace_parshape : false else : trace_parshape fi), + ] + fi ; +enddef ; diff --git a/Master/texmf-dist/metapost/context/base/mpxl/mp-tool.mpxl b/Master/texmf-dist/metapost/context/base/mpxl/mp-tool.mpxl new file mode 100644 index 00000000000..7ea222fb002 --- /dev/null +++ b/Master/texmf-dist/metapost/context/base/mpxl/mp-tool.mpxl @@ -0,0 +1,3831 @@ +%D \module +%D [ file=mp-tool.mpiv, +%D version=1998.02.15, +%D title=\CONTEXT\ \METAPOST\ graphics, +%D subtitle=auxiliary macros, +%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_tool : endinput ; fi ; + +newinternal boolean metafun_loaded_tool ; metafun_loaded_tool := true ; immutable metafun_loaded_tool ; + +let @## = @# ; + +let noexpand = quote ; + +permanent @##, noexpand ; + +%D New, version number testing: +%D +%D \starttyping +%D fill fullcircle scaled 2cm withcolor if mpversiongt("0.6") : red else : green fi ; +%D fill fullcircle scaled 1cm withcolor if mpversionlt(0.6) : blue else : white fi ; +%D \stoptyping + +if not known mpversion : string mpversion ; mpversion := "0.641" ; fi ; + +% newinternal metapostversion ; metapostversion := scantokens(mpversion) ; + +newinternal metapostversion ; metapostversion := 2.0 ; permanent metapostversion ; + +%D We always want \EPS\ conforming output, so we say: + +warningcheck := 0 ; + +%D Handy: + +def nothing = enddef ; + +%D Namespace handling: + +% let exclamationmark = ! ; +% let questionmark = ? ; +% +% def unprotect = +% let ! = relax ; +% let ? = relax ; +% enddef ; +% +% def protect = +% let ! = exclamationmark ; +% let ? = questionmark ; +% enddef ; +% +% unprotect ; +% +% mp!some!module = 10 ; show mp!some!module ; show somemodule ; +% +% protect ; + +string space ; space := char 32 ; +string percent ; percent := char 37 ; +string crlf ; crlf := char 10 & char 13 ; +string dquote ; dquote := char 34 ; + +% let SPACE = space ; +% let CRLF = crlf ; +% let DQUOTE = dquote ; +% let PERCENT = percent ; + +permanent space, percent, crlf, dquote ; + +% %D Plain compatibility: +% +% string plain_compatibility_data ; plain_compatibility_data := "" ; +% +% def startplaincompatibility = +% begingroup ; +% scantokens plain_compatibility_data ; +% enddef ; +% +% def stopplaincompatibility = +% endgroup ; +% enddef ; + +%D More neutral: + +let triplet = rgbcolor ; +let quadruplet = cmykcolor ; + +permanent triplet, quadruplet ; + +%D Image redefined, for Alan: + +vardef image@#(text t) = + save currentpicture ; + picture currentpicture ; + currentpicture := nullpicture ; + t ; + currentpicture + if str @# <> "" : + shifted ( + mfun_labxf@# * lrcorner p + + mfun_labyf@# * ulcorner p + + (1-mfun_labxf@#-mfun_labyf@#) * llcorner p + ) + fi +enddef ; + +permanent image ; + +%D Variables + +def dispose suffix s = + if known s : + begingroup ; + save ss ; + if numeric s : numeric ss + elseif boolean s : boolean ss + elseif pair s : pair ss + elseif path s : path ss + elseif picture s : picture ss + elseif string s : string ss + elseif transform s : transform ss + elseif color s : color ss + elseif rgbcolor s : rgbcolor ss + elseif cmykcolor s : cmykcolor ss + elseif pen s : pen ss + else s : numeric ss + fi ; + s := ss ; + endgroup ; + fi ; +enddef ; + +permanent dispose ; + +%D Colors: + +newinternal nocolormodel ; nocolormodel := 1 ; +newinternal greycolormodel ; greycolormodel := 3 ; +newinternal graycolormodel ; graycolormodel := 3 ; +newinternal rgbcolormodel ; rgbcolormodel := 5 ; +newinternal cmykcolormodel ; cmykcolormodel := 7 ; + +let grayscale = graycolor ; +let greyscale = greycolor ; + +vardef colorpart expr c = + if not picture c : + 0 + elseif colormodel c = greycolormodel : + greypart c + elseif colormodel c = rgbcolormodel : + (redpart c,greenpart c,bluepart c) + elseif colormodel c = cmykcolormodel : + (cyanpart c,magentapart c,yellowpart c,blackpart c) + else : + 0 % black + fi +enddef ; + +vardef colorlike(text c) text v = % colorlike(a) b, c, d ; + save temp_p ; picture temp_p ; + forsuffixes i=v : + temp_p := image(draw origin withcolor c ;) ; % intercept pre and postscripts + if (colormodel temp_p = cmykcolormodel) : + cmykcolor i ; + elseif (colormodel temp_p = rgbcolormodel) : + rgbcolor i ; + else : + greycolor i ; + fi ; + endfor ; +enddef ; + +permanent nocolormodel, greycolormodel, graycolormodel, rgbcolormodel, cmykcolormodel, + greyscale, grayscale, colorpart, colorlike ; + +%D Also multiple d's: handy (when we flush colors): + +vardef ddecimal primary p = + decimal xpart p & " " & decimal ypart p +enddef ; + +vardef dddecimal primary c = + decimal redpart c & " " & decimal greenpart c & " " & decimal bluepart c +enddef ; + +vardef ddddecimal primary c = + decimal cyanpart c & " " & decimal magentapart c & " " & decimal yellowpart c & " " & decimal blackpart c +enddef ; + +vardef colordecimals primary c = + if cmykcolor c : + decimal cyanpart c & ":" & decimal magentapart c & ":" & decimal yellowpart c & ":" & decimal blackpart c + elseif rgbcolor c : + decimal redpart c & ":" & decimal greenpart c & ":" & decimal bluepart c + elseif string c: + colordecimals resolvedcolor(c) + else : + decimal c + fi +enddef ; + +vardef colordecimalslist(text t) = + save b ; boolean b ; b := false ; + for s=t : + if b : & " " & fi + colordecimals(s) + hide(b := true ;) + endfor +enddef ; + +permanent decimal, ddecimal, dddecimal, ddddecimal, colordecimals, colordecimalslist ; + +% vardef _ctx_color_spec_ primary c = +% if cmykcolor c : +% "c=" & decimal cyanpart c & +% ",m=" & decimal magentapart c & +% ",y=" & decimal yellowpart c & +% ",k=" & decimal blackpart c +% elseif rgbcolor c : +% "r=" & decimal redpart c & +% ",g=" & decimal greenpart c & +% ",b=" & decimal bluepart c +% else : +% "s=" & decimal c +% fi +% enddef ; +% +% vardef _ctx_color_spec_list_(text t) = +% save b ; boolean b ; b := false ; +% for s=t : +% if b : & " " & fi +% _ctx_color_spec_(s) +% hide(b := true ;) +% endfor +% enddef ; + +%D Because \METAPOST\ has a hard coded limit of 4~datafiles, we need some trickery +%D when we have multiple files. This will be redone (via \LUA). + +boolean savingdata ; savingdata := false ; +boolean savingdatadone ; savingdatadone := false ; + +def savedata expr txt = + lua.mp.mf_save_data(txt); +enddef ; + +def startsavingdata = + lua.mp.mf_start_saving_data(); +enddef ; + +def stopsavingdata = + lua.mp.mf_stop_saving_data() ; +enddef ; + +def finishsavingdata = + lua.mp.mf_finish_saving_data() ; +enddef ; + +%D Instead of a keystroke eating save and allocation sequence, you can use the \quote +%D {new} alternatives to save and allocate in one command. + +%D Are these used? + +def newcolor text v = forsuffixes i=v : save i ; color i ; endfor ; enddef ; +def newrgbcolor text v = forsuffixes i=v : save i ; rgbcolor i ; endfor ; enddef ; +def newcmykcolor text v = forsuffixes i=v : save i ; cmykcolor i ; endfor ; enddef ; +def newnumeric text v = forsuffixes i=v : save i ; numeric i ; endfor ; enddef ; +def newboolean text v = forsuffixes i=v : save i ; boolean i ; endfor ; enddef ; +def newtransform text v = forsuffixes i=v : save i ; transform i ; endfor ; enddef ; +def newpath text v = forsuffixes i=v : save i ; path i ; endfor ; enddef ; +def newpicture text v = forsuffixes i=v : save i ; picture i ; endfor ; enddef ; +def newstring text v = forsuffixes i=v : save i ; string i ; endfor ; enddef ; +def newpair text v = forsuffixes i=v : save i ; pair i ; endfor ; enddef ; + +permanent newcolor, newrgbcolor, newcmykcolor, newnumeric, newboolean, newtransform, newpath, newpicture, newstring, newpair ; + +%D Sometimes we don't want parts of the graphics add to the bounding box. One way of +%D doing this is to save the bounding box, draw the graphics that may not count, and +%D restore the bounding box. +%D +%D \starttyping +%D push_boundingbox currentpicture; +%D pop_boundingbox currentpicture; +%D \stoptyping +%D +%D The bounding box can be called with: +%D +%D \starttyping +%D boundingbox currentpicture +%D inner_boundingbox currentpicture +%D outer_boundingbox currentpicture +%D \stoptyping +%D +%D Especially the latter one can be of use when we include the graphic in a document +%D that is clipped to the bounding box. In such occasions one can use: +%D +%D \starttyping +%D set_outer_boundingbox currentpicture; +%D \stoptyping +%D +%D Its counterpart is: +%D +%D \starttyping +%D set_inner_boundingbox p +%D \stoptyping + +path mfun_boundingbox_stack[] ; +numeric mfun_boundingbox_stack_depth ; + +mfun_boundingbox_stack_depth := 0 ; + +def pushboundingbox text p = + mfun_boundingbox_stack_depth := mfun_boundingbox_stack_depth + 1 ; + mfun_boundingbox_stack[mfun_boundingbox_stack_depth] := boundingbox p ; +enddef ; + +def popboundingbox text p = + setbounds p to mfun_boundingbox_stack[mfun_boundingbox_stack_depth] ; + mfun_boundingbox_stack[mfun_boundingbox_stack_depth] := origin -- cycle ; + mfun_boundingbox_stack_depth := mfun_boundingbox_stack_depth - 1 ; +enddef ; + +% let push_boundingbox = pushboundingbox ; % downward compatible +% let pop_boundingbox = popboundingbox ; % downward compatible + +vardef boundingbox primary p = + if (path p) or (picture p) : + llcorner p -- lrcorner p -- urcorner p -- ulcorner p + else : + origin + fi -- cycle +enddef; + +vardef innerboundingbox primary p = + top rt llcorner p -- + top lft lrcorner p -- + bot lft urcorner p -- + bot rt ulcorner p -- cycle +enddef; + +vardef outerboundingbox primary p = + bot lft llcorner p -- + bot rt lrcorner p -- + top rt urcorner p -- + top lft ulcorner p -- cycle +enddef; + +% def inner_boundingbox = innerboundingbox enddef ; +% def outer_boundingbox = outerboundingbox enddef ; +% +% vardef set_inner_boundingbox text q = % obsolete +% setbounds q to innerboundingbox q; +% enddef; +% +% vardef set_outer_boundingbox text q = % obsolete +% setbounds q to outerboundingbox q; +% enddef; + +% secondarydef a boundedto b = % will this cleanup ? +% hide(picture mfun_a_b ; mfun_a_b := a ; setbounds mfun_a_b to b;) +% mfun_a_b +% enddef ; + +%D Here are some special ones, cooked up in the process of Alan's mp-node +%D module: + +vardef boundingradius primary p = + if picture p : + max( + abs((llcorner p) shifted -center p), + abs((lrcorner p) shifted -center p), + abs((urcorner p) shifted -center p), + abs((ulcorner p) shifted -center p) + ) + elseif pen p : + boundingradius image(draw makepath p ;) + elseif path p : + boundingradius image(draw p ;) + fi +enddef ; + +vardef boundingcircle primary p = + fullcircle scaled 2boundingradius p shifted center p +enddef ; + +vardef boundingpoint@#(expr p) = + if picture p : % pen? + ( mfun_labxf@# *ulcorner p + + mfun_labyf@# *lrcorner p + +(1-mfun_labxf@#-mfun_labyf@#)*urcorner p) + elseif path p : + boundingpoint@#(image(draw p ;)) + %elseif pair p : + % p + %else : + % origin + fi +enddef ; + +permanent pushboundingbox, popboundingbox, boundingbox, innerboundingbox, outerboundingbox, + boundingradius, boundingcircle, boundingpoint ; + +%D Whatever: + +def mirrored primary a = + a scaled -1 +enddef ; + +primarydef a mirroredabout b = + (a shifted -b) scaled -1 shifted b +enddef ; + +permanent mirrored, mirroredabout ; + +%D Some missing functions can be implemented rather straightforward (thanks to Taco +%D and others): + +% oldpi := 3.14159265358979323846 ; % from <math.h> +pi := 3.14159265358979323846264338327950288419716939937510 ; % 50 digits +radian := 180/pi ; % 2pi*radian = 360 ; + +permanent pi, radian ; + +% let +++ = ++ ; + +vardef sqr primary x = x*x enddef ; +vardef log primary x = if x=0: 0 else: mlog(x)/mlog(10) fi enddef ; +vardef ln primary x = if x=0: 0 else: mlog(x)/256 fi enddef ; +vardef exp primary x = (mexp 256)**x enddef ; +vardef inv primary x = if x=0: 0 else: x**-1 fi enddef ; + +vardef pow (expr x,p) = x**p enddef ; + +vardef tand primary x = sind(x)/cosd(x) enddef ; +vardef cotd primary x = cosd(x)/sind(x) enddef ; + +% sin primary x = sind(x*radian) enddef ; +% cos primary x = cosd(x*radian) enddef ; +% tan primary x = sin(x)/cos(x) enddef ; +vardef cot primary x = cos(x)/sin(x) enddef ; + +% asin primary x = angle((1+-+x,x)) enddef ; +% acos primary x = angle((x,1+-+x)) enddef ; +% atan primary x = angle(1,x) enddef ; + +% invsin primary x = (asin(x))/radian enddef ; +% invcos primary x = (acos(x))/radian enddef ; +% invtan primary x = (atan(x))/radian enddef ; + +% acosh primary x = ln(x+(x+-+1)) enddef ; +% asinh primary x = ln(x+(x++1)) enddef ; + +% sinh primary x = save xx ; xx = exp x ; (xx-1/xx)/2 enddef ; +% cosh primary x = save xx ; xx = exp x ; (xx+1/xx)/2 enddef ; +% tanh primary x = save xx ; xx = exp x ; (xx-1/xx)/(xx+1/xx) enddef ; + +%D Like mod, but useful for angles, it returns (-.5d,+.5d] and is used +%D in for instance mp-chem. + +primarydef a zmod b = (-((b/2 - a) mod b) + b/2) enddef ; + +permanent sqr, log, ln, exp, inv, pow, tand, cotd, cot, zmod ; + +%D Sometimes this is handy: + +def undashed = + dashed nullpicture +enddef ; + +permanent undashed ; + +%D We provide two macros for drawing stripes across a shape. The first method (with the +%D n suffix) uses another method, slower in calculation, but more efficient when drawn. +%D The first macro divides the sides into n equal parts. The first argument specifies the +%D way the lines are drawn, while the second argument identifier the way the shape is to +%D be drawn. +%D +%D \starttyping +%D stripe_path_n +%D (dashed evenly withcolor blue) +%D (filldraw) +%D fullcircle xscaled 100 yscaled 40 shifted (50,50) withpen pencircle scaled 4; +%D \stoptyping +%D +%D The a (or angle) alternative supports arbitrary angles and is therefore more versatile. +%D +%D \starttyping +%D stripe_path_a +%D (withpen pencircle scaled 2 withcolor red) +%D (draw) +%D fullcircle xscaled 100 yscaled 40 withcolor blue; +%D \stoptyping +%D +%D We have two alternatives, controlled by arguments or defaults (when arguments are zero). +%D +%D The newer and nicer interface is used as follows (triggered by a question by Mari): +%D +%D \starttyping +%D draw image (draw fullcircle scaled 3cm shifted (0cm,0cm) withcolor green) numberstriped (1,10,3) withcolor red ; +%D draw image (draw fullcircle scaled 3cm shifted (3cm,0cm) withcolor green) numberstriped (2,20,3) withcolor green ; +%D draw image (draw fullcircle scaled 3cm shifted (3cm,3cm) withcolor green) numberstriped (3,10,5) withcolor blue ; +%D draw image (draw fullcircle scaled 3cm shifted (0cm,3cm) withcolor green) numberstriped (4,20,5) withcolor yellow ; +%D +%D draw image (draw fullcircle scaled 3cm shifted (6cm,0cm) withcolor green) anglestriped (1,20,2) withcolor red ; +%D draw image (draw fullcircle scaled 3cm shifted (9cm,0cm) withcolor green) anglestriped (2,40,2) withcolor green ; +%D draw image (draw fullcircle scaled 3cm shifted (9cm,3cm) withcolor green) anglestriped (3,60,2) withcolor blue ; +%D draw image (draw fullcircle scaled 3cm shifted (6cm,3cm) withcolor green) anglestriped (4,80,2) withcolor yellow ; +%D +%D draw image ( +%D draw fullcircle scaled 3cm shifted (0cm,0cm) withcolor green withpen pencircle scaled 2mm ; +%D draw fullcircle scaled 2cm shifted (0cm,1cm) withcolor blue withpen pencircle scaled 3mm ; +%D ) shifted (9cm,0cm) numberstriped (1,10,3) withcolor red ; +%D +%D draw image ( +%D draw fullcircle scaled 3cm shifted (0cm,0cm) withcolor green withpen pencircle scaled 2mm ; +%D draw fullcircle scaled 2cm shifted (0cm,1cm) withcolor blue withpen pencircle scaled 3mm ; +%D ) shifted (12cm,0cm) numberstriped (2,10,3) withcolor red ; +%D +%D draw image ( +%D draw fullcircle scaled 3cm shifted (0cm,0cm) withcolor green withpen pencircle scaled 2mm ; +%D draw fullcircle scaled 2cm shifted (0cm,1cm) withcolor blue withpen pencircle scaled 3mm ; +%D ) shifted (9cm,5cm) numberstriped (3,10,3) withcolor red ; +%D +%D draw image ( +%D draw fullcircle scaled 3cm shifted (0cm,0cm) withcolor green withpen pencircle scaled 2mm ; +%D draw fullcircle scaled 2cm shifted (0cm,1cm) withcolor blue withpen pencircle scaled 3mm ; +%D ) shifted (12cm,5cm) numberstriped (4,10,3) withcolor red ; +%D \stoptyping + +stripe_n := 10; +stripe_slot := 3; +stripe_gap := 5; +stripe_angle := 45; + +def mfun_tool_striped_number_action text extra = + for i = 1/used_n step 1/used_n until 1 : + draw point (1+i) of bounds -- point (3-i) of bounds withpen pencircle scaled penwidth extra ; + endfor ; + for i = 0 step 1/used_n until 1 : + draw point (3+i) of bounds -- point (1-i) of bounds withpen pencircle scaled penwidth extra ; + endfor ; +enddef ; + +def mfun_tool_striped_set_options(expr option) = + save isinner, swapped ; + boolean isinner, swapped ; + if option = 1 : + isinner := false ; + swapped := false ; + elseif option = 2 : + isinner := true ; + swapped := false ; + elseif option = 3 : + isinner := false ; + swapped := true ; + elseif option = 4 : + isinner := true ; + swapped := true ; + else : + isinner := false ; + swapped := false ; + fi ; +enddef ; + +vardef mfun_tool_striped_number(expr option, p, asked_n, asked_slot) text extra = + image ( + begingroup ; + save pattern, shape, bounds, penwidth, used_n, used_slot ; + picture pattern, shape ; path bounds ; numeric used_s, used_slot ; + mfun_tool_striped_set_options(option) ; + used_slot := if asked_slot = 0 : stripe_slot else : asked_slot fi ; + used_n := if asked_n = 0 : stripe_n else : asked_n fi ; + shape := image(draw p) ; + bounds := boundingbox shape ; + penwidth := min(ypart urcorner shape - ypart llcorner shape, xpart urcorner shape - xpart llcorner shape) / (used_slot * used_n) ; + pattern := image ( + if isinner : + mfun_tool_striped_number_action extra ; + for s within shape : + if stroked s or filled s : + clip currentpicture to pathpart s ; + fi + endfor ; + else : + for s within shape : + if stroked s or filled s : + draw image ( + mfun_tool_striped_number_action extra ; + clip currentpicture to pathpart s ; + ) ; + fi ; + endfor ; + fi ; + ) ; + if swapped : + addto currentpicture also shape ; + addto currentpicture also pattern ; + else : + addto currentpicture also pattern ; + addto currentpicture also shape ; + fi ; + endgroup ; + ) +enddef ; + +def mfun_tool_striped_angle_action text extra = + for i = minimum -.5used_gap step used_gap until maximum : + draw (minimum,i) -- (maximum,i) extra ; + endfor ; + currentpicture := currentpicture rotated used_angle ; +enddef ; + +vardef mfun_tool_striped_angle(expr option, p, asked_angle, asked_gap) text extra = + image ( + begingroup ; + save pattern, shape, mask, maximum, minimum, centrum, used_angle, used_gap ; + picture pattern, shape, mask ; numeric maximum, minimum ; pair centrum ; numeric used_angle, used_gap ; + mfun_tool_striped_set_options(option) ; + used_angle := if asked_angle = 0 : stripe_angle else : asked_angle fi ; + used_gap := if asked_gap = 0 : stripe_gap else : asked_gap fi ; + shape := image(draw p) ; + centrum := center shape ; + shape := shape shifted - centrum ; + mask := shape rotated used_angle ; + maximum := max (xpart llcorner mask, xpart urcorner mask, ypart llcorner mask, ypart urcorner mask) ; + minimum := min (xpart llcorner mask, xpart urcorner mask, ypart llcorner mask, ypart urcorner mask) ; + pattern := image ( + if isinner : + mfun_tool_striped_angle_action extra ; + for s within shape : + if stroked s or filled s : + clip currentpicture to pathpart s ; + fi + endfor ; + else : + for s within shape : + if stroked s or filled s : + draw image ( + mfun_tool_striped_angle_action extra ; + clip currentpicture to pathpart s ; + ) ; + fi ; + endfor ; + fi ; + ) ; + if swapped : + addto currentpicture also shape ; + addto currentpicture also pattern ; + else : + addto currentpicture also pattern ; + addto currentpicture also shape ; + fi ; + currentpicture := currentpicture shifted centrum ; + endgroup ; + ) +enddef; + +newinternal striped_normal_inner ; striped_normal_inner := 1 ; +newinternal striped_reverse_inner ; striped_reverse_inner := 2 ; +newinternal striped_normal_outer ; striped_normal_outer := 3 ; +newinternal striped_reverse_outer ; striped_reverse_outer := 4 ; + +secondarydef p anglestriped s = + mfun_tool_striped_angle(redpart s,p,greenpart s,bluepart s) +enddef ; + +secondarydef p numberstriped s = + mfun_tool_striped_number(redpart s,p,greenpart s,bluepart s) +enddef ; + +% for old times sake: + +def stripe_path_n (text asked_spec) (text asked_draw) expr asked_path = + do_stripe_path_n (asked_spec) (asked_draw) (asked_path) +enddef; + +def do_stripe_path_n (text asked_spec) (text asked_draw) (expr asked_path) text asked_text = + draw image(asked_draw asked_path asked_text) numberstriped(3,0,0) asked_spec ; +enddef ; + +def stripe_path_a (text asked_spec) (text asked_draw) expr asked_path = + do_stripe_path_a (asked_spec) (asked_draw) (asked_path) +enddef; + +def do_stripe_path_a (text asked_spec) (text asked_draw) (expr asked_path) text asked_text = + draw image(asked_draw asked_path asked_text) anglestriped(3,0,0) asked_spec ; +enddef ; + +%D A few normalizing macros: + +primarydef p xsized w = + (p if (bbwidth (p) > 0) and (w > 0) : scaled (w/bbwidth (p)) fi) +enddef ; + +primarydef p ysized h = + (p if (bbheight(p) > 0) and (h > 0) : scaled (h/bbheight(p)) fi) +enddef ; + +primarydef p xysized s = + begingroup + save wh, w, h ; pair wh ; numeric w, h ; + wh := paired (s) ; w := bbwidth(p) ; h := bbheight(p) ; + p + if (w>0) and (h>0) : + if xpart wh > 0 : xscaled (xpart wh/w) fi + if ypart wh > 0 : yscaled (ypart wh/h) fi + fi + endgroup +enddef ; + +let sized = xysized ; + +permanent xsized, ysized, xysized, sized ; + +% def xscale_currentpicture(expr w) = % obsolete +% currentpicture := currentpicture xsized w ; +% enddef; +% +% def yscale_currentpicture(expr h) = % obsolete +% currentpicture := currentpicture ysized h ; +% enddef; +% +% def xyscale_currentpicture(expr w, h) = % obsolete +% currentpicture := currentpicture xysized (w,h) ; +% enddef; +% +% def scale_currentpicture(expr w, h) = % obsolete +% currentpicture := currentpicture xsized w ; +% currentpicture := currentpicture ysized h ; +% enddef; + +%D A full circle is centered at the origin, while a unitsquare is located in the first +%D quadrant. Now guess what kind of path fullsquare and unitcircle do return. + +path fullsquare, unitcircle ; + +fullsquare := unitsquare shifted - center unitsquare ; +unitcircle := fullcircle shifted urcorner fullcircle ; + +%D Some more paths: + +path urcircle, ulcircle, llcircle, lrcircle ; + +urcircle := origin -- (+.5,0) & (+.5,0){up} .. (0,+.5) & (0,+.5) -- cycle ; +ulcircle := origin -- (0,+.5) & (0,+.5){left} .. (-.5,0) & (-.5,0) -- cycle ; +llcircle := origin -- (-.5,0) & (-.5,0){down} .. (0,-.5) & (0,-.5) -- cycle ; +lrcircle := origin -- (0,-.5) & (0,-.5){right} .. (+.5,0) & (+.5,0) -- cycle ; + +path tcircle, bcircle, lcircle, rcircle ; + +tcircle = origin -- (+.5,0) & (+.5,0) {up} .. (0,+.5) .. {down} (-.5,0) -- cycle ; +bcircle = origin -- (-.5,0) & (-.5,0) {down} .. (0,-.5) .. {up} (+.5,0) -- cycle ; +lcircle = origin -- (0,+.5) & (0,+.5) {left} .. (-.5,0) .. {right} (0,-.5) -- cycle ; +rcircle = origin -- (0,-.5) & (0,-.5) {right} .. (+.5,0) .. {left} (0,+.5) -- cycle ; + +path urtriangle, ultriangle, lltriangle, lrtriangle ; % watch out: it's contrary to what you expect and starts in the origin + +urtriangle := origin -- (+.5,0) -- (0,+.5) -- cycle ; +ultriangle := origin -- (0,+.5) -- (-.5,0) -- cycle ; +lltriangle := origin -- (-.5,0) -- (0,-.5) -- cycle ; +lrtriangle := origin -- (0,-.5) -- (+.5,0) -- cycle ; + +path triangle, uptriangle, downtriangle, lefttriangle, righttriangle ; + +triangle := (1,0) -- (1,0) rotated 120 -- (1,0) rotated -120 -- cycle ; + +uptriangle := triangle rotated 90 ; +downtriangle := triangle rotated -90 ; +lefttriangle := triangle rotated 180 ; +righttriangle := triangle ; + +path unitdiamond, fulldiamond ; + +unitdiamond := (.5,0) -- (1,.5) -- (.5,1) -- (0,.5) -- cycle ; +fulldiamond := unitdiamond shifted - center unitdiamond ; + +permanent + fullsquare, unitcircle, + urcircle, ulcircle, llcircle, lrcircle, + tcircle, bcircle, lcircle, rcircle, + urtriangle, ultriangle, lltriangle, lrtriangle, + triangle, uptriangle, downtriangle, lefttriangle, righttriangle, + unitdiamond, fulldiamond ; + +%D More robust: + +% let normalscaled = scaled ; +% let normalxscaled = xscaled ; +% let normalyscaled = yscaled ; +% +% def scaled expr s = normalscaled (s) enddef ; +% def xscaled expr s = normalxscaled (s) enddef ; +% def yscaled expr s = normalyscaled (s) enddef ; + +%D Shorter + +primarydef p xyscaled q = % secundarydef does not work out well + begingroup + save qq ; pair qq ; + qq = paired(q) ; + p + if xpart qq <> 0 : xscaled (xpart qq) fi + if ypart qq <> 0 : yscaled (ypart qq) fi + endgroup +enddef ; + +permanent xyscaled ; + +%D Some personal code that might move to another module (todo: save). + +def set_grid(expr w, h, nx, ny) = + boolean grid[][] ; boolean grid_full ; + numeric grid_w, grid_h, grid_nx, grid_ny, grid_x, grid_y, grid_left ; + grid_w := w ; + grid_h := h ; + grid_nx := nx ; + grid_ny := ny ; + grid_x := round(w/grid_nx) ; % +.5) ; + grid_y := round(h/grid_ny) ; % +.5) ; + grid_left := (1+grid_x)*(1+grid_y) ; + grid_full := false ; + for i=0 upto grid_x : + for j=0 upto grid_y : + grid[i][j] := false ; + endfor ; + endfor ; +enddef ; + +vardef new_on_grid(expr grid_dx, grid_dy) = + dx := grid_dx ; + dy := grid_dy ; + ddx := min(round(dx/grid_nx),grid_x) ; % +.5),grid_x) ; + ddy := min(round(dy/grid_ny),grid_y) ; % +.5),grid_y) ; + if not grid_full and not grid[ddx][ddy] : + grid[ddx][ddy] := true ; + grid_left := grid_left-1 ; + grid_full := (grid_left=0) ; + true + else : + false + fi +enddef ; + +%D usage: \type{innerpath peepholed outerpath}. +%D +%D beginfig(1); +%D def fullsquare = (unitsquare shifted -center unitsquare) enddef ; +%D fill (fullsquare scaled 200) withcolor red ; +%D path p ; p := (fullcircle scaled 100) ; bboxmargin := 0 ; +%D fill p peepholed bbox p ; +%D endfig; + +secondarydef p peepholed q = + begingroup + save start ; pair start ; + start := point 0 of p ; + if xpart start >= xpart center p : + if ypart start >= ypart center p : + urcorner q -- ulcorner q -- llcorner q -- lrcorner q -- + reverse p -- lrcorner q -- cycle + else : + lrcorner q -- urcorner q -- ulcorner q -- llcorner q -- + reverse p -- llcorner q -- cycle + fi + else : + if ypart start > ypart center p : + ulcorner q -- llcorner q -- lrcorner q -- urcorner q -- + reverse p -- urcorner q -- cycle + else : + llcorner q -- lrcorner q -- urcorner q -- ulcorner q -- + reverse p -- ulcorner q -- cycle + fi + fi + endgroup +enddef ; + +newinternal boolean intersection_found ; + +secondarydef p intersection_point q = + begingroup + save temp_x, temp_y ; + (temp_x,temp_y) = p intersectiontimes q ; + if temp_x < 0 : + intersection_found := false ; + center p % origin + else : + intersection_found := true ; + .5[point temp_x of p, point temp_y of q] + fi + endgroup +enddef ; + +permanent intersection_found, intersection_point ; + +%D New, undocumented, experimental: + +vardef tensecircle (expr width, height, offset) = + (-width/2,-height/2) ... (0,-height/2-offset) ... + (+width/2,-height/2) ... (+width/2+offset,0) ... + (+width/2,+height/2) ... (0,+height/2+offset) ... + (-width/2,+height/2) ... (-width/2-offset,0) ... cycle +enddef ; + +vardef roundedsquare (expr width, height, offset) = + (offset,0) -- (width-offset,0) {right} .. + (width,offset) -- (width,height-offset) {up} .. + (width-offset,height) -- (offset,height) {left} .. + (0,height-offset) -- (0,offset) {down} .. cycle +enddef ; + +vardef roundedsquarexy (expr width, height, dx, dy) = + (dx,0) -- (width-dx,0) {right} .. + (width,dy) -- (width,height-dy) {up} .. + (width-dx,height) -- (dx,height) {left} .. + (0,height-dy) -- (0,dy) {down} .. cycle +enddef ; + +permanent tensecircle, roundedsquare, roundedsquarexy ; + +%D Some colors. + +def resolvedcolor(expr s) = + .5white +enddef ; + +let normalwithcolor = withcolor ; + +def withcolor expr c = + normalwithcolor if string c : resolvedcolor(c) else : c fi +enddef ; + +permanent resolvedcolor, normalwithcolor, withcolor ; + +% I don't want a "withcolor black" in case of an empty string ... who knows how that can +% interfere with outer colors. Somehow the next one doesn't always work out ok, but why +% ... must be some parsing issue. Anyway, when we cannot do that, we need to fix some +% chem macros instead as empty strings now lead to black while everywhere else in context +% empty means: leave color untouched. + +% def withcolor expr c = +% if not string c : +% normalwithcolor c +% elseif c <> "" : +% normalwithcolor resolvedcolor(c) +% fi +% enddef ; + +% So why does this work better than the above: +% +% def withcolor expr c = +% if string c : +% if c <> "" : +% normalwithcolor resolvedcolor(c) +% fi +% else : +% normalwithcolor c +% fi +% enddef ; + +vardef colortype expr c = + if cmykcolor c : cmykcolor + elseif rgbcolor c : rgbcolor + elseif numeric c : grayscale + fi +enddef ; + +vardef whitecolor expr c = + if cmykcolor c : (0,0,0,0) + elseif rgbcolor c : (1,1,1) + elseif numeric c : 1 + elseif string c : whitecolor resolvedcolor(c) + fi +enddef ; + +vardef blackcolor expr c = + if cmykcolor c : (0,0,0,1) + elseif rgbcolor c : (0,0,0) + elseif numeric c : 0 + elseif string c : blackcolor resolvedcolor(c) + fi +enddef ; + +vardef complementary expr c = + if cmykcolor c : (1,1,1,1) - c + elseif rgbcolor c : (1,1,1) - c + elseif pair c : (1,1) - c + elseif numeric c : 1 - c + elseif string c : complementary resolvedcolor(c) + fi +enddef ; + +vardef complemented expr c = + save m ; + if cmykcolor c : m := max(cyanpart c, magentapart c, yellowpart c, blackpart c) ; + (m,m,m,m) - c + elseif rgbcolor c : m := max(redpart c, greenpart c, bluepart c) ; + (m,m,m) - c + elseif pair c : m := max(xpart c, ypart c) ; + (m,m) - c + elseif numeric c : m - c + elseif string c : complemented resolvedcolor(c) + fi +enddef ; + +permanent colortype, whitecolor, blackcolor, complementary, complemented ; + +%D Well, this is the dangerous and naive version: + +% def drawfill text t = +% fill t ; +% draw t ; +% enddef; + +%D This two step approach saves the path first, since it can be a function. Attributes +%D must not be randomized. + +def drawfill expr c = + path temp_c ; temp_c := c ; + mfun_do_drawfill +enddef ; + +def mfun_do_drawfill text t = + draw temp_c t ; + fill temp_c t ; +enddef; + +def undrawfill expr c = + drawfill c withcolor background % rather useless +enddef ; + +permanent drawfill, undrawfill ; + +%D Moved from mp-char.mp + +vardef paired primary d = + if pair d : d else : (d,d) fi +enddef ; + +vardef tripled primary d = + if color d : d else : (d,d,d) fi +enddef ; + +permanent paired, tripled ; + +% maybe secondaries: + +primarydef p enlarged d = ( p llmoved d -- p lrmoved d -- p urmoved d -- p ulmoved d -- cycle ) enddef ; +primarydef p llenlarged d = ( p llmoved d -- lrcorner p -- urcorner p -- ulcorner p -- cycle ) enddef ; +primarydef p lrenlarged d = ( llcorner p -- p lrmoved d -- urcorner p -- ulcorner p -- cycle ) enddef ; +primarydef p urenlarged d = ( llcorner p -- lrcorner p -- p urmoved d -- ulcorner p -- cycle ) enddef ; +primarydef p ulenlarged d = ( llcorner p -- lrcorner p -- urcorner p -- p ulmoved d -- cycle ) enddef ; + +primarydef p llmoved d = ( (llcorner p) shifted (-xpart paired(d),-ypart paired(d)) ) enddef ; +primarydef p lrmoved d = ( (lrcorner p) shifted (+xpart paired(d),-ypart paired(d)) ) enddef ; +primarydef p urmoved d = ( (urcorner p) shifted (+xpart paired(d),+ypart paired(d)) ) enddef ; +primarydef p ulmoved d = ( (ulcorner p) shifted (-xpart paired(d),+ypart paired(d)) ) enddef ; + +primarydef p leftenlarged d = ( (llcorner p) shifted (-d,0) -- lrcorner p -- urcorner p -- (ulcorner p) shifted (-d,0) -- cycle ) enddef ; +primarydef p rightenlarged d = ( llcorner p -- (lrcorner p) shifted (d,0) -- (urcorner p) shifted (d,0) -- ulcorner p -- cycle ) enddef ; +primarydef p topenlarged d = ( llcorner p -- lrcorner p -- (urcorner p) shifted (0,d) -- (ulcorner p) shifted (0,d) -- cycle ) enddef ; +primarydef p bottomenlarged d = ( llcorner p shifted (0,-d) -- lrcorner p shifted (0,-d) -- urcorner p -- ulcorner p -- cycle ) enddef ; + + +permanent + enlarged, llenlarged, lrenlarged, urenlarged, ulenlarged, + llmoved, lrmoved, urmoved, ulmoved, + leftenlarged, rightenlarged, topenlarged, bottomenlarged ; + +%D Handy as stepper: + +vardef rotation(expr i, n) = + if (n == 0) : 0 else : i * 360 / n fi +enddef ; + + +permanent rotation ; + +%D Handy for testing/debugging; the ladders are for math: + +primarydef p crossed d = ( + if pair p : + p shifted (-d, 0) -- p -- + p shifted ( 0,-d) -- p -- + p shifted (+d, 0) -- p -- + p shifted ( 0,+d) -- p -- cycle + else : + center p shifted (-d, 0) -- llcorner p -- + center p shifted ( 0,-d) -- lrcorner p -- + center p shifted (+d, 0) -- urcorner p -- + center p shifted ( 0,+d) -- ulcorner p -- cycle + fi +) enddef ; + +vardef laddered primary p = % was expr + point 0 of p + for i=1 upto length(p) : + -- (xpart (point i of p), ypart (point (i-1) of p)) -- (point i of p) + endfor +enddef ; + +permanent crossed, laddered ; + +%D Saves typing: + +% vardef bottomboundary primary p = (llcorner p -- lrcorner p) enddef ; +% vardef rightboundary primary p = (lrcorner p -- urcorner p) enddef ; +% vardef topboundary primary p = (urcorner p -- ulcorner p) enddef ; +% vardef leftboundary primary p = (ulcorner p -- llcorner p) enddef ; + +vardef bottomboundary primary p = if pair p : p else : (llcorner p -- lrcorner p) fi enddef ; +vardef rightboundary primary p = if pair p : p else : (lrcorner p -- urcorner p) fi enddef ; +vardef topboundary primary p = if pair p : p else : (urcorner p -- ulcorner p) fi enddef ; +vardef leftboundary primary p = if pair p : p else : (ulcorner p -- llcorner p) fi enddef ; + +permanent bottomboundary, rightboundary, topboundary, leftboundary ; + +%D Nice too: + +primarydef p superellipsed s = + superellipse ( + .5[lrcorner p,urcorner p], + .5[urcorner p,ulcorner p], + .5[ulcorner p,llcorner p], + .5[llcorner p,lrcorner p], + s + ) +enddef ; + +primarydef p squeezed s = ( + (llcorner p .. .5[llcorner p,lrcorner p] shifted ( 0, ypart paired(s)) .. lrcorner p) & + (lrcorner p .. .5[lrcorner p,urcorner p] shifted (-xpart paired(s), 0) .. urcorner p) & + (urcorner p .. .5[urcorner p,ulcorner p] shifted ( 0,-ypart paired(s)) .. ulcorner p) & + (ulcorner p .. .5[ulcorner p,llcorner p] shifted ( xpart paired(s), 0) .. llcorner p) & cycle +) enddef ; + +primarydef p randomshifted s = + begingroup ; + save ss ; pair ss ; + ss := paired(s) ; + p shifted (-.5xpart ss + uniformdeviate xpart ss,-.5ypart ss + uniformdeviate ypart ss) + endgroup +enddef ; + +vardef mfun_randomized_path(expr p,s) = + for i=0 upto length(p)-1 : + (point i of p) .. controls + ((postcontrol i of p) randomshifted s) and + ((precontrol (i+1) of p) randomshifted s) .. + endfor + if cycle p : + cycle + else : + (point length(p) of p) + fi +enddef; + +vardef mfun_randomized_picture(expr p,s)(text rnd) = + save currentpicture ; + picture currentpicture ; + currentpicture := nullpicture ; + for i within p : + addto currentpicture + if stroked i : + doublepath pathpart i rnd s + dashed dashpart i + withpen penpart i + withcolor colorpart i + withprescript prescriptpart i + withpostscript postscriptpart i + elseif filled i : + contour pathpart i rnd s + withpen penpart i + withcolor colorpart i + withprescript prescriptpart i + withpostscript postscriptpart i + else : + also i + fi + ; + endfor ; + currentpicture +enddef ; + +primarydef p randomizedcontrols s = ( + if path p : + mfun_randomized_path(p,s) + elseif picture p : + mfun_randomized_picture(p,s)(randomizedcontrols) + else : + p randomized s + fi +) enddef ; + +primarydef p randomized s = ( + if path p : + for i=0 upto length(p)-1 : + ((point i of p) randomshifted s) .. controls + ((postcontrol i of p) randomshifted s) and + ((precontrol (i+1) of p) randomshifted s) .. + endfor + if cycle p : + cycle + else : + ((point length(p) of p) randomshifted s) + fi + elseif pair p : + p randomshifted s + elseif cmykcolor p : + if cmykcolor s : + ((uniformdeviate cyanpart s) * cyanpart p, + (uniformdeviate magentapart s) * magentapart p, + (uniformdeviate yellowpart s) * yellowpart p, + (uniformdeviate blackpart s) * blackpart p) + elseif pair s : + ((xpart s + (uniformdeviate (ypart s - xpart s))) * p) + else : + ((uniformdeviate s) * p) + fi + elseif rgbcolor p : + if rgbcolor s : + ((uniformdeviate redpart s) * redpart p, + (uniformdeviate greenpart s) * greenpart p, + (uniformdeviate bluepart s) * bluepart p) + elseif pair s : + ((xpart s + (uniformdeviate (ypart s - xpart s))) * p) + else : + ((uniformdeviate s) * p) + fi + elseif color p : + if color s : + ((uniformdeviate greypart s) * greypart p) + elseif pair s : + ((xpart s + (uniformdeviate (ypart s - xpart s))) * p) + else : + ((uniformdeviate s) * p) + fi + elseif string p : + (resolvedcolor(p)) randomized s + elseif picture p : + mfun_randomized_picture(p,s)(randomized) + else : + % p - s/2 + uniformdeviate s % would have been better but we want to be positive + p + uniformdeviate s + fi +) enddef ; + +permanent superellipsed, squeezed, randomshifted, randomized, randomizedcontrols ; + +%D Not perfect (alternative for interpath) + +vardef interpolated(expr s, p, q) = + save m ; numeric m ; + m := max(length(p),length(q)) ; + if path p : + for i=0 upto m-1 : + s[point (i /m) along p,point (i /m) along q] .. controls + s[postcontrol (i /m) along p,postcontrol (i /m) along q] and + s[precontrol ((i+1)/m) along p,precontrol ((i+1)/m) along q] .. + endfor + if cycle p : + cycle + else : + s[point infinity of p,point infinity of q] + fi + else : + a[p,q] + fi +enddef ; + +permanent interpolated ; + +%D Interesting too: + +% primarydef p paralleled d = ( +% p shifted if d < 0 : - fi ((point abs(d) on (p rotatedaround(point 0 of p,90))) - point 0 of p) +% ) enddef ; +% +% primarydef p paralleled d = ( +% p shifted ((d*unitvector(direction 0 of p) - point 0 of p) rotated 90) +% ) enddef ; + +%D Alan came up with an improved version and stepwise we ended up with (or might up +%D with a variant of): + +def istextext(expr p) = + (picture p and ((substring(0,3) of prescriptpart p) = "tx_")) +enddef ; + +vardef perpendicular expr t of p = + unitvector((direction t of p) rotated 90) +enddef ; + +primarydef p paralleled d = ( + if path p : + begingroup ; + save dp ; pair dp ; + for i=0 upto length p if cycle p : -1 fi : + hide(dp := d * perpendicular i of p) + if i > 0 : .. fi + (point i of p + dp) + if i < length p : + .. controls (postcontrol i of p + dp) and + (precontrol (i+1) of p + dp) + fi + endfor + if cycle p : .. cycle fi + endgroup + elseif picture p : + image( + for i within p : + draw (pathpart i) + if not istextext(i) : % dirty trick + paralleled d + fi + mfun_decoration_i i ; + endfor ; + ) + elseif pair p : + p + fi +) enddef ; + +vardef punked primary p = + point 0 of p for i=1 upto length(p)-1 : -- point i of p endfor + if cycle p : -- cycle else : -- point length(p) of p fi +enddef ; + +vardef curved primary p = + point 0 of p for i=1 upto length(p)-1 : .. point i of p endfor + if cycle p : .. cycle else : .. point length(p) of p fi +enddef ; + +primarydef p blownup s = + begingroup + save temp_p ; path temp_p ; + temp_p := p xysized (bbwidth(p)+2(xpart paired(s)),bbheight(p)+2(ypart paired(s))) ; + (temp_p shifted (center p - center temp_p)) + endgroup +enddef ; + +permanent perpendicular, istextext, paralleled, punked, curved, blownup ; + +%D Rather fundamental. + +% not yet ok + +vardef mfun_left_right_path(expr p, l) = % used in s-pre-19 + save q, r, t, b ; path q, r ; pair t, b ; + t := (ulcorner p -- urcorner p) intersection_point p ; + b := (llcorner p -- lrcorner p) intersection_point p ; + r := if xpart directionpoint t of p < 0 : reverse p else : p fi ; % r is needed, else problems when reverse is fed + q := r cutbefore if l: t else: b fi ; + q := q if xpart point 0 of r > 0 : & r fi cutafter if l: b else: t fi ; + q +enddef ; + +vardef leftpath expr p = mfun_left_right_path(p,true ) enddef ; +vardef rightpath expr p = mfun_left_right_path(p,false) enddef ; + +permanent leftpath, rightpath ; + +%D Drawoptions + +def saveoptions = + save base_draw_options ; def base_draw_options = enddef ; +enddef ; + +permanent saveoptions ; + +%D Tracing. (not yet in lexer) + +let normaldraw = draw ; +let normalfill = fill ; + +% bugged in mplib so ... + +def normalfill expr c = addto currentpicture contour c base_draw_options enddef ; +def normaldraw expr p = addto currentpicture if picture p: also p else: doublepath p withpen currentpen fi base_draw_options enddef ; + +def drawlineoptions (text t) = def mfun_opt_lin = t enddef ; enddef ; +def drawpointoptions (text t) = def mfun_opt_pnt = t enddef ; enddef ; +def drawcontroloptions(text t) = def mfun_opt_ctr = t enddef ; enddef ; +def drawlabeloptions (text t) = def mfun_opt_lab = t enddef ; enddef ; +def draworiginoptions (text t) = def mfun_opt_ori = t enddef ; enddef ; +def drawboundoptions (text t) = def mfun_opt_bnd = t enddef ; enddef ; +def drawpathoptions (text t) = def mfun_opt_pth = t enddef ; enddef ; + +numeric drawoptionsfactor ; drawoptionsfactor := pt ; + +def resetdrawoptions = + drawlineoptions (withpen pencircle scaled 1.0 drawoptionsfactor withcolor .5white) ; + drawpointoptions (withpen pencircle scaled 4.0 drawoptionsfactor withcolor black) ; + drawcontroloptions(withpen pencircle scaled 2.5 drawoptionsfactor withcolor black) ; + drawlabeloptions () ; + draworiginoptions (withpen pencircle scaled 1.0 drawoptionsfactor withcolor .5white) ; + drawboundoptions (dashed evenly mfun_opt_ori) ; + drawpathoptions (withpen pencircle scaled 5.0 drawoptionsfactor withcolor .8white) ; +enddef ; + +resetdrawoptions ; + +%D Path. + +def drawpath expr p = + normaldraw p mfun_opt_pth +enddef ; + +permanent + drawlineoptions, drawpointoptions, drawcontroloptions, drawlabeloptions, draworiginoptions, + drawboundoptions, drawpathoptions, drawpath, normaldraw ; + +%D Arrow. + +newinternal ahvariant ; ahvariant := 0 ; +newinternal ahdimple ; ahdimple := 1/5 ; +newinternal ahscale ; ahscale := 3/4 ; + +permanent ahvariant, ahdimple, ahscale ; + +vardef arrowhead expr p = + save q, e, r ; + pair e ; e = point length p of p ; + path q ; q = gobble(p shifted -e cutafter makepath(pencircle scaled (2ahlength))) cuttings ; + if ahvariant > 0: + path r ; r = gobble(p shifted -e cutafter makepath(pencircle scaled ((1-ahdimple)*2ahlength))) cuttings ; + fi + (q rotated (ahangle/2) & reverse q rotated -(ahangle/2) + if ahvariant = 1 : + -- point 0 of r -- + elseif ahvariant = 2 : + ... point 0 of r ... + else : + -- + fi + cycle + ) shifted e +enddef ; + +vardef drawarrowpath expr p = +% save autoarrows ; boolean autoarrows ; autoarrows := true ; + interim autoarrows := true ; + drawarrow p mfun_opt_pth +enddef ; + +def midarrowhead expr p = + arrowhead p cutafter (point length(p cutafter point .5 along p) + ahlength on p) +enddef ; + +vardef arrowheadonpath (expr p, s) = +% save autoarrows ; boolean autoarrows ; + interim autoarrows := true ; + set_ahlength(scaled ahfactor) ; % added + arrowhead p if s < 1 : cutafter (point (s*arclength(p) + (ahlength/2)) on p) fi +enddef ; + +def resetarrows = + hide ( + ahlength := 4 ; + ahangle := 45 ; + ahvariant := 0 ; + ahdimple := 1/5 ; + ahscale := 3/4 ; +) +enddef ; + +permanent arrowhead, drawarrowpath, midarrowhead, arrowheadonpath ; + +%D Points. + +vardef dotlabel@#(expr s,z) text t = + label@#(s,z) t ; + interim linecap := rounded ; + normaldraw z withpen pencircle scaled dotlabeldiam t ; +enddef ; + +def drawpoint expr c = + if string c : + string temp_c ; + temp_c := "(" & c & ")" ; + dotlabel.urt(temp_c, scantokens temp_c) ; + drawdot scantokens temp_c + else : + dotlabel.urt("(" & decimal xpart c & "," & decimal ypart c & ")", c) ; + drawdot c + fi mfun_opt_pnt +enddef ; + +%D PathPoints. + +def drawpoints expr c = path temp_c ; temp_c := c ; mfun_draw_points enddef ; +def drawcontrolpoints expr c = path temp_c ; temp_c := c ; mfun_draw_controlpoints enddef ; +def drawcontrollines expr c = path temp_c ; temp_c := c ; mfun_draw_controllines enddef ; +def drawpointlabels expr c = path temp_c ; temp_c := c ; mfun_draw_pointlabels enddef ; + +def mfun_draw_points text t = + for i=0 upto length(temp_c) if cycle temp_c : -1 fi : + normaldraw point i of temp_c mfun_opt_pnt t ; + endfor ; +enddef; + +def mfun_draw_controlpoints text t = + for i=0 upto length(temp_c) : + normaldraw precontrol i of temp_c mfun_opt_ctr t ; + normaldraw postcontrol i of temp_c mfun_opt_ctr t ; + endfor ; +enddef; + +def mfun_draw_controllines text t = + for i=0 upto length(temp_c) : + normaldraw point i of temp_c -- precontrol i of temp_c mfun_opt_lin t ; + normaldraw point i of temp_c -- postcontrol i of temp_c mfun_opt_lin t ; + endfor ; +enddef; + +boolean swappointlabels ; swappointlabels := false ; +numeric pointlabelscale ; pointlabelscale := 0 ; +string pointlabelfont ; pointlabelfont := "" ; + +def mfun_draw_pointlabels text asked_options = + for i=0 upto length(temp_c) if cycle temp_c : -1 fi : + pair temp_u ; temp_u := unitvector(direction i of temp_c) rotated if swappointlabels : - fi 90 ; + pair temp_p ; temp_p := (point i of temp_c) ; + begingroup ; + if pointlabelscale > 0 : + save defaultscale ; numeric defaultscale ; + defaultscale := pointlabelscale ; + fi ; + if pointlabelfont <> "" : + save defaultfont ; string defaultfont ; + defaultfont := pointlabelfont ; + fi ; + temp_u := 10 * drawoptionsfactor * defaultscale * temp_u ; + normaldraw thelabel ( decimal i, temp_p shifted if cycle temp_c and (i=0) : - fi temp_u ) mfun_opt_lab asked_options ; + endgroup ; + endfor ; +enddef; + +%D Bounding box. + +def drawboundingbox expr p = + normaldraw boundingbox p mfun_opt_bnd +enddef ; + +%D Origin. + +numeric originlength ; originlength := .5cm ; + +def draworigin text t = + normaldraw (origin shifted (0, originlength) -- origin shifted (0,-originlength)) mfun_opt_ori t ; + normaldraw (origin shifted ( originlength,0) -- origin shifted (-originlength,0)) mfun_opt_ori t ; +enddef; + +permanent dotlabel, swappointlabels, pointlabelscale, pointlabelfont ; +permanent drawboundingbox, drawpoints, drawcontrolpoints, drawcontrollines, drawpointlabels, draworigin ; + +%D Axis. + +numeric tickstep ; tickstep := 5mm ; +numeric ticklength ; ticklength := 2mm ; + +def drawxticks expr c = path temp_c ; temp_c := c ; mfun_draw_xticks enddef ; +def drawyticks expr c = path temp_c ; temp_c := c ; mfun_draw_yticks enddef ; +def drawticks expr c = path temp_c ; temp_c := c ; mfun_draw_ticks enddef ; + +% Adding eps prevents disappearance due to rounding errors. + +def mfun_draw_xticks text t = + for i=0 step -tickstep until xpart llcorner temp_c - eps : + if (i<=xpart lrcorner temp_c) : + normaldraw (i,-ticklength)--(i,ticklength) mfun_opt_ori t ; + fi ; + endfor ; + for i=0 step tickstep until xpart lrcorner temp_c + eps : + if (i>=xpart llcorner temp_c) : + normaldraw (i,-ticklength)--(i,ticklength) mfun_opt_ori t ; + fi ; + endfor ; + normaldraw (llcorner temp_c -- ulcorner temp_c) shifted (-xpart llcorner temp_c,0) mfun_opt_ori t ; +enddef ; + +def mfun_draw_yticks text t = + for i=0 step -tickstep until ypart llcorner temp_c - eps : + if (i<=ypart ulcorner temp_c) : + normaldraw (-ticklength,i)--(ticklength,i) mfun_opt_ori t ; + fi ; + endfor ; + for i=0 step tickstep until ypart ulcorner temp_c + eps : + if (i>=ypart llcorner temp_c) : + normaldraw (-ticklength,i)--(ticklength,i) mfun_opt_ori t ; + fi ; + endfor ; + normaldraw (llcorner temp_c -- lrcorner temp_c) shifted (0,-ypart llcorner temp_c) mfun_opt_ori t ; +enddef ; + +def mfun_draw_ticks text t = + drawxticks temp_c t ; + drawyticks temp_c t ; +enddef ; + +%D All of it except axis. + +def drawwholepath expr p = + draworigin ; + drawpath p ; + drawcontrollines p ; + drawcontrolpoints p ; + drawpoints p ; + drawboundingbox p ; + drawpointlabels p ; +enddef ; + +def drawpathonly expr p = + drawpath p ; + drawcontrollines p ; + drawcontrolpoints p ; + drawpoints p ; + drawpointlabels p ; +enddef ; + +%D Tracing. + +def visualizeddraw expr c = + if picture c : normaldraw c else : path temp_c ; temp_c := c ; do_visualizeddraw fi +enddef ; + +def visualizedfill expr c = + if picture c : normalfill c else : path temp_c ; temp_c := c ; do_visualizedfill fi +enddef ; + +def do_visualizeddraw text t = + draworigin ; + drawpath temp_c t ; + drawcontrollines temp_c ; + drawcontrolpoints temp_c ; + drawpoints temp_c ; + drawboundingbox temp_c ; + drawpointlabels temp_c ; +enddef ; + +def do_visualizedfill text t = + if cycle temp_c : normalfill temp_c t fi ; + draworigin ; + drawcontrollines temp_c ; + drawcontrolpoints temp_c ; + drawpoints temp_c ; + drawboundingbox temp_c ; + drawpointlabels temp_c ; +enddef ; + +def detaileddraw expr c = + if picture c : normaldraw c else : path temp_c ; temp_c := c ; do_detaileddraw fi +enddef ; + +def do_detaileddraw text t = + drawpath temp_c t ; + drawcontrollines temp_c ; + drawcontrolpoints temp_c ; + drawpoints temp_c ; + % % for labels we need an third run (as the second will mark the numbers); i could preroll them + % % but then the hash needs to handle that as well (as now we keep numbering) + % drawpointlabels temp_c ; +enddef ; + +def visualizepaths = + let fill = visualizedfill ; + let draw = visualizeddraw ; +enddef ; + +def detailpaths = + let draw = detaileddraw ; +enddef ; + +def naturalizepaths = + let fill = normalfill ; + let draw = normaldraw ; +enddef ; + +extra_endfig := extra_endfig & " naturalizepaths ; " ; + +permanent + visualizeddraw, detaileddraw, visualizedfill, + visualizepaths, detailpaths, naturalizepaths ; + +%D Nice tracer: + +def drawboundary primary p = + draw p dashed evenly withcolor white ; + draw p dashed oddly withcolor black ; + draw (- llcorner p) withpen pencircle scaled 3 withcolor white ; + draw (- llcorner p) withpen pencircle scaled 1.5 withcolor black ; +enddef ; + +permanent drawboundary ; + +%D Also handy: + +extra_beginfig := extra_beginfig & " truecorners := 0 ; " ; % restores +extra_beginfig := extra_beginfig & " miterlimit := 10 ; " ; % restores +extra_beginfig := extra_beginfig & " linejoin := rounded ; " ; % restores +extra_beginfig := extra_beginfig & " linecap := rounded ; " ; % restores + +%D Normally, arrowheads don't scale well. So we provide a hack. + +% boolean autoarrows ; autoarrows := false ; % todo: newinternal boolean autoarrows ; +numeric ahfactor ; ahfactor := 2.5 ; % todo: newinternal ahfactor ; + +newinternal boolean autoarrows ; + +permanent ahfactor, ahlength, autoarrows ; + +def set_ahlength (text t) = % called to often + % ahlength := (ahfactor*pen_size(base_draw_options t)) ; % base_draw_options added + % problem: base_draw_options can contain color so a no-go, we could apply the transform + % but i need to figure out the best way (fakepicture and take components). + ahlength := (ahfactor*pen_size(t)) ; +enddef ; + +vardef pen_size (text t) = + save p ; picture p ; p := nullpicture ; + addto p doublepath (top origin -- bot origin) t ; + (ypart urcorner p - ypart lrcorner p) +enddef ; + +%D The next two macros are adapted versions of plain +%D \METAPOST\ definitions. + +vardef arrowpath expr p = % patch by Peter Rolf: supports squared pen and shifting (hh: maybe just use center of head as first) + (p cutafter makepath(pencircle + scaled (if ahvariant > 0 : (1-ahdimple)* fi 2ahlength*cosd(ahangle/2)) + shifted point length p of p + )) +enddef; + +permanent arrowpath ; + +% New experimental extension: also handling pictures: +% +% drawarrow fullsquare scaled 2cm withcolor green ; +% drawarrow fullcircle scaled 3cm withcolor green ; +% drawarrow image ( +% draw fullsquare scaled 4cm withcolor red ; +% draw fullcircle scaled 5cm withcolor blue ; +% ) ; +% currentpicture := currentpicture shifted (-bbwidth(currentpicture)-1cm,0) ; +% drawdblarrow fullsquare scaled 2cm withcolor green ; +% drawdblarrow fullcircle scaled 3cm withcolor green ; +% drawdblarrow image ( +% draw fullsquare scaled 4cm withcolor red ; +% draw fullcircle scaled 5cm withcolor blue ; +% ) ; + +vardef stroked_paths(expr p) = + save n ; numeric n ; n := 0 ; + for i within p : + if stroked i : + n := n + 1 ; + fi + endfor ; + n +enddef ; + +def mfun_decoration_i expr i = + withpen penpart i + withcolor colorpart i + withprescript prescriptpart i + withpostscript postscriptpart i +enddef ; + +%D We could collapse all in one helper but in context we nowaways don't want the added +%D obscurity. Tokens come cheap. + +numeric mfun_arrow_snippets ; +numeric mfun_arrow_count ; + +def drawarrow expr p = + begingroup ; + save mfun_arrow_path ; + path mfun_arrow_path ; + if path p : + mfun_arrow_path := p ; + expandafter mfun_draw_arrow_path + elseif picture p : + save mfun_arrow_picture ; + picture mfun_arrow_picture ; + mfun_arrow_picture := p ; + expandafter mfun_draw_arrow_picture + else : + expandafter mfun_draw_arrow_nothing + fi +enddef ; + +def drawdblarrow expr p = + begingroup ; + save mfun_arrow_path ; + path mfun_arrow_path ; + if path p : + mfun_arrow_path := p ; + expandafter mfun_draw_arrow_path_double + elseif picture p : + save mfun_arrow_picture ; + picture mfun_arrow_picture ; + mfun_arrow_picture := p ; + expandafter mfun_draw_arrow_picture_double + else : + expandafter mfun_draw_arrow_nothing + fi +enddef ; + +def mfun_draw_arrow_nothing text t = +enddef ; + +%D The path is shortened so that the arrow head extends it to the original length. In +%D case of a double arrow the path gets shortened twice. + +def mfun_draw_arrow_path text t = + if autoarrows : + set_ahlength(t) ; + fi + draw arrowpath mfun_arrow_path t ; + fillup arrowhead mfun_arrow_path t ; + endgroup ; +enddef ; + +def mfun_draw_arrow_path_double text t = + if autoarrows : + set_ahlength(t) ; + fi + draw arrowpath (reverse arrowpath mfun_arrow_path) t ; + fillup arrowhead mfun_arrow_path t ; + fillup arrowhead reverse mfun_arrow_path t ; + endgroup ; +enddef ; + +%D The picture variant is not treating each path but only the first and last path. This +%D can be somewhat counterintuitive but is needed for Alan's macros. So here the last +%D and in case of a double path first paths in a icture get the shortening. + +def mfun_with_arrow_picture (text t) = + mfun_arrow_count := 0 ; + mfun_arrow_snippets := stroked_paths(mfun_arrow_picture) ; + for i within mfun_arrow_picture : + if istextext(i) : + draw i + else : + mfun_arrow_count := mfun_arrow_count + 1 ; + mfun_arrow_path := pathpart i ; + t + fi ; + endfor ; +enddef ; + +def mfun_draw_arrow_picture text t = + if autoarrows : + set_ahlength(t) ; + fi + mfun_with_arrow_picture ( + if mfun_arrow_count = mfun_arrow_snippets : + draw arrowpath mfun_arrow_path mfun_decoration_i i t ; + fillup arrowhead mfun_arrow_path mfun_decoration_i i t ; + else : + draw mfun_arrow_path mfun_decoration_i i t ; + fi ; + ) + endgroup ; +enddef ; + +def mfun_draw_arrow_picture_double text t = + if autoarrows : + set_ahlength(t) ; + fi + mfun_with_arrow_picture ( + draw + if mfun_arrow_count = 1 : + arrowpath reverse + elseif mfun_arrow_count = mfun_arrow_snippets : + arrowpath + fi + mfun_arrow_path mfun_decoration_i i t ; + if mfun_arrow_count = 1 : + fillup arrowhead reverse mfun_arrow_path mfun_decoration_i i t ; + fi + if mfun_arrow_count = mfun_arrow_snippets : + fillup arrowhead mfun_arrow_path mfun_decoration_i i t ; + fi + ) + endgroup ; +enddef ; + +%D Some more arrow magic, by Alan: + +let drawdoublearrow = drawdblarrow ; + +def drawdoublearrows expr p = + begingroup ; + save mfun_arrow_path ; + path mfun_arrow_path ; + save mfun_arrow_path_parallel ; + path mfun_arrow_path_parallel ; + if path p : + mfun_arrow_path := p ; + expandafter mfun_draw_arrow_paths + elseif picture p : + save mfun_arrow_picture ; + picture mfun_arrow_picture ; + mfun_arrow_picture := p ; + expandafter mfun_draw_arrow_pictures + else : + expandafter mfun_draw_arrow_nothing + fi +enddef ; + +def mfun_draw_arrow_paths text t = + if autoarrows : + set_ahlength(t) ; + fi + save d ; d := ahscale*ahlength*sind(ahangle/2) ; + mfun_arrow_path_parallel := mfun_arrow_path paralleled d ; + draw arrowpath mfun_arrow_path_parallel t ; + fillup arrowhead mfun_arrow_path_parallel t ; + mfun_arrow_path_parallel := (reverse mfun_arrow_path) paralleled d ; + draw arrowpath mfun_arrow_path_parallel t ; + fillup arrowhead mfun_arrow_path_parallel t ; + endgroup ; +enddef ; + +def mfun_draw_arrow_pictures text t = + if autoarrows : + set_ahlength(t) ; + fi + save d ; d := ahscale*ahlength*sind(ahangle/2) ; + mfun_with_arrow_picture( + if mfun_arrow_count = 1 : + draw (mfun_arrow_path paralleled d) mfun_decoration_i i t ; + mfun_arrow_path_parallel := (reverse mfun_arrow_path) paralleled d ; + draw arrowpath mfun_arrow_path_parallel mfun_decoration_i i t ; + fillup arrowhead mfun_arrow_path_parallel mfun_decoration_i i t ; + elseif mfun_arrow_count = mfun_arrow_snippets : + draw ((reverse mfun_arrow_path) paralleled d) mfun_decoration_i i t ; + mfun_arrow_path_parallel := mfun_arrow_path paralleled d ; + draw arrowpath mfun_arrow_path_parallel mfun_decoration_i i t ; + fillup arrowhead mfun_arrow_path_parallel mfun_decoration_i i t ; + else : + draw ( mfun_arrow_path paralleled d) mfun_decoration_i i t ; + draw ((reverse mfun_arrow_path) paralleled d) mfun_decoration_i i t ; + fi + ) + endgroup ; +enddef ; + +%D Handy too ...... + +vardef pointarrow (expr pat, loc, len, off) = + save l, r, s, t ; path l, r ; numeric s ; pair t ; + t := if pair loc : loc else : point loc along pat fi ; + s := len/2 - off ; if s<=0 : s := 0 elseif s>len : s := len fi ; + r := pat cutbefore t ; + r := (r cutafter point (arctime s of r) of r) ; + s := len/2 + off ; if s<=0 : s := 0 elseif s>len : s := len fi ; + l := reverse (pat cutafter t) ; + l := (reverse (l cutafter point (arctime s of l) of l)) ; + (l..r) +enddef ; + +def rightarrow (expr pat,tim,len) = pointarrow(pat,tim,len,-len) enddef ; +def leftarrow (expr pat,tim,len) = pointarrow(pat,tim,len,+len) enddef ; +def centerarrow (expr pat,tim,len) = pointarrow(pat,tim,len, 0) enddef ; + +permanent drawarrow, drawdblarrow, drawdoublearrows, drawdoublearrow, pointarrow, rightarrow, leftarrow, centerarrow ; + +%D The \type {along} and \type {on} operators can be used as follows: +%D +%D \starttyping +%D drawdot point .5 along somepath ; +%D drawdot point 3cm on somepath ; +%D \stoptyping +%D +%D The number denotes a percentage (fraction). + +primarydef pct along pat = % also negative + (arctime (pct * (arclength pat)) of pat) of pat +enddef ; + +primarydef len on pat = % no outer ( ) .. somehow fails + (arctime if len>=0 : len else : (arclength(pat)+len) fi of pat) of pat +enddef ; + +% this cuts of a piece from both ends + +tertiarydef pat cutends len = + begingroup + save tap ; path tap ; + tap := pat cutbefore (point (xpart paired(len)) on pat) ; + (tap cutafter (point -(ypart paired(len)) on tap)) + endgroup +enddef ; + +permanent along, on, cutends ; + +%D To be documented. + +path freesquare ; freesquare := ( + (-1,0) -- (-1,-1) -- (0,-1) -- (+1,-1) -- + (+1,0) -- (+1,+1) -- (0,+1) -- (-1,+1) -- cycle +) scaled .5 ; + +numeric freelabeloffset ; freelabeloffset := 3pt ; +numeric freedotlabelsize ; freedotlabelsize := 3pt ; + +vardef thefreelabel (expr asked_text, asked_location, asked_origin) = + save s, p, q, l ; picture s ; path p, q ; pair l ; + interim labeloffset := freelabeloffset ; + s := if string asked_text : thelabel(asked_text,asked_location) else : asked_text shifted -center asked_text shifted asked_location fi ; + setbounds s to boundingbox s enlarged freelabeloffset ; + p := fullcircle scaled (2*length(asked_location-asked_origin)) shifted asked_origin ; + q := freesquare xyscaled (urcorner s - llcorner s) ; + l := point xpart (p intersectiontimes (asked_origin--asked_location shifted (asked_location-asked_origin))) of q ; + setbounds s to boundingbox s enlarged -freelabeloffset ; % new + % draw boundingbox s shifted -l withpen pencircle scaled .5pt withcolor red ; + (s shifted -l) +enddef ; + +vardef freelabel (expr asked_text, asked_location, asked_origin) = + draw thefreelabel(asked_text,asked_location,asked_origin) ; +enddef ; + +vardef freedotlabel (expr asked_text, asked_location, asked_origin) = + interim linecap := rounded ; + draw asked_location withpen pencircle scaled freedotlabelsize ; + draw thefreelabel(asked_text,asked_location,asked_origin) ; +enddef ; + +immutable freesquare ; +permanent freelabeloffset, freedotlabelsize, thefreelabel, freelabel, freedotlabel ; + +%D \starttyping +%D drawarrow anglebetween(line_a,line_b,somelabel) ; +%D \stoptyping + +newinternal angleoffset ; angleoffset := 0pt ; +newinternal anglelength ; anglelength := 20pt ; +newinternal anglemethod ; anglemethod := 1 ; + +vardef anglebetween (expr a, b, s) = % path path string + save pointa, pointb, common, middle, offset ; + pair pointa, pointb, common, middle, offset ; + save curve ; path curve ; + save where ; numeric where ; + if round point 0 of a = round point 0 of b : + common := point 0 of a ; + else : + common := a intersectionpoint b ; + fi ; + pointa := point anglelength on a ; + pointb := point anglelength on b ; + where := turningnumber (common--pointa--pointb--cycle) ; + middle := (reverse(common--pointa) rotatedaround (pointa,-where*90)) + intersection_point + (reverse(common--pointb) rotatedaround (pointb, where*90)) ; + if not intersection_found : + middle := point .5 along + ((reverse(common--pointa) rotatedaround (pointa,-where*90)) -- + ( (common--pointb) rotatedaround (pointb, where*90))) ; + fi ; + if anglemethod = 0 : + curve := pointa{unitvector(middle-pointa)}.. pointb; + middle := point .5 along curve ; + curve := common ; + elseif anglemethod = 1 : + curve := pointa{unitvector(middle-pointa)}.. pointb; + middle := point .5 along curve ; + elseif anglemethod = 2 : + middle := common rotatedaround(.5[pointa,pointb],180) ; + curve := pointa--middle--pointb ; + elseif anglemethod = 3 : + curve := pointa--middle--pointb ; + elseif anglemethod = 4 : + curve := pointa..controls middle..pointb ; + middle := point .5 along curve ; + fi ; + draw thefreelabel(s, middle, common) ; % withcolor black ; + curve +enddef ; + +permanent anglebetween, angleoffset, anglelength, anglemethod ; + +% Stack + +picture mfun_current_picture_stack[] ; +numeric mfun_current_picture_depth ; + +mfun_current_picture_depth := 0 ; + +def pushcurrentpicture = + mfun_current_picture_depth := mfun_current_picture_depth + 1 ; + mfun_current_picture_stack[mfun_current_picture_depth] := currentpicture ; + currentpicture := nullpicture ; +enddef ; + +def popcurrentpicture text t = % optional text + if mfun_current_picture_depth > 0 : + addto mfun_current_picture_stack[mfun_current_picture_depth] also currentpicture t ; + currentpicture := mfun_current_picture_stack[mfun_current_picture_depth] ; + mfun_current_picture_stack[mfun_current_picture_depth] := nullpicture ; + mfun_current_picture_depth := mfun_current_picture_depth - 1 ; + fi ; +enddef ; + +permanent pushcurrentpicture, popcurrentpicture ; + +% penpoint (i,2) of somepath -> inner / outer point + +vardef penpoint expr pnt of p = + save n, d ; numeric n, d ; + (n,d) = if pair pnt : pnt else : (pnt,1) fi ; + (point n of p shifted ((penoffset direction n of p of currentpen) scaled d)) +enddef ; + +permanent penpoint ; + +%D colorcircle(size, red, green, blue) ; + +vardef colorcircle (expr size, red, green, blue) = % might move + save r, g, b, c, m, y, w ; save radius ; + path r, g, b, c, m, y, w ; numeric radius ; + + radius := 5cm ; pickup pencircle scaled (radius/25) ; + + transform t ; t := identity rotatedaround(origin,120) ; + + r := fullcircle rotated 90 scaled radius shifted (0,radius/4) rotatedaround(origin,135) ; + + b := r transformed t ; g := b transformed t ; + + c := buildcycle(subpath(1,7) of g,subpath(1,7) of b) ; + y := c transformed t ; m := y transformed t ; + + w := buildcycle(subpath(3,5) of r, subpath(3,5) of g,subpath(3,5) of b) ; + + pushcurrentpicture ; + + fill r withcolor red ; + fill g withcolor green ; + fill b withcolor blue ; + fill c withcolor white - red ; + fill m withcolor white - green ; + fill y withcolor white - blue ; + fill w withcolor white ; + + for i = r,g,b,c,m,y : draw i withcolor .5white ; endfor ; + + currentpicture := currentpicture xsized size ; + + popcurrentpicture ; +enddef ; + +% nice: currentpicture := inverted currentpicture ; + +primarydef p uncolored c = % not complete ... needs text and scripts and ... + if color p : + c - p + else : + image ( + for i within p : + addto currentpicture + if stroked i or filled i : + if filled i : + contour + else : + doublepath + fi + pathpart i + dashed dashpart i withpen penpart i + else : + also i + fi + withcolor c-(redpart i, greenpart i, bluepart i) ; + endfor ; + ) + fi +enddef ; + +vardef inverted primary p = + p uncolored white +enddef ; + +primarydef p softened c = + begingroup + save cc ; color cc ; cc := tripled(c) ; + if color p : + (redpart cc * redpart p,greenpart cc * greenpart p, bluepart cc * bluepart p) + else : + image ( + for i within p : + addto currentpicture + if stroked i or filled i : + if filled i : + contour + else : + doublepath + fi + pathpart i + dashed dashpart i withpen penpart i + else : + also i + fi + withcolor (redpart cc * redpart i, greenpart cc * greenpart i, bluepart cc * bluepart i) ; + endfor ; + ) + fi + endgroup +enddef ; + +vardef grayed primary p = + if rgbcolor p : + tripled(.30redpart p+.59greenpart p+.11bluepart p) + elseif cmykcolor p : + tripled(.30*(1-cyanpart i)+.59*(1-magentapart i)+.11*(1-yellowpart i)+blackpart i) + elseif greycolor p : + p + elseif string p : + grayed resolvedcolor(p) + elseif picture p : + image ( + for i within p : + addto currentpicture + if stroked i or filled i : + if filled i : + contour + else : + doublepath + fi + pathpart i + dashed dashpart i + withpen penpart i + else : + also i + fi + if unknown colorpart i : + % nothing + elseif rgbcolor colorpart i : + withcolor tripled(.30redpart i+.59greenpart i+.11bluepart i) ; + elseif cmykcolor colorpart i : + withcolor tripled(.30*(1-cyanpart i)+.59*(1-magentapart i)+.11*(1-yellowpart i)+blackpart i) ; + else : + withcolor colorpart i ; + fi + endfor ; + ) + else : + p + fi +enddef ; + +let greyed = grayed ; + +vardef hsvtorgb(expr h,s,v) = + save H, S, V, x ; + H = h mod 360 ; + S = if s < 0 : 0 elseif s > 1 : 1 else: s fi ; + V = if v < 0 : 0 elseif v > 1 : 1 else: v fi ; + x = 1 - abs(H mod 120 - 60)/60 ; + V * ( (1-S) * (1,1,1) + S * + if H < 60 : (1,x,0) + elseif H < 120 : (x,1,0) + elseif H < 180 : (0,1,x) + elseif H < 240 : (0,x,1) + elseif H < 300 : (x,0,1) + else : (1,0,x) + fi ) +enddef ; + +permanent colorcircle, uncolored, inverted, grayed, greyed, hsvtorgb ; + +% yes or no: "text" infont "cmr12" at 24pt ; + +% let normalinfont = infont ; +% +% numeric lastfontsize ; lastfontsize = fontsize defaultfont ; +% +% def infont primary name = % no vardef, no expr +% hide(lastfontsize := fontsize name) % no ; +% normalinfont name +% enddef ; +% +% def scaledat expr size = +% scaled (size/lastfontsize) +% enddef ; +% +% let at = scaledat ; + +% like decimal + +def condition primary b = if b : "true" else : "false" fi enddef ; + +permanent condition ; + +% undocumented + +primarydef p stretched s = + begingroup + save pp ; path pp ; pp := p xyscaled s ; + (pp shifted ((point 0 of p) - (point 0 of pp))) + endgroup +enddef ; + +primarydef p enlonged len = + begingroup + if len == 0 : + p + elseif pair p : + save q ; path q ; q := origin -- p ; + save al ; al := arclength(q) ; + if al > 0 : + point 1 of (q stretched ((al+len)/al)) + else : + p + fi + else : + save al ; al := arclength(p) ; + if al > 0 : + p stretched ((al+len)/al) + else : + p + fi + fi + endgroup +enddef ; + +% path p ; p := (0,0) -- (10cm,5cm) ; +% drawarrow p withcolor red ; +% drawarrow p shortened 1cm withcolor green ; + +% primarydef p shortened d = +% reverse ( ( reverse (p enlonged -d) ) enlonged -d ) +% enddef ; + +primarydef p shortened d = + reverse ( ( reverse (p enlonged -xpart paired(d)) ) enlonged -ypart paired(d) ) +enddef ; + +% yes or no, untested -) + +def xshifted expr dx = shifted(dx,0) enddef ; +def yshifted expr dy = shifted(0,dy) enddef ; + + +permanent stretched, enlonged, shortened, xshifted, yshifted ; + +% also handy + +% right: str = readfrom ("abc" & ".def" ) ; +% wrong: str = readfrom "abc" & ".def" ; + +% Every 62th read fails so we need to try again! + +% def readfile (expr name) = +% if (readfrom (name) <> EOF) : +% scantokens("input " & name & ";") ; +% elseif (readfrom (name) <> EOF) : +% scantokens("input " & name & ";") ; +% fi ; +% closefrom (name) ; +% enddef ; +% +% this sometimes fails on the elseif, so : +% + +def readfile (expr name) = + begingroup ; save ok ; boolean ok ; + if (readfrom (name) <> EOF) : + ok := false ; + elseif (readfrom (name) <> EOF) : + ok := false ; + else : + ok := true ; + fi ; + if not ok : + scantokens("input " & name & " ") ; + fi ; + closefrom (name) ; + endgroup ; +enddef ; + +permanent readfile ; % todo: lmtx + +% permits redefinition of end in macro + +inner end ; + +% this will be redone (when needed) using scripts and backend handling + +let mfun_remap_colors_normalwithcolor = normalwithcolor ; + +def remapcolors = + def normalwithcolor primary c = + mfun_remap_colors_normalwithcolor remappedcolor(c) + enddef ; +enddef ; + +def normalcolors = + let normalwithcolor = mfun_remap_colors_normalwithcolor ; +enddef ; + +def resetcolormap = + color color_map[][][] ; + normalcolors ; +enddef ; + +resetcolormap ; + +def r_color primary c = redpart c enddef ; % still neeeded? +def g_color primary c = greenpart c enddef ; % still neeeded? +def b_color primary c = bluepart c enddef ; % still neeeded? + +def remapcolor(expr old, new) = + color_map[redpart old][greenpart old][bluepart old] := new ; +enddef ; + +def remappedcolor(expr c) = + if known color_map[redpart c][greenpart c][bluepart c] : + color_map[redpart c][greenpart c][bluepart c] + else : + c + fi +enddef ; + +% Thanks to Jens-Uwe Morawski for pointing out that we need +% to treat bounded and clipped components as local pictures. + +def recolor suffix p = p := mfun_repathed (0,p) enddef ; +def refill suffix p = p := mfun_repathed (1,p) enddef ; +def redraw suffix p = p := mfun_repathed (2,p) enddef ; +def retext suffix p = p := mfun_repathed (3,p) enddef ; +def untext suffix p = p := mfun_repathed (4,p) enddef ; + +% primarydef p recolored t = mfun_repathed(0,p) t enddef ; +% primarydef p refilled t = mfun_repathed(1,p) t enddef ; +% primarydef p redrawn t = mfun_repathed(2,p) t enddef ; +% primarydef p retexted t = mfun_repathed(3,p) t enddef ; +% primarydef p untexted t = mfun_repathed(4,p) t enddef ; + +color refillbackground ; refillbackground := (1,1,1) ; + +def restroke suffix p = p := mfun_repathed (21,p) enddef ; % keep attributes +def reprocess suffix p = p := mfun_repathed (22,p) enddef ; % no attributes + +permanent recolor, refill, redraw, retext, untext, restroke, reprocess, refillbackground ; + +% also 11 and 12 + +vardef mfun_repathed (expr mode, p) text t = + begingroup ; + if mode = 0 : + save normalwithcolor ; + remapcolors ; + fi ; + save temp_p, temp_q, temp_r, temp_f, temp_b ; + picture temp_p, temp_q, temp_r ; color temp_f ; path temp_b ; + temp_b := boundingbox p ; + temp_p := nullpicture ; + for i within p : + temp_f := (redpart i, greenpart i, bluepart i) ; + if bounded i : + temp_q := mfun_repathed(mode,i) t ; + setbounds temp_q to pathpart i ; + addto temp_p also temp_q ; + elseif clipped i : + temp_q := mfun_repathed(mode,i) t ; + clip temp_q to pathpart i ; + addto temp_p also temp_q ; + elseif stroked i : + if mode=21 : + temp_r := i ; % indirectness is needed + addto temp_p also image(scantokens(t & " pathpart temp_r") + dashed dashpart i withpen penpart i + withcolor temp_f ; ) ; + elseif mode=22 : + temp_r := i ; % indirectness is needed + addto temp_p also image(scantokens(t & " pathpart temp_r")) ; + else : + addto temp_p doublepath pathpart i + dashed dashpart i withpen penpart i + withcolor temp_f % (redpart i, greenpart i, bluepart i) + if mode = 2 : + t + fi ; + fi ; + elseif filled i : + if mode=11 : + temp_r := i ; % indirectness is needed + addto temp_p also image(scantokens(t & " pathpart temp_r") + withcolor temp_f ; ) ; + elseif mode=12 : + temp_r := i ; % indirectness is needed + addto temp_p also image(scantokens(t & " pathpart temp_r")) ; + else : + addto temp_p contour pathpart i + withcolor temp_f + if (mode=1) and (temp_f<>refillbackground) : + t + fi ; + fi ; + else : + addto temp_p also i ; + fi ; + endfor ; + setbounds temp_p to temp_b ; + temp_p + endgroup +enddef ; + +%D After a question of Denis on how to erase a z variable, Jacko suggested to assign +%D whatever to x and y. So a clearz variable can be defined as: +% +% vardef clearz@# = +% x@# := whatever ; +% y@# := whatever ; +% enddef ; +% +% but Jacko suggested a redefinition of clearxy: +% +% def clearxy text s = +% clearxy_index_:=0; +% for $:=s: +% clearxy_index_:=clearxy_index_+1; endfor; +% if clearxy_index_=0: +% save x,y; +% else: +% forsuffixes $:=s: x$:=whatever; y$:=whatever; endfor; +% fi +% enddef; +% +% which i decided to simplify to: + +def clearxy text s = + if false for $ := s : or true endfor : + forsuffixes $ := s : x$ := whatever ; y$ := whatever ; endfor ; + else : + save x, y ; + fi +enddef ; + +permanent clearxy ; + +% so now we can say: clearxy ; as well as clearxy 1, 2, 3 ; + +% show x0 ; z0 = (10,10) ; +% show x0 ; x0 := whatever ; y0 := whatever ; +% show x0 ; z0 = (20,20) ; +% show x0 ; clearxy 0 ; +% show x0 ; z0 = (30,30) ; + +primarydef p smoothed d = + (p llmoved (-xpart paired(d),0) -- p lrmoved (-xpart paired(d),0) {right} .. + p lrmoved (0,-ypart paired(d)) -- p urmoved (0,-ypart paired(d)) {up} .. + p urmoved (-xpart paired(d),0) -- p ulmoved (-xpart paired(d),0) {left} .. + p ulmoved (0,-ypart paired(d)) -- p llmoved (0,-ypart paired(d)) {down} .. cycle) +enddef ; + +primarydef p cornered c = + ((point 0 of p) shifted (c*(unitvector(point 1 of p - point 0 of p))) -- + for i=1 upto length(p) : + (point i-1 of p) shifted (c*(unitvector(point i of p - point i-1 of p))) -- + (point i of p) shifted (c*(unitvector(point i-1 of p - point i of p))) .. + controls point i of p .. + endfor cycle) +enddef ; + +permanent smoothed, cornered ; + +% cmyk color support + +% vardef cmyk(expr c,m,y,k) = % elsewhere +% (1-c-k,1-m-k,1-y-k) +% enddef ; + +% handy + +% vardef bbwidth (expr p) = % vardef width_of primary p = +% if known p : +% if path p or picture p : +% xpart (lrcorner p - llcorner p) +% else : +% 0 +% fi +% else : +% 0 +% fi +% enddef ; + +vardef bbwidth primary p = + if unknown p : + 0 + elseif path p or picture p : + xpart (lrcorner p - llcorner p) + else : + 0 + fi +enddef ; + +% vardef bbheight (expr p) = % vardef heigth_of primary p = +% if known p : +% if path p or picture p : +% ypart (urcorner p - lrcorner p) +% else : +% 0 +% fi +% else : +% 0 +% fi +% enddef ; + +vardef bbheight primary p = + if unknown p : + 0 + elseif path p or picture p : + ypart (urcorner p - lrcorner p) + else : + 0 + fi +enddef ; + +permanent bbwidth, bbheight ; + +color nocolor ; numeric noline ; % both unknown signals + +def dowithpath (expr p, lw, lc, bc) = + if known p : + if known bc : + fill p withcolor bc ; + fi ; + if known lw and known lc : + draw p withpen pencircle scaled lw withcolor lc ; + elseif known lw : + draw p withpen pencircle scaled lw ; + elseif known lc : + draw p withcolor lc ; + fi ; + fi ; +enddef ; + +% result from metafont discussion list (denisr/boguslawj) + +def [[[ = [ [ [ enddef ; % already: def [[ = [ [ enddef ; +def ]]] = ] ] ] enddef ; % already: def ]] = ] ] enddef ; + +let == = = ; % magic + +permanent [[[, ]]], ==; + +% added + +picture oddly ; % evenly already defined + +evenly := dashpattern(on 3 off 3) ; +oddly := dashpattern(off 3 on 3) ; + +% not perfect, but useful since it removes redundant points. + +vardef mfun_straightened(expr sign, p) = + save temp_p, temp_q ; path temp_p, temp_q ; + temp_p := p ; + forever : + temp_q := mfun_do_straightened(sign, temp_p) ; + exitif length(temp_p) = length(temp_q) ; + temp_p := temp_q ; + endfor ; + temp_q +enddef ; + +% vardef mfun_straightened(expr sign, p) = +% save lp, lq, q ; path q ; q := p ; +% lp := length(p) ; +% forever : +% q := mfun_do_straightened(sign,q) ; +% lq := length(q) ; +% exitif lp = lq ; +% lp := lq ; +% endfor ; +% q +% enddef ; + +% can be optimized: + +vardef mfun_do_straightened(expr sign, p) = + if length(p) > 2 : % was 1, but straight lines are ok + save pp ; path pp ; + pp := point 0 of p ; + for i=1 upto length(p)-1 : + if round(point i of p) <> round(point length(pp) of pp) : + pp := pp -- point i of p ; + fi ; + endfor ; + save n, ok ; numeric n ; boolean ok ; + n := length(pp) ; ok := false ; + if n > 2 : + for i=0 upto n : + if unitvector(round(point i of pp - point if i=0 : n else : i-1 fi of pp)) <> + sign * unitvector(round(point if i=n : 0 else : i+1 fi of pp - point i of pp)) : + if ok : + -- + else : + ok := true ; + fi point i of pp + fi + endfor + if ok and (cycle p) : + -- cycle + fi + else : + pp + fi + else : + p + fi +enddef ; + +vardef simplified expr p = ( + reverse mfun_straightened(+1,mfun_straightened(+1,reverse p)) +) enddef ; + +vardef unspiked expr p = ( + reverse mfun_straightened(-1,mfun_straightened(-1,reverse p)) +) enddef ; + +permanent simplified, unspiked ; + +% path p ; +% p := (2cm,1cm) -- (2cm,1cm) -- (2cm,1cm) -- (3cm,1cm) -- +% (4cm,1cm) -- (4cm,2cm) -- (4cm,2.5cm) -- (4cm,3cm) -- +% (3cm,3cm) -- (2cm,3cm) -- (1cm,3cm) -- (-1cm,3cm) -- +% .5[(-1cm,3cm),(1cm,1cm)] -- (1cm,1cm) -- cycle ; +% +% p := unitcircle scaled 4cm ; +% +% drawpath p ; drawpoints p ; drawpointlabels p ; +% p := p shifted (4cm,0) ; p := straightened p ; +% drawpath p ; drawpoints p ; drawpointlabels p ; +% p := p shifted (4cm,0) ; p := straightened p ; +% drawpath p ; drawpoints p ; drawpointlabels p ; + +% new + +path originpath ; originpath := origin -- cycle ; + +vardef unitvector primary z = + if abs z = abs origin : z else : z/abs z fi % hm, abs origin is just origin +enddef; + +vardef epsed (expr e) = % epsed(1.2345) + e if e>0 : + eps elseif e < 0 : - eps fi +enddef ; + +immutable originpath ; +permanent unitvector, epsed ; + +% handy + +def withgray primary g = + withcolor g +enddef ; + +if unknown darkred : color darkred ; darkred := .625(1,0,0) fi ; +if unknown darkgreen : color darkgreen ; darkgreen := .625(0,1,0) fi ; +if unknown darkblue : color darkblue ; darkblue := .625(0,0,1) fi ; +if unknown darkcyan : color darkcyan ; darkcyan := .625(0,1,1) fi ; +if unknown darkmagenta : color darkmagenta ; darkmagenta := .625(1,0,1) fi ; +if unknown darkyellow : color darkyellow ; darkyellow := .625(1,1,0) fi ; +if unknown darkgray : color darkgray ; darkgray := .625(1,1,1) fi ; +if unknown lightgray : color lightgray ; lightgray := .850(1,1,1) fi ; + +permanent withgray ; + +% an improved plain mp macro + +vardef center primary p = + if pair p : + p + else : + .5[llcorner p, urcorner p] + fi +enddef; + +permanent center ; + +% new, yet undocumented + +vardef rangepath (expr p, d, a) = + if length p>0 : + (d*unitvector(direction 0 of p) rotated a) shifted point 0 of p + -- p -- + (d*unitvector(direction length(p) of p) rotated a) shifted point length(p) of p + else : + p + fi +enddef ; + +% under construction + +vardef straightpath (expr a, b, method) = + if (method<1) or (method>6) : + (a--b) + elseif method = 1 : + (a -- + if xpart a > xpart b : + if ypart a > ypart b : + (xpart b,ypart a) -- + elseif ypart a < ypart b : + (xpart a,ypart b) -- + fi + elseif xpart a < xpart b : + if ypart a > ypart b : + (xpart a,ypart b) -- + elseif ypart a < ypart b : + (xpart b,ypart a) -- + fi + fi + b) + elseif method = 3 : + (a -- + if xpart a > xpart b : + (xpart b,ypart a) -- + elseif xpart a < xpart b : + (xpart a,ypart b) -- + fi + b) + elseif method = 5 : + (a -- + if ypart a > ypart b : + (xpart b,ypart a) -- + elseif ypart a < ypart b : + (xpart a,ypart b) -- + fi + b) + else : + (reverse straightpath(b,a,method-1)) + fi +enddef ; + +permanent straightpath ; + +% handy for myself + +def addbackground text t = + begingroup ; + save p, b ; picture p ; path b ; + b := boundingbox currentpicture ; + p := currentpicture ; currentpicture := nullpicture ; + fill b t ; + setbounds currentpicture to b ; + addto currentpicture also p ; + endgroup ; +enddef ; + +permanent addbackground ; + +% makes a (line) into an infinite one (handy for calculating +% intersection points + +vardef infinite expr p = + (-infinity*unitvector(direction 0 of p) + shifted point 0 of p + -- p -- + +infinity*unitvector(direction length(p) of p) + shifted point length(p) of p) +enddef ; + +permanent infinite ; + +% obscure macros: create var from string and replace - and : +% (needed for process color id's) .. will go away + +% this will become a lua helper + +% string mfun_clean_ascii[] ; +% +% def register_dirty_chars(expr str) = +% for i = 0 upto length(str)-1 : +% mfun_clean_ascii[ASCII substring(i,i+1) of str] := "_" ; +% endfor ; +% enddef ; +% +% register_dirty_chars("+-*/:;., ") ; +% +% vardef cleanstring (expr s) = +% save ss ; string ss, si ; ss = "" ; save i ; +% for i=0 upto length(s) : +% si := substring(i,i+1) of s ; +% ss := ss & if known mfun_clean_ascii[ASCII si] : mfun_clean_ascii[ASCII si] else : si fi ; +% endfor ; +% ss +% enddef ; +% +% vardef asciistring (expr s) = +% save ss ; string ss, si ; ss = "" ; save i ; +% for i=0 upto length(s) : +% si := substring(i,i+1) of s ; +% if (ASCII si >= ASCII "0") and (ASCII si <= ASCII "9") : +% ss := ss & char(scantokens(si) + ASCII "A") ; +% else : +% ss := ss & si ; +% fi ; +% endfor ; +% ss +% enddef ; +% +% vardef setunstringed (expr s, v) = +% scantokens(cleanstring(s)) := v ; +% enddef ; +% +% vardef getunstringed (expr s) = +% scantokens(cleanstring(s)) +% enddef ; +% +% vardef unstringed (expr s) = +% expandafter known scantokens(cleanstring(s)) +% enddef ; + +% for david arnold: showgrid(-5,10,1cm,-10,10,1cm); + +def showgrid (expr minx, maxx, deltax, miny, maxy, deltay) = % will move + begingroup + save size ; numeric size ; size := 2pt ; + for x=minx upto maxx : + for y=miny upto maxy : + draw (x*deltax, y*deltay) withpen pencircle scaled + if (x mod 5 = 0) and (y mod 5 = 0) : + 1.5size withcolor .50white + else : + size withcolor .75white + fi ; + endfor ; + endfor ; + for x=minx upto maxx: + label.bot(textext("\infofont " & decimal x), (x*deltax,-size)) ; + endfor ; + for y=miny upto maxy: + label.lft(textext("\infofont " & decimal y), (-size,y*deltay)) ; + endfor ; + endgroup +enddef; + +% new, handy for: +% +% \startuseMPgraphic{map}{n} +% \includeMPgraphic{map:germany} ; +% c_phantom (\MPvar{n}<1) ( +% fill map_germany withcolor \MPcolor{lightgray} ; +% draw map_germany withpen pencircle scaled 1pt withcolor \MPcolor{darkgray} ; +% ) ; +% \includeMPgraphic{map:austria} ; +% c_phantom (\MPvar{n}<2) ( +% fill map_austria withcolor \MPcolor{lightgray} ; +% draw map_austria withpen pencircle scaled 1pt withcolor \MPcolor{darkgray} ; +% ) ; +% c_phantom (\MPvar{n}<3) ( +% \includeMPgraphic{map:swiss} ; +% fill map_swiss withcolor \MPcolor{lightgray} ; +% draw map_swiss withpen pencircle scaled 1pt withcolor \MPcolor{darkgray} ; +% ) ; +% c_phantom (\MPvar{n}<4) ( +% \includeMPgraphic{map:luxembourg} ; +% fill map_luxembourg withcolor \MPcolor{lightgray} ; +% draw map_luxembourg withpen pencircle scaled 1pt withcolor \MPcolor{darkgray} ; +% ) ; +% \stopuseMPgraphic +% +% \useMPgraphic{map}{n=3} + +vardef phantom (text t) = % to be checked + picture temp_p ; + temp_p := image(t) ; + addto temp_p also currentpicture ; + setbounds currentpicture to boundingbox temp_p ; +enddef ; + +vardef c_phantom (expr b) (text t) = + if b : + save temp_p; picture temp_p ; + temp_p := image(t) ; + addto temp_p also currentpicture ; + setbounds currentpicture to boundingbox temp_p ; + else : + t ; + fi ; +enddef ; + +permanent phantom ; + +%D Handy: + +def break = + exitif true ; % fi +enddef ; + +permanent break ; + +%D New too: + +primarydef p xstretched w = ( + p if (bbwidth (p)>0) and (w>0) : xscaled (w/bbwidth (p)) fi +) enddef ; + +primarydef p ystretched h = ( + p if (bbheight(p)>0) and (h>0) : yscaled (h/bbheight(p)) fi +) enddef ; + +permanent xstretched, ystretched ; + +%D Newer: + +vardef area expr p = + % we could calculate the boundingbox once + (xpart llcorner boundingbox p,0) -- p -- + (xpart lrcorner boundingbox p,0) -- cycle +enddef ; + +vardef basiccolors[] = + if @ = 0 : + white + else : + save n ; n := @ mod 7 ; + if n = 1 : red + elseif n = 2 : green + elseif n = 3 : blue + elseif n = 4 : cyan + elseif n = 5 : magenta + elseif n = 6 : yellow + else : black + fi + fi +enddef ; + +% vardef somecolor = (1,1,0,0) enddef ; + +% fill OverlayBox withcolor (rcomponent somecolor,gcomponent somecolor,bcomponent somecolor) ; +% fill OverlayBox withcolor (ccomponent somecolor,mcomponent somecolor,ycomponent somecolor,bcomponent somecolor) ; + +% This could be standard mplib 2 behaviour: + +% vardef rcomponent expr p = if rgbcolor p : redpart elseif cmykcolor p : 1 - cyanpart fi p enddef ; + +vardef rcomponent expr p = if rgbcolor p : redpart p elseif cmykcolor p : 1 - cyanpart p else : p fi enddef ; +vardef gcomponent expr p = if rgbcolor p : greenpart p elseif cmykcolor p : 1 - magentapart p else : p fi enddef ; +vardef bcomponent expr p = if rgbcolor p : bluepart p elseif cmykcolor p : 1 - yellowpart p else : p fi enddef ; +vardef ccomponent expr p = if cmykcolor p : cyanpart p elseif rgbcolor p : 1 - redpart p else : p fi enddef ; +vardef mcomponent expr p = if cmykcolor p : magentapart p elseif rgbcolor p : 1 - greenpart p else : p fi enddef ; +vardef ycomponent expr p = if cmykcolor p : yellowpart p elseif rgbcolor p : 1 - bluepart p else : p fi enddef ; +vardef kcomponent expr p = if cmykcolor p : blackpart p elseif rgbcolor p : 0 else : p fi enddef ; + +permanent rcomponent, gcomponent, bcomponent, ccomponent, mcomponent, ycomponent, kcomponent ; + +% draw image (...) ... ; % prescripts prepended to first, postscripts appended to last +% draw decorated (...) ... ; % prescripts prepended to each, postscripts appended to each +% draw redecorated (...) ... ; % prescripts assigned to each, postscripts assigned to each +% draw undecorated (...) ... ; % following properties are ignored, existing properties are kept +% +% draw decorated ( +% draw fullcircle scaled 20cm withpen pencircle scaled 20mm withcolor red withtransparency (1,.40) ; +% draw fullcircle scaled 15cm withpen pencircle scaled 15mm withcolor green withtransparency (1,.30) ; +% draw fullcircle scaled 10cm withpen pencircle scaled 10mm withcolor blue withtransparency (1,.20) ; +% ) +% withcolor blue +% withtransparency (1,.125) % selectively applied +% withpen pencircle scaled 10mm +% ; + +% vardef image (text imagedata) = % already defined +% save currentpicture ; +% picture currentpicture ; +% currentpicture := nullpicture ; +% imagedata ; +% currentpicture +% enddef ; + +vardef undecorated (text t) text decoration = + save currentpicture ; + picture currentpicture ; + currentpicture := nullpicture ; + t ; + currentpicture +enddef ; + +vardef decorated (text imagedata) text decoration = + save mfun_decorated_path, currentpicture ; + picture mfun_decorated_path, currentpicture ; + currentpicture := nullpicture ; + imagedata ; + mfun_decorated_path := currentpicture ; + currentpicture := nullpicture ; + for i within mfun_decorated_path : + addto currentpicture + if stroked i : + doublepath pathpart i + dashed dashpart i + withpen penpart i + withcolor colorpart i + withprescript prescriptpart i + withpostscript postscriptpart i + decoration + elseif filled i : + contour pathpart i + withpen penpart i + withcolor colorpart i + withprescript prescriptpart i + withpostscript postscriptpart i + decoration + elseif textual i : + also i + withcolor colorpart i + withprescript prescriptpart i + withpostscript postscriptpart i + decoration + else : + also i + fi + ; + endfor ; + currentpicture +enddef ; + +vardef redecorated (text imagedata) text decoration = + save mfun_decorated_path, currentpicture ; + picture mfun_decorated_path, currentpicture ; + currentpicture := nullpicture ; + imagedata ; + mfun_decorated_path := currentpicture ; + currentpicture := nullpicture ; + for i within mfun_decorated_path : + addto currentpicture + if stroked i : + doublepath pathpart i + dashed dashpart i + withpen penpart i + decoration + elseif filled i : + contour pathpart i + withpen penpart i + decoration + elseif textual i : + also i + decoration + else : + also i + fi + ; + endfor ; + currentpicture +enddef ; + +permanent decorated, undecorated, redecorated ; + +% path mfun_bleed_box ; + +% primarydef p bleeded d = +% image ( +% mfun_bleed_box := boundingbox p ; +% if pair d : +% draw p xysized (bbwidth(p)+2*xpart d,bbheight(p)+2*ypart d) shifted -d ; +% else : +% draw p xysized (bbwidth(p)+2d,bbheight(p)+2d) shifted (-d,-d) ; +% fi ; +% setbounds currentpicture to mfun_bleed_box ; +% ) +% enddef ; + +vardef mfun_snapped(expr p, s) = + if p < 0 : - ( - else : ( fi p div s) * s % the less tokens the better +enddef ; + +vardef mfun_applied(expr p, s)(suffix a) = + if path p : + if pair s : + for i=0 upto length(p)-1 : + (a(xpart point i of p,xpart s),a(ypart point i of p,ypart s)) -- + endfor + if cycle p : + cycle + else : + (a(xpart point length(p) of p,xpart s),a(ypart point length(p) of p,ypart s)) + fi + else : + for i=0 upto length(p)-1 : + (a(xpart point i of p,s),a(ypart point i of p,s)) -- + endfor + if cycle p : + cycle + else : + (a(xpart point length(p) of p,s),a(ypart point length(p) of p,s)) + fi + fi + elseif pair p : + if pair s : + (a(xpart p,xpart s),a(ypart p,ypart s)) + else : + (a(xpart p,s),a(ypart p,s)) + fi + elseif cmykcolor p : + (a(cyanpart p,s),a(magentapart p,s),a(yellowpart p,s),a(blackpart p,s)) + elseif rgbcolor p : + (a(redpart p,s),a(greenpart p,s),a(bluepart p,s)) + elseif graycolor p : + a(p,s) + elseif numeric p : + a(p,s) + else + p + fi +enddef ; + +primarydef p snapped s = + mfun_applied(p,s)(mfun_snapped) % so we can play with variants +enddef ; + +permanent snapped ; + +%D Take a look at mp-tool.mpiv for the old implementation if the next code. We only provide +%D this for old times sake. We assume that the lmt_ commands are defined by the time this +%D is used: + +% beginfont("demo-symbols"); +% beginglyph(9754,2,4,0) ; % high voltage +% interim ahlength := 1 ; +% drawarrow (1,4) -- (0,2) -- (2,3) -- (1,0) withcolor darkred ; +% endglyph ; +% endfont; + +picture font_glyph[][] ; +numeric font_count ; font_count := 0; + +def beginfont(expr n) = + begingroup ; + save name ; string name; name := n; + font_count := font_count + 1 ; + lmt_registerglyphs [ + name = name, + units = 10, + width = 10, + height = 8, + depth = 2, + ] ; +enddef ; + +def endfont = + endgroup; +enddef ; + +def beginglyph(expr u, w, h, d) = + save unicode ; unicode := u; + lmt_registerglyph [ + category = name, + unicode = u, + code = "draw font_glyph[" & decimal font_count & "][" & decimal u & "];" + width = w, + height = h, + depth = d, + ] ; + currentpicture := nullpicture ; +enddef ; + +def endglyph = + font_glyph[font_count][unicode] := currentpicture ; +enddef ; + +permanent beginfont, endfont, beginglyph, endglyph ; + +%D Dimensions have never been an issue as traditional MP can't make that large pictures, +%D but with double mode we need a catch: + +newinternal maxdimensions ; maxdimensions := 14000 ; + +def mfun_apply_max_dimensions = % not a generic helper, we want to protect this one + if bbwidth currentpicture > maxdimensions : + currentpicture := currentpicture if bbheight currentpicture > bbwidth currentpicture : ysized else : xsized fi maxdimensions ; + elseif bbheight currentpicture > maxdimensions : + currentpicture := currentpicture ysized maxdimensions ; + fi ; +enddef; + +extra_endfig := extra_endfig & "mfun_apply_max_dimensions ;" ; + +%D Bonus shapes (need along): + +path unittriangle, fulltriangle ; % not really units but circle based + +unittriangle := point 0 along unitcircle + -- point 1/3 along unitcircle + -- point 2/3 along unitcircle + -- cycle ; +fulltriangle := point 0 along fullcircle + -- point 1/3 along fullcircle + -- point 2/3 along fullcircle + -- cycle ; + +immutable unittriangle, fulltriangle ; + +%D Kind of special and undocumented. On Wikipedia one can find examples of quick sort +%D routines. Here we have a variant that permits a method. + +% vardef listsize(suffix list) = +% numeric len ; len := 0 ; +% forever : +% exitif unknown list[len+1] ; +% len := len + 1 ; +% endfor ; +% len +% enddef ; + +vardef listsize(suffix list) = + numeric len ; len := 1 ; + forever : + exitif unknown list[len] ; + len := len + 1 ; + endfor ; + len if unknown list[0] : - 1 fi +enddef ; + +vardef listlast(suffix list) = + numeric len ; len := if known list[0] : 0 else : 1 fi ; + forever : + len := len + 1 ; + exitif unknown list[len] ; + endfor ; + len - 1 +enddef ; + +vardef mfun_quick_sort(suffix list)(expr asked_min, asked_max)(text what) = + save l, r, m ; + numeric l ; l := asked_min ; + numeric r ; r := asked_max ; + numeric m ; m := floor(.5[asked_min,asked_max]) ; + asked_mid := what list[m] ; + forever : + exitif l >= r ; + forever : + exitif l > asked_max ; + % exitif (what list[l]) >= (what list[m]) ; + exitif (what list[l]) >= asked_mid ; + l := l + 1 ; + endfor ; + forever : + exitif r < asked_min ; + % exitif (what list[m]) >= (what list[r]) ; + exitif asked_mid >= (what list[r]) ; + r := r - 1 ; + endfor ; + if l <= r : + temp := list[l] ; + list[l] := list[r] ; + list[r] := temp ; + l := l + 1 ; + r := r - 1 ; + fi ; + endfor ; + if asked_min < r : + mfun_quick_sort(list)(asked_min,r)(what) ; + fi ; + if l < asked_max : + mfun_quick_sort(list)(l,asked_max)(what) ; + fi ; +enddef ; + +vardef sortlist(suffix list)(text what) = + save asked_max ; numeric asked_max ; + save asked_mid ; numeric asked_mid ; + save temp ; + % asked_max := listsize(list) ; + asked_max := listlast(list) ; + if pair list[asked_max] : + pair temp ; + else : + numeric temp ; + fi ; + if pair what list[asked_max] : + pair asked_mid ; + else : + numeric asked_mid ; + fi ; + if asked_max > 1 : + % mfun_quick_sort(list)(1,asked_max)(what) ; + mfun_quick_sort(list)(if known list[0] : 0 else : 1 fi,asked_max)(what) ; + fi ; +enddef ; + +vardef uniquelist(suffix list) = + % this one will be defined later +enddef ; + +vardef copylist(suffix list, target) = + save i ; i := 1 ; + forever : + exitif unknown list[i] ; + target[i] := list[i] ; + i := i + 1 ; + endfor ; +enddef ; + +vardef listtolines(suffix list) = + list[1] for i=2 upto listsize(list) : -- list[i] endfor +enddef ; + +vardef listtocurves(suffix list) = + list[1] for i=2 upto listsize(list) : .. list[i] endfor +enddef ; + +%D The sorter is used in: + +% not yet ok + +vardef shapedlist(suffix p) = % takes a list of paths + save l ; pair l[] ; + save r ; pair r[] ; + save i ; i := 1 ; + save n ; n := 0 ; + forever : + exitif unknown p[i] ; + n := n + 1 ; + l[n] := ulcorner p[i] ; + r[n] := urcorner p[i] ; + n := n + 1 ; + l[n] := llcorner p[i] ; + r[n] := lrcorner p[i] ; + i := i + 1 ; + endfor ; + for i = 3 upto n : + if xpart r[i] < xpart r[i-1] : + r[i] := (xpart r[i],ypart r[i-1]) ; + elseif xpart r[i] > xpart r[i-1] : + r[i-1] := (xpart r[i-1],ypart r[i]) ; + fi ; + if xpart l[i] < xpart l[i-1] : + l[i-1] := (xpart l[i-1],ypart l[i]) ; + elseif xpart l[i] > xpart l[i-1] : + l[i] := (xpart l[i],ypart l[i-1]) ; + fi ; + endfor ; + if n > 0 : + simplified ( + for i = 1 upto n : r[i] -- endfor + for i = n downto 1 : l[i] -- endfor + cycle + ) + else : + origin -- cycle + fi +enddef ; + +permanent listsize, listlast, sortlist, uniquelist, copylist, listtolines, listtocurves, shapedlist ; + +%D Dumping is fake anyway but let's keep this: + +let dump = relax ; + +%D Loading modules can be done with: + +def loadmodule expr name = % no vardef + % input can't be used directly in a macro + if (unknown scantokens("context_" & name)) and (unknown scantokens("metafun_loaded_" & name)) : + save s ; string s ; s := "input " & ditto & "mp-" & name & ditto & ";" ; + expandafter scantokens expandafter s + fi ; +enddef ; + +def loadfile (expr filename) = scantokens("input " & filename) enddef ; +def loadimage (expr filename) = image(scantokens("input " & filename);) enddef ; + +permanent loadmodule, loadfile, loadimage ; + +%D Handy for backgrounds: + +def drawpathwithpoints expr p = + do_drawpathwithpoints(p) +enddef ; + +def do_drawpathwithpoints(expr p) text t = + draw p t ; + if length(p) > 2 : + begingroup ; + save temp_c ; path temp_c ; + save temp_p; picture temp_p ; + temp_p := image ( + temp_c := if cycle p : fullsquare else : fullcircle fi scaled 6pt ; + for i=0 upto length(p) if cycle p : -1 fi : + fill temp_c shifted point i of p withcolor white ; + draw temp_c shifted point i of p withcolor white/2 withpen pencircle scaled .5pt ; + if (i = 0) and cycle p : + temp_c := fullcircle scaled 6pt ; + fi ; + endfor ; + for i=0 upto length(p) if cycle p : -1 fi : + draw textext("\infofont " & decimal i) ysized 2pt shifted point i of p ; + endfor ; + ) ; + setbounds temp_p to boundingbox p ; + draw temp_p ; + fi ; +enddef ; + +%D These new helpers are by Alan and are used in for instance the mp-node module. + +newinternal crossingdebug ; crossingdebug := 0 ; +newinternal crossingscale ; crossingscale := 10 ; +newinternal crossingnumbermax ; crossingnumbermax := 1000 ; + +% primary, secondary or tertiary? always hard to decide but primary makes sense + +vardef infotext@#(expr txt, ysize) = + textext@#("\infofont " & if numeric txt : decimal fi txt) ysized ysize +enddef ; + +primarydef p crossingunder q = + begingroup + save pic ; picture pic ; pic := nullpicture ; + if picture p : + for i within p : + if stroked i : + addto pic also image(draw pathpart i crossingunder q) ; + fi + endfor + elseif path p : + save n, t, a, b, c, r, bcuttings, hold ; + numeric n, t[], hold ; + path a, b, c, r, bcuttings, hold[] ; + c := makepath(currentpen scaled crossingscale) ; + r := if picture q : boundingbox fi q ; + t[0] := n := hold := 0 ; + a := p ; + % The cutbefore/cutafter using c below prevents endless loops! + %forever : % find all intersections + for i=1 upto crossingnumbermax : % safeguard + clearxy ; z = a intersectiontimes r ; + if x < 0 : + exitif hold < 1 ; + a := hold[hold] ; hold := hold - 1 ; + clearxy ; z = a intersectiontimes r ; + fi + (t[incr n], whatever) = p intersectiontimes point x of a ; + if x = 0 : + a := a cutbefore c shifted point x of a ; + elseif x = length a : + a := a cutafter c shifted point x of a ; + else : % before or after? + b := subpath (0,x) of a cutafter c shifted point x of a ; + bcuttings := cuttings ; + a := subpath (x,length a) of a cutbefore c shifted point x of a ; + clearxy ; z = a intersectiontimes r ; + if x < 0 : + a := b ; + cuttings := bcuttings ; + else : + if length bcuttings > 0 : + clearxy ; z = b intersectiontimes r ; + if x >= 0 : + hold[incr hold] := b ; + fi + fi + fi + fi + if length cuttings = 0 : % a single point: nothing cut + exitif hold < 1 ; + a := hold[hold] ; hold := hold - 1 ; + fi + if i = crossingnumbermax : + message("crossingunder reached maximum " & decimal i & " intersections."); + fi + endfor + + if n = 0 : % No crossings, we return the PATH + save pic ; path pic ; pic := p ; + else : % n>0 + sortlist(t,) ; + % we add too much, maybe a test is needed + t[incr n] = length p if cycle p : + t[1] fi ; +% save tt[] ; numeric tt[] ; uniquelist(t,tt) ; t := tt ; + % Now, n>1 ! + % t[0] is the first point of the path and t[n] is the last point + % (or the first intersection beyond the length if cyclic) + save m ; m := 0 ; + for i=if cycle p: 2 else: 1 fi upto n : + % skip the first segment if cyclic + % as it gets repeated (fully) at the end. + if crossingdebug > 0 : + if crossingdebug = 1 : + addto pic doublepath c shifted point t[i] of p + withpen currentpen withtransparency(1,.5) ; + elseif crossingdebug = 2 : + addto pic also + infotext (incr m,crossingscale/5) + shifted point t[i] of p ; + fi + fi + a := subpath (t[i-1],t[i]) of p + if i > 1 : + cutbefore (c shifted point t[i-1] of p) + fi + if (i < n) or (cycle p) : + cutafter (c shifted point t[i] of p) + fi ; + if (not picture q) or (a outsideof q) : + addto pic doublepath a withpen currentpen ; + fi + endfor + fi + fi + pic + endgroup +enddef ; + +primarydef p insideof q = + begingroup + save pth, pic, t ; + path pth ; picture pic ; + pic := if path q : image(draw q;) else : q fi ; + pth := p -- center pic ; + (t, whatever) = pth intersectiontimes boundingbox pic ; + t < 0 + endgroup +enddef ; + +% primarydef p insideof q = +% if (path q or picture q) : +% if (path p or picture p) : +% (xpart llcorner p > xpart llcorner q) and +% (xpart urcorner p < xpart urcorner q) and +% (ypart llcorner p > ypart llcorner q) and +% (ypart urcorner p < ypart urcorner q) +% elseif pair p : +% (xpart p > xpart llcorner q) and +% (xpart p < xpart urcorner q) and +% (ypart p > ypart llcorner q) and +% (ypart p < ypart urcorner q) +% fi +% elseif (numeric p and pair q) : +% % range check +% (p >= xpart q) and (p <= ypart q) +% else : % maybe triplets and such +% false +% fi +% enddef ; + +primarydef p outsideof q = + not (p insideof q) +enddef ; + +permanent crossingdebug, crossingscale, crossingnumberm, infotext, crossingunder, insideof, outsideof ; + +%D Also handy: + +vardef circularpath primary n = + reverse (for i=0 step 2/n until 8-2/n+2eps: point i of fullcircle .. endfor cycle) rotated 90 +enddef ; + +vardef squarepath primary n = + for i=0 step 1/n until 4-1/n + 2eps: point i of fullsquare -- endfor cycle +enddef ; + +vardef linearpath primary n = + origin for i=1/n step 1/n until 1-1/n + 2eps: -- point i of (origin--(1,0)) endfor +enddef ; + +permanent circularpath, squarepath, linearpath ; + +%D A nice tracing helper: + +color pensilcolor ; pensilcolor := .5red ; +newinternal pensilstep ; pensilstep := 1/25 ; + +vardef pensilled(expr p, q) = + image ( + draw p withcolor pensilcolor withpen q ; + for i = 0 step pensilstep until length(p) + eps: + draw point i of p withcolor white withtransparency (1,.5) withpen q ; + endfor ; + ) +enddef ; + +permanent pensilled, pensilcolor, pensilstep ; + +%D Easy to forget but handy for manuals: + +vardef tolist(suffix l)(text t) = + save n ; n := 1 ; + for p = t : + if numeric p : + n := p ; + dispose(l[n]) + elseif pair p : + l[n] := p ; + n := n + 1 ; + elseif path p : + for i=0 step 1 until length(p) : + l[n] := point i of p ; + n := n + 1 ; + endfor ; + else : + % ignore + fi ; + endfor ; + forever : + exitif unknown l[n] ; + dispose(l[n]) + n := n + 1 ; + endfor ; +enddef ; + +vardef topath(suffix p)(text t) = + save i ; i := if known p[1] : 2 ; p[1] elseif known p[0] : 1 ; p[0] else : 0 ; origin fi + forever : + exitif unknown p[i] ; + t p[i] + hide(i := i + 1) + endfor +enddef ; + +vardef tocycle(suffix p)(text t) = + topath(p,t) t cycle +enddef ; + +permanent tolist, topath, tocycle ; + +% reimplemented to support paths and pictures + +def drawdot expr p = + if pair p : + addto currentpicture doublepath p + withpen currentpen base_draw_options + elseif path p : + draw image ( + for i=0 upto length p : + addto currentpicture doublepath point i of p + withpen currentpen base_draw_options ; + endfor ; + ) + elseif picture p : + draw image ( + save pp ; path pp ; + for i within p : + if stroked i or filled i : + pp := pathpart i ; + for j=0 upto length pp : + addto currentpicture doublepath point j of pp + withpen currentpen base_draw_options ; + endfor ; + fi ; + endfor ; + ) + fi +enddef ; + +permanent drawdot ; + +% vardef textlength(text t) = +% save n ; n := 0 ; +% for i = t : +% n := n + 1 ; +% endfor; +% n +% enddef; + +vardef mfun_timestamp = + decimal year & "-" & + decimal month & "-" & + decimal day & " " & + if ((time div 60) < 10) : "0" & fi + decimal (time div 60) & ":" & + if ((time-(time div 60)*60) < 10) : "0" & fi + decimal (time-(time div 60)*60) +enddef ; + +vardef totransform(expr x, y, xx, xy, yx, yy) = + save t ; transform t ; + xxpart t = xx ; yypart t = yy ; + xypart t = xy ; yxpart t = yx ; + xpart t = x ; ypart t = y ; + t +enddef ; + +vardef bymatrix(expr rx, sx, sy, ry, tx, ty) = + save t ; transform t ; + xxpart t = rx ; yypart t = ry ; + xypart t = sx ; yxpart t = sy ; + xpart t = tx ; ypart t = ty ; + t +enddef ; + +permanent totransform, bymatrix ; + +let xslanted = slanted ; + +def yslanted primary s = + transformed + begingroup + save t ; transform t ; + xxpart t = 1 ; yypart t = 1 ; + xypart t = 0 ; yxpart t = s ; + xpart t = 0 ; ypart t = 0 ; + t + endgroup +enddef ; + +permanent xslanted, yslanted ; + +vardef processpath (expr p) (text pp) = + if path p : + for i=0 upto length(p)-1 : + pp(point i of p) .. controls + pp(postcontrol i of p) and + pp(precontrol (i+1) of p) .. + endfor + if cycle p : + cycle + else : + pp(point length(p) of p) + fi + elseif pair p : + pp(p) + else : + p + fi +enddef ; + +permanent processpath ; diff --git a/Master/texmf-dist/metapost/context/fonts/mpiv/bidi-symbols.mp b/Master/texmf-dist/metapost/context/fonts/mpiv/bidi-symbols.mp index abe48b95116..926e1c5fd40 100644 --- a/Master/texmf-dist/metapost/context/fonts/mpiv/bidi-symbols.mp +++ b/Master/texmf-dist/metapost/context/fonts/mpiv/bidi-symbols.mp @@ -52,6 +52,8 @@ numeric font_bidi_wd ; font_bidi_wd := -12 ; % setbounds currentpicture to boundingbox nullpicture ; % endfig ; +beginfont("bidi-symbols") ; + beginglyph(8234,0,0,0) ; % lre drawarrow (0,0) -- (0,font_bidi_dp) -- (font_bidi_wd,font_bidi_dp) withcolor red ; endglyph ; @@ -71,3 +73,5 @@ endglyph ; beginglyph(8238,0,0,0) ; % rlo drawarrow reverse ((0,0) -- (0,font_bidi_dp) -- (-font_bidi_wd,font_bidi_dp)) withcolor green ; endglyph ; + +endfont ; diff --git a/Master/texmf-dist/metapost/context/fonts/mpiv/demo-symbols.mp b/Master/texmf-dist/metapost/context/fonts/mpiv/demo-symbols.mp index 822854c9419..f74189a1be0 100644 --- a/Master/texmf-dist/metapost/context/fonts/mpiv/demo-symbols.mp +++ b/Master/texmf-dist/metapost/context/fonts/mpiv/demo-symbols.mp @@ -14,8 +14,11 @@ passvariable("fontname","demo-symbols") ; passvariable("fontversion","1.005") ; +beginfont("demo-symbols") ; + beginglyph(9754,2,4,0) ; % high voltage interim ahlength := 1 ; drawarrow (1,4) -- (0,2) -- (2,3) -- (1,0) withcolor darkred ; endglyph ; +endfont ; diff --git a/Master/texmf-dist/metapost/context/fonts/mpiv/demo-symbols.tex b/Master/texmf-dist/metapost/context/fonts/mpiv/demo-symbols.tex index e9af4a027ed..b85803b24bc 100644 --- a/Master/texmf-dist/metapost/context/fonts/mpiv/demo-symbols.tex +++ b/Master/texmf-dist/metapost/context/fonts/mpiv/demo-symbols.tex @@ -1,21 +1,36 @@ +%\setupbodyfont[dejavu] + \starttext - \definemetafont[demo-symbols][demo-symbols.mp] + \ifcase\contextlmtxmode + + \definemetafont[demo-symbols][demo-symbols.mp] + + \startbuffer + watch this: {\demo\char"261A} \quad \ruledhbox{\demo\char"261A} + \stopbuffer + + \definefont[demo][demo@demo-symbols] + + \getbuffer \blank + + \definefont[demo][demo@demo-symbols at \the\dimexpr3\exheight] - \startbuffer - watch this: {\demo\char"261A} \quad \ruledhbox{\demo\char"261A} - \stopbuffer + \getbuffer \blank - \definefont[demo][demo@demo-symbols] + \definefont[demo][demo@demo-symbols at \the\dimexpr4\exheight] - \getbuffer \blank + \getbuffer \blank - \definefont[demo][demo@demo-symbols at \the\dimexpr3\exheight] + \else - \getbuffer \blank + \showglyphs - \definefont[demo][demo@demo-symbols at \the\dimexpr4\exheight] + \startTEXpage[offset=10pt] + \definemetafont[MyDemoA][demo-symbols][at 10pt]\MyDemoA\char9754 + \definemetafont[MyDemoB][demo-symbols][at 30pt]\MyDemoB\char9754 + \stopTEXpage - \getbuffer \blank + \fi \stoptext diff --git a/Master/texmf-dist/metapost/context/fonts/mpiv/punkfont-characters.mp b/Master/texmf-dist/metapost/context/fonts/mpiv/punkfont-characters.mp index da0015b02b4..5ba7a8a2182 100644 --- a/Master/texmf-dist/metapost/context/fonts/mpiv/punkfont-characters.mp +++ b/Master/texmf-dist/metapost/context/fonts/mpiv/punkfont-characters.mp @@ -592,9 +592,19 @@ pd z1; pd z2; pd z3; pd z4; draw z1--z2; draw flex(z3,z6,z4); % stems pd z5; draw z5--z6; % crossbar endchar; -beginpunkchar("i",5,1,2); -z1=pp(.5w,0); z2=(.5w,1/3h); z3=(.5w,2/3h); z4=(.5w,h); -pd z1; pd z4; draw flex(z1,z2,z3,z4); % stem +% beginpunkchar("i",5,1,2); +% z1=pp(.5w,0); z2=(.5w,1/3h); z3=(.5w,2/3h); z4=(.5w,h); +% pd z1; pd z4; draw flex(z1,z2,z3,z4); % stem +% endchar; + +% beginpunkchar("i",9,1,2); +% z1=pp(.5w,0); z2=(.5w,.1h); z3=(.5w,2/3h); z4=(.5w,h); +% pd z1; pd z4; draw flex(z1,z2,z3,z4) withcolor red; % stem +% endchar; + +beginpunkchar("i",9,1,2); +z1=pp(.5w,0); z4=(.5w,h); +pd z1; pd z4; draw z1--z4; % stem endchar; beginpunkchar("j",9,1,2); @@ -642,7 +652,8 @@ z5=pp(.4w,.2h); z6=pp(w-u,-.1h); z7=pp(.5[x5,x6],-.2h); pd z5; pd z6; draw z5--z7--z6; % tail endchar; -beginpunkchar("r",16,1,2); +% beginpunkchar("r",16,1,2); +beginpunkchar("r",13,1,2); z1=pp(2u,0); z2=pp(2u,h); z3=pp(w-u,.6[y2,y4]); z4=pp(2u,.5h); z5=pp(w-1.5u,0); pd z1; pd z2; pd z5; draw z1--flex(z2,z3,z4)--z5; % stem, bowl, and diagonal endchar; |