From 18499e46a49b8ccf4346686d1cf626ada33935b8 Mon Sep 17 00:00:00 2001 From: Hans Hagen Date: Mon, 23 Nov 2020 19:48:34 +0100 Subject: 2020-11-23 18:39:00 --- metapost/context/base/mpiv/metafun.mpxl | 46 - metapost/context/base/mpiv/minifun.mpxl | 35 - metapost/context/base/mpiv/mp-cont.mpxl | 158 --- metapost/context/base/mpiv/mp-lmtx.mpxl | 2281 ------------------------------- metapost/context/base/mpiv/mp-luas.mpxl | 250 ---- metapost/context/base/mpiv/mp-math.mpxl | 161 --- metapost/context/base/mpiv/mp-page.mpxl | 243 ---- metapost/context/base/mpxl/metafun.mpxl | 46 + metapost/context/base/mpxl/minifun.mpxl | 35 + metapost/context/base/mpxl/mp-cont.mpxl | 158 +++ metapost/context/base/mpxl/mp-lmtx.mpxl | 2281 +++++++++++++++++++++++++++++++ metapost/context/base/mpxl/mp-luas.mpxl | 250 ++++ metapost/context/base/mpxl/mp-math.mpxl | 161 +++ metapost/context/base/mpxl/mp-page.mpxl | 243 ++++ 14 files changed, 3174 insertions(+), 3174 deletions(-) delete mode 100644 metapost/context/base/mpiv/metafun.mpxl delete mode 100644 metapost/context/base/mpiv/minifun.mpxl delete mode 100644 metapost/context/base/mpiv/mp-cont.mpxl delete mode 100644 metapost/context/base/mpiv/mp-lmtx.mpxl delete mode 100644 metapost/context/base/mpiv/mp-luas.mpxl delete mode 100644 metapost/context/base/mpiv/mp-math.mpxl delete mode 100644 metapost/context/base/mpiv/mp-page.mpxl create mode 100644 metapost/context/base/mpxl/metafun.mpxl create mode 100644 metapost/context/base/mpxl/minifun.mpxl create mode 100644 metapost/context/base/mpxl/mp-cont.mpxl create mode 100644 metapost/context/base/mpxl/mp-lmtx.mpxl create mode 100644 metapost/context/base/mpxl/mp-luas.mpxl create mode 100644 metapost/context/base/mpxl/mp-math.mpxl create mode 100644 metapost/context/base/mpxl/mp-page.mpxl (limited to 'metapost') diff --git a/metapost/context/base/mpiv/metafun.mpxl b/metapost/context/base/mpiv/metafun.mpxl deleted file mode 100644 index a6160ef3e..000000000 --- a/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/metapost/context/base/mpiv/minifun.mpxl b/metapost/context/base/mpiv/minifun.mpxl deleted file mode 100644 index 6769d26e4..000000000 --- a/metapost/context/base/mpiv/minifun.mpxl +++ /dev/null @@ -1,35 +0,0 @@ -%D \module -%D [ file=minifun.mp, -%D version=2018.06.02, -%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 This is a minimal \METAFUN\ instance which can be handy for isolated -%D subruns. - -boolean contextlmtxmode ; contextlmtxmode := if known fontmaking : false else: true fi; - -prologues := 0 ; -mpprocset := 1 ; - -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.mpiv" ; - -string minifunversion ; minifunversion = "minifun xl " & mfun_timestamp; - -let normalend = end ; - -def end = ; message "" ; message minifunversion ; message "" ; endinput ; enddef ; -def bye = ; message "" ; message minifunversion ; message "" ; endinput ; enddef ; diff --git a/metapost/context/base/mpiv/mp-cont.mpxl b/metapost/context/base/mpiv/mp-cont.mpxl deleted file mode 100644 index bc318d4b9..000000000 --- a/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/metapost/context/base/mpiv/mp-lmtx.mpxl b/metapost/context/base/mpiv/mp-lmtx.mpxl deleted file mode 100644 index 1f70d0ac1..000000000 --- a/metapost/context/base/mpiv/mp-lmtx.mpxl +++ /dev/null @@ -1,2281 +0,0 @@ -%D \module -%D [ file=mp-luas.lmtx, -%D version=2019.06.23, -%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. - -% 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 ; - -boolean context_lmtx ; context_lmtx := true ; - -presetparameters "text" [ - offset = 0, - strut = "auto", - style = "", - color = "", - text = "", - anchor = "", - format = "", - position = origin, - trace = false, - - background = "", % "color", - backgroundcolor = "gray", -] ; - -def lmt_text = applyparameters "text" "lmt_do_text" enddef ; - -vardef lmt_do_text = - image ( - pushparameters "text" ; - save style, anchor, txt, fmt, strt ; - string style, anchor, txt, fmt, strt, bgr ; - interim textextoffset := getparameter "offset" ; - style := getparameter "style" ; - anchor := getparameter "anchor" ; - strt := getparameter "strut" ; - fmt := getparameter "format" ; - txt := getparameter "text" ; - bgr := getparameter "background" ; - if fmt <> "" : - txt := "\formatone{" & fmt & "}{" & txt & "}" - fi ; - if strt = "yes" : - txt := "\strut " & txt ; - elseif strt = "auto" : - txt := "\setstrut\strut " & txt ; - fi ; - if style <> "" : - txt := "\style[" & style & "]{" & txt & "}" ; - fi ; - if getparameter "trace" : - txt := "\ruledhbox{\showstruts" & txt & "}" ; - fi ; - draw - if anchor = "" : thetextext else : scantokens("thetextext." & anchor) fi ( - txt, - getparameter "position" - ) - withcolor getparameter "color" ; - if bgr = "color" : - addbackground withcolor getparameter "backgroundcolor" ; - fi ; - popparameters ; - ) -enddef ; - -presetparameters "grid" [ - nx = 1, dx = 1, - ny = 1, dy = 1, -] ; - -def lmt_grid = applyparameters "grid" "lmt_do_grid" enddef ; - -vardef lmt_do_grid = - image ( - save nx; nx := getparameter "grid" "nx" ; - save ny; ny := getparameter "grid" "ny" ; - save dx; dx := getparameter "grid" "dx" ; - save dy; dy := getparameter "grid" "dy" ; - for i = 0 step dx until nx : - draw ((0,0) -- (0,ny)) shifted (i,0) ; - endfor ; - for i = 0 step dy until ny : - draw ((0,0) -- (nx,0)) shifted (0,i) ; - endfor ; - ) -enddef ; - -def lmt_axis = applyparameters "axis" "lmt_do_axis" enddef ; - -presetparameters "axis" [ - nx = 1, dx = 1, tx = 0, sx = 1, startx = 0, - ny = 1, dy = 1, ty = 0, sy = 1, starty = 0, - - samples = { }, - list = { }, - connect = false, - list = [ close = false ], - samplecolors = { "" }, - axiscolor = "", - textcolor = "", -] ; - -vardef lmt_do_axis = - image ( - - pushparameters "axis" ; - save nx, ny, dx, dy, tx, ty ; - save c, startx, starty ; string c ; - nx := getparameter "nx" ; - ny := getparameter "ny" ; - dx := getparameter "dx" ; - dy := getparameter "dy" ; - tx := getparameter "tx" ; - ty := getparameter "ty" ; - c := getparameter "axiscolor" ; - startx := getparameter "startx" ; - starty := getparameter "starty" ; - draw (startx,starty) -- (startx,ny) withcolor c ; - draw (startx,starty) -- (nx,starty) withcolor c ; - for i = startx step dx until nx : - if (i > startx) or (startx = 0) : - draw ((0,0) -- (0,-2)) shifted (i,starty) withcolor c ; - fi ; - endfor ; - for i = starty step dy until ny : - if (i > starty) or (starty = 0) : - draw ((0,0) -- (-2,0)) shifted (startx,i) withcolor c ; - fi ; - endfor ; - if tx <> 0 : - c := getparameter "textcolor" ; - for i = startx step tx until nx : - if (i > startx) or (startx = 0) : - draw - textext("\strut " & decimal (i)) ysized 2 shifted (i,-4+starty) - withcolor c; - fi ; - endfor ; - fi ; - if ty <> 0 : - c := getparameter "textcolor" ; - for i = starty step ty until ny : - if (i > starty) or (starty = 0) : - draw - textext.lft("\strut " & decimal (i)) ysized 2 shifted (-3+startx,i) - withcolor c; - fi ; - endfor ; - fi ; - - if (getparametercount "samples") > 0 : - if getparameter "connect" : - for s = 1 upto getparametercount "samples" : - c := getparameter "samplecolors" s ; - draw for i = 1 upto getparametercount "samples" s : - if (i > 1) : -- fi (i, getparameter "samples" s i) - endfor - withcolor c ; - endfor ; - else : - for s = 1 upto getparametercount "samples" : - c := getparameter "samplecolors" s ; - for i = 1 upto getparametercount "samples" s : - draw (i, getparameter "samples" s i) - withcolor c ; - endfor ; - endfor ; - fi ; - fi ; - - if (getparametercount "list") > 0 : - - save p, ts, a, d ; path p ; numeric ts ; pair a, d ; - - ts := (getparameter "sy") / 20 ; - - pushparameters "list" ; - for s = 1 upto getparametercount : - pushparameters s ; - - c := getparameter "color" ; - - % p := for i = 1 upto getparametercount "points": - % if (i > 1) : -- fi (getparameter "points" i) - % endfor - % if (getparameterdefault "close" false) : -- cycle fi ; - - % this can become: - - % p := if (getparameterdefault "close" false) : - % % getparameterpath "points" "--" true ; - % getparameterpath "points" true ; - % else : - % % getparameterpath "points" "--" false ; - % getparameterpath "points" ; - % fi ; - - % p := getparameterpath "points" if (getparameterdefault "close" false) : true fi ; - - p := getparameterpath "points" (getparameterdefault "close" false) ; - % p := getparameterpath "points" getparameterdefault "close" false ; - - draw p withcolor c ; - - pushparameters "labels" ; - if (getparametercount) > 0 : - for i = 1 upto getparametercount: - n := i - 1 ; - a := point n of p ; - d := direction n of p ; - draw - textext(getparametertext i true) - ysized ts - shifted (a + .5 * unitvector(d) rotated 90) ; - endfor ; - fi ; - popparameters ; - - pushparameters "texts" ; - if (getparametercount) > 0 : - for i = 1 upto getparametercount : - n := i + 0.5 ; - a := point n of p ; - d := direction n of p ; - draw textext.d(getparametertext i true) - if d < left : rotated 180 shifted (0,-5) else : shifted (0,5) fi - ysized ts - shifted a - rotatedaround(a,angle(d)) ; - endfor ; - fi ; - popparameters ; - - popparameters ; - endfor ; - popparameters ; - fi ; - - popparameters ; - - ) - xyscaled(getparameter "axis" "sx",getparameter "axis" "sy") -enddef ; - -presetparameters "outline" [ - text = "", - kind = "draw", - fillcolor = "", - drawcolor = "", - rulethickness = 1/10, - align = "", - style = "", - width = 0, -] ; - -def lmt_outline = applyparameters "outline" "lmt_do_outline" enddef ; - -vardef lmt_do_outline = - image ( normaldraw image ( - save kind ; string kind ; kind := getparameter "outline" "kind" ; - save align ; string align ; align := getparameter "outline" "align" ; - save style ; string style ; style := getparameter "outline" "style" ; - save width ; numeric width ; width := getparameter "outline" "width" ; - if kind = "draw" : - kind := "d" ; - elseif kind = "fill" : - kind := "f" ; - elseif kind = "both" : - kind := "b" ; - elseif kind = "reverse" : - kind := "r" ; - elseif kind = "fillup" : - kind := "u" ; - fi ; - currentoutlinetext := currentoutlinetext + 1 ; - lua.mp.mf_outline_text( - currentoutlinetext, - if align = "" : - getparameter "outline" "text", - else : - "\framed[align={" & align & "}" - if width > 0 : - & ",width=" & decimal width & "bp" - fi - if style <> "" : - & ",foregroundstyle={" & style & "}" - fi - & ",offset=none,frame=off]{" - & (getparameter "outline" "text") - & "}", - fi, - kind - ) ; - save currentpen; pen currentpen ; - pickup pencircle scaled getparameter "outline" "rulethickness" ; - if kind = "f" : - mfun_do_outline_text_set_f ( - withcolor getparameter "outline" "fillcolor" - ); - elseif kind = "d" : - mfun_do_outline_text_set_d ( - withcolor getparameter "outline" "drawcolor" - ); - elseif kind = "b" : - mfun_do_outline_text_set_b ( - withcolor getparameter "outline" "fillcolor" - ) ( - withcolor getparameter "outline" "drawcolor" - ); - elseif kind = "u" : - mfun_do_outline_text_set_u ( - withcolor getparameter "outline" "fillcolor" - ); - elseif kind = "r" : - mfun_do_outline_text_set_r ( - withcolor getparameter "outline" "drawcolor" - ) ( - withcolor getparameter "outline" "fillcolor" - ) ; - elseif kind = "p" : - mfun_do_outline_text_set_p ; - else : - mfun_do_outline_text_set_n ( - % what to use here - ); - fi ; - lua.mp.mf_get_outline_text(currentoutlinetext) ; - ) ) -enddef ; - -presetparameters "followtext" [ - text = "", - spread = true, - trace = false, - reverse = false, - autoscaleup = "no", - autoscaledown = "no", - path = (fullcircle), -] ; - -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 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 ; - draw followtext ( - if (getparameter "reverse") : reverse fi (getparameter "path"), - getparameter "text" - ) ; - popparameters ; - ) -enddef ; - -presetparameters "arrow" [ - path = origin, - % pen = ..., - kind = "fill", - dimple = 1/5, - scale = 3/4, - penscale = 3, - length = 4, - angle = 45, - location = "end", % middle both - alternative = "normal", % dimpled curved - percentage = 50, - headonly = false, -] ; - -def lmt_arrow = applyparameters "arrow" "lmt_do_arrow" enddef ; - -vardef lmt_do_arrow = - image ( - pushparameters "arrow" ; - save a ; string a ; a := getparameter "alternative" ; - 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" ; - if not getparameter "headonly" : - draw p ; - fi ; - if hasparameter "pen" : - % a cheat: we should have a type check in lua - if hasoption "pen" "auto" : - ahlength := (getparameter "penscale") * boundingradius(currentpen) ; - else : - ahlength := (getparameter "penscale") * boundingradius(getparameterpen "pen") ; - fi ; - fi ; - if k = "draw" : draw elseif k = "both" : filldraw else : fill fi - if l = "middle" : - midarrowhead p ; - elseif l = "percentage" : - arrowheadonpath (p, (getparameter "percentage")/100) ; - elseif l = "both" : - arrowhead p ; - if k = "draw" : draw elseif k = "both" : filldraw else : fill fi - arrowhead reverse p ; - else : - arrowhead p ; - fi ; - popparameters ; - ) -enddef ; - -% from dum - -presetparameters "placeholder" [ - color = "red", - width = 1, - height = 1, - reduction = 0, - alternative = "circle", -] ; - -def lmt_placeholder = applyparameters "placeholder" "lmt_do_placeholder" enddef ; - -def lmt_do_placeholder = - begingroup ; - pushparameters "placeholder" ; - save w, h, d, r, p, c, b, s, q, a ; - numeric w, h, d, r ; path p ; string s, a ; - s := getparameter "color" ; - w := getparameter "width" ; - h := getparameter "height" ; - r := getparameter "reduction" ; - a := getparameter "alternative" ; - d := max(w,h) ; - if cmykcolor resolvedcolor(s) : - cmykcolor c, b ; b := (0,0,0,0) - else : - color c, b ; b := (1,1,1) - fi ; - c := resolvedcolor(s) ; - p := unitsquare xyscaled (w,h) ; - fill p withcolor r[.5c,b] ; - if a = "square" : - vardef q = fullsquare enddef ; - elseif a = "triangle" : - vardef q = fulltriangle rotated (90 * round(uniformdeviate(4))) enddef ; - else : - vardef q = fullcircle enddef ; - fi ; - for i := 1 upto 60 : - fill q - scaled (d/5 randomized (d/5)) - shifted (center p randomized (d)) - withcolor r[c randomized(.3,.9),b] ; - endfor ; - clip currentpicture to p ; - popparameters ; - endgroup ; -enddef ; - -% maybe: - -vardef lmt_connected(text t) = - save p ; path p ; - p := origin t ; - subpath (1,length(p)) of p -enddef ; - -def lmt_connection expr t = - -- t -enddef ; - -% also (todo) - -% % draw lmt_path [ -% % points = [ color = "darkred", size = 6 ], -% % controls = [ color = "darkgreen", size = 4 ], -% % lines = [ color = "darkgray", size = 1 ], -% % shape = [ color = "middlegray", size = 8 ], -% % labels = [ ], -% % path = ((1cm,1cm) -- (1.5cm,1.5cm) .. (2cm,0cm) .. cycle) -% % ] ; -% -% presetparameters "path" [ -% labels = [ -% color = "", -% size = 1 -% ], -% controls = [ -% color = "black", -% size = 2.5 -% ], -% lines = [ -% color = "middlegray", -% size = 1 -% ], -% points = [ -% color = "black", -% size = 4 -% ], -% path = [ -% color = "lightgray", -% size = 5, -% path = origin -% ] -% ] ; -% -% def lmt_path = applyparameters "path" "lmt_do_path" enddef ; -% -% vardef lmt_do_path = -% image ( -% % This one is not that efficient ... we can better inline the drawing routines here, but -% % it's just an interfacing test after all. -% if hasparameter "path" "path" : -% save p ; path p ; p := getparameter "path" "path" ; -% drawpath p -% withpen pencircle scaled (drawoptionsfactor * getparameterdefault "path" "shape" "size" "*") -% withcolor getparameterdefault "path" "shape" "color" "*" -% ; -% if hasparameter "path" "controls" : -% drawcontrollines p -% withpen pencircle scaled (drawoptionsfactor * getparameterdefault "path" "lines" "size" "*" ) -% withcolor getparameterdefault "path" "lines" "color" "*" -% ; -% drawcontrolpoints p -% withpen pencircle scaled (drawoptionsfactor * getparameterdefault "path" "controls" "size" "*") -% withcolor getparameterdefault "path" "controls" "color" "*" -% ; -% fi ; -% if hasparameter "path" "points" : -% drawpoints p -% withpen pencircle scaled (drawoptionsfactor * getparameterdefault "path" "points" "size" "*") -% withcolor getparameterdefault "path" "points" "color" "*" -% ; -% if hasparameter "path" "labels" : -% drawpointlabels p -% withcolor getparameterdefault "path" "labels" "color" "*" -% ; -% fi ; -% fi ; -% fi ; -% ) -% enddef ; - -% Here we use nodraw and dodraw to create efficient axis ticks. Yet another demo -% of coding. - -presetparameters "function" [ - sx = 1mm, - sy = 1mm, - offset = 0, - xmin = 1, - xmax = 1, - xstep = 1, - xsmall = 0, - xlarge = 0, - xlabels = "no", - xticks = "bottom", % top bottom middle - xcaption = "", - ymin = 1, - ymax = 1, - ystep = 1, - ysmall = 0, - ylarge = 0, - % xfirst = 0, - % xlast = 0, - % yfirst = 0, - % ylast = 0, - ylabels = "no", - yticks = "left", % left right middle - ycaption = "", - code = "", - close = false, - shape = "curve", - fillcolor = "", - drawsize = 1, - drawcolor = "", - frame = "", % yes ticks - linewidth = .05mm, - pointsymbol = "", - pointsize = 2, - pointcolor = "", - xarrow = "", - yarrow = "", - reverse = false, -] ; - -def lmt_function = applyparameters "function" "lmt_do_function" enddef ; - -vardef lmt_do_function_p(expr xmin, xmax, xstep, code, shape, close, fcolor, dsize, dcolor, psymbol, psize, pcolor) = - save p, q ; path p, q ; - p := lua.mp.lmt_function_x(xmin,xmax,xstep,code,shape) ; - if close : - q := (xmin,0) -- p -- (xmax,0) -- cycle ; - fill q withcolor fcolor ; - else : - draw p withpen currentpen scaled dsize withcolor dcolor - ; - fi ; - if psize > 0 : - if psymbol = "dot" : - draw image ( - for i = 0 upto length(p) : - draw point i of p ; - endfor ; - ) withpen currentpen scaled psize withcolor pcolor ; - fi ; - fi ; -enddef ; - -vardef lmt_do_function = - image ( - pushparameters "function" ; - save sx, sy, lw, tl, tr, ts, tt, currentpen ; transform tr, tt ; pen currentpen ; - sx := getparameter "sx" ; - sy := getparameter "sy" ; - lw := getparameter "linewidth" ; - tl := 1/20 ; % tick length - ts := 1/10 ; % text scale - tr := identity xyscaled(10/sx,10/sy) ; - tt := identity xyscaled(ts/sx,ts/sy) ; - pickup pencircle xyscaled(lw/sx,lw/sy) ; - draw image ( - save xmin, xmax, xstep, xsmall, xlarge, ymin, ymax, ystep, ysmall, ylarge, p ; - save code, option, txl, txs, tyl, tys, swap ; - string code, option ; - path txl, txs, tyl, tys ; boolean swap ; - picture p ; - - xmin := getparameter "xmin" ; - xmax := getparameter "xmax" ; - xstep := getparameter "xstep" ; - xsmall := getparameter "xsmall" ; - xlarge := getparameter "xlarge" ; - ymin := getparameter "ymin" ; - ymax := getparameter "ymax" ; - ystep := getparameter "ystep" ; - ysmall := getparameter "ysmall" ; - ylarge := getparameter "ylarge" ; - code := getparameter "code" ; - swap := getparameter "reverse" ; - - p := image ( - - if (getparametercount "functions") > 0 : - for s = 1 upto getparametercount "functions" : - pushparameters "functions" s ; - lmt_do_function_p ( - getparameterdefault "xmin", - getparameterdefault "xmax", - getparameterdefault "xstep", - getparameterdefault "code", - getparameterdefault "shape", - getparameterdefault "close", - getparameterdefault "fillcolor", - getparameterdefault "drawsize", - getparameterdefault "drawcolor", - getparameterdefault "pointsymbol", - getparameterdefault "pointsize", - getparameterdefault "pointcolor" - ) ; - popparameters ; - endfor ; - elseif code <> "" : - lmt_do_function_p ( - getparameter "xmin", - getparameter "xmax", - getparameter "xstep", - getparameter "code", - getparameter "shape", - getparameter "close", - getparameter "fillcolor", - getparameter "drawsize", - getparameter "drawcolor", - getparameter "pointsymbol", - getparameter "pointsize", - getparameter "pointcolor" - ) ; - fi ; - ) ; - - if not swap : draw p fi ; - - option := getparameter "xticks" ; - if option = "top" : - txs := (0,0) -- (0,tl) ; - elseif option = "bottom" : - txs := (0,-tl) -- (0,0) ; - else : - txs := (0,-tl) -- (0,tl) ; - fi ; - - option := getparameter "yticks" ; - if option = "left" : - tys := (-tl,0) -- (0,0) ; - elseif option = "right" : - tys := (0,0) -- (tl,0) ; - else : - tys := (-tl,0) -- (tl,0) ; - fi ; - - txs := txs transformed tr ; - tys := tys transformed tr ; - txl := txs scaled 2 ; - tyl := tys scaled 2 ; - - % this arrow head scaling is for Alan to sort out ... - - xmin := getparameterdefault "xfirst" xmin ; - xmax := getparameterdefault "xlast" xmax ; - ymin := getparameterdefault "yfirst" ymin ; - ymax := getparameterdefault "ylast" ymax ; - - if hasoption "frame" "ticks,sticks" : - if xsmall > 0 : - if hasoption "frame" "horizontal" : - for i = ymin step ((ymax-ymin)/ysmall) until ymax : - draw (xmin,i) -- (xmax,i) ; - endfor ; - dodraw (xmin,ymin) ; % flush snippets - fi ; - fi ; - if ysmall > 0 : - if hasoption "frame" "vertical" : - for i = xmin step ((xmax-xmin)/xsmall) until xmax : - draw (i,ymin) -- (i,ymax) ; - endfor ; - dodraw (xmin,ymin) ; % flush snippets - fi ; - fi ; - fi ; - - option := getparameter "xarrow" ; - if option = "yes" : - save ahlength ; ahlength := tl ; - % save ahangle ; ahangle := 100/sy ; - drawarrow (xmin,0) -- (xmax,0) ; - else : - draw (xmin,0) -- (xmax,0) ; - fi ; - - option := getparameter "yarrow" ; - if option = "yes" : - save ahlength ; ahlength := tl ; - % save ahangle ; ahangle := 100/sx ; - drawarrow (xmin,ymin) -- (xmin,ymax) ; - else : - draw (xmin,ymin) -- (xmin,ymax) ; - fi ; - - if hasoption "frame" "yes" : - draw (xmin,ymin) -- (xmax,ymin) -- (xmax,ymax) -- (xmin,ymax) -- cycle ; - fi ; - - if hasoption "frame" "ticks,sticks" : - if xsmall > 0 : - if hasoption "frame" "horizontal" : - for i = ymin step ((ymax-ymin)/ysmall) until ymax : - draw (xmin,i) -- (xmax,i) ; - endfor ; - fi ; - if hasoption "frame" "bottom" : - txs := ((0,0) -- (0,tl)) if hasoption "frame" "sticks" : rotated 180 fi ; - txs := txs transformed tr ; - for i = xmin step ((xmax-xmin)/xsmall) until xmax : - nodraw txs shifted (i,ymin) ; - endfor ; - fi ; - if hasoption "frame" "top" : - txs := (0,0) -- (0,-tl) if hasoption "frame" "sticks" : rotated 180 fi ; - txs := txs transformed tr ; - for i = xmin step ((xmax-xmin)/xsmall) until xmax : - nodraw txs shifted (i,ymax) ; - endfor ; - fi ; - dodraw (xmin,ymin) ; % flush snippets - fi ; - if ysmall > 0 : - if hasoption "frame" "vertical" : - for i = xmin step ((xmax-xmin)/xsmall) until xmax : - draw (i,ymin) -- (i,ymax) ; - endfor ; - fi ; - if hasoption "frame" "left" : - tys := (0,0) -- (tl,0) if hasoption "frame" "sticks" : rotated 180 fi ; - tys := tys transformed tr ; - for i = ymin step ((ymax-ymin)/ysmall) until ymax : - nodraw tys shifted (xmin,i) ; - endfor ; - fi ; - if hasoption "frame" "right" : - tys := (0,0) -- (-tl,0) if hasoption "frame" "sticks" : rotated 180 fi ; - tys := tys transformed tr ; - for i = ymin step ((ymax-ymin)/ysmall) until ymax : - nodraw tys shifted (xmax,i) ; - endfor ; - fi ; - dodraw (xmin,ymin) ; % flush snippets - fi ; - fi ; - - if xsmall > 0 : - for i = xmin step xsmall until xmax : - nodraw txs shifted (i,0) ; - endfor ; - fi ; - - if xlarge > 0 : - for i = xmin step xlarge until xmax : - nodraw txl shifted (i,0) ; - endfor ; - dodraw (xmin,0) ; % flush snippets - elseif xsmall > 0 : - dodraw (xmin,0) ; % flush snippets - fi ; - - if ysmall > 0 : - for i = ymin step ysmall until ymax : - nodraw tys shifted (xmin,i) ; - endfor ; - fi ; - - if ylarge > 0 : - for i = ymin step ylarge until ymax : - nodraw tyl shifted (xmin,i) ; - endfor ; - dodraw (xmin,ymin) ; % flush snippets - elseif ysmall > 0 : - dodraw (xmin,ymin) ; % flush snippets - fi ; - - if swap : draw p fi ; - - if xlarge > 0 : - option := getparameter "xlabels" ; - if option <> "no" : - for i = xmin step xlarge until xmax : - if ((i <> 0) and ((option <> "nolimits") or ((i > xmin) and (i < xmax)))) : - draw textext.bot(decimal i) transformed tt - shifted (i,1.25*(ypart point 0 of txl)) ; - fi ; - endfor ; - fi ; - fi ; - - if ylarge > 0 : - option := getparameter "ylabels" ; - if option <> "no" : - for i = ymin step ylarge until ymax : - if ((i <> 0) and ((option <> "nolimits") or ((i > ymin) and (i < ymax)))) : - draw textext.lft(decimal i) transformed tt - shifted (xmin+1.25*(xpart point 0 of tyl),i) ; - fi ; - endfor ; - fi ; - fi ; - - option := getparameter "xcaption" ; - if (option <> "") : - draw textext.bot(option) transformed tt - shifted (xmin,-tl) - shifted center bottomboundary currentpicture ; - fi ; - - option := getparameter "ycaption" ; - if (option <> "") : - draw textext.lft(option) transformed tt - shifted (xmin-tl,0) - shifted center leftboundary currentpicture ; - fi ; - ) - - xyscaled(sx,sy) ; - - setbounds currentpicture to - boundingbox currentpicture - enlarged (getparameter "offset") ; - - popparameters ; - ) -enddef ; - -% Don't use this one! - -presetparameters "mesh" [ - trace = false, - auto = false, - step = 0.05, - % box = ... - % paths = { ..., ..., ... } -] ; - -def lmt_mesh = applyparameters "mesh" "lmt_do_mesh" enddef ; - -vardef lmt_do_mesh = - image ( - save p, b ; path p, b ; - pushparameters "mesh" ; - if getparameter "auto" : - b := if hasparameter "box" : getparameter "box" else : OverlayBox fi ; - for i=1 upto getparametercount "paths" : - p := getparameter "paths" i ; - p := meshed(p if not cycle p : -- cycle fi,b,getparameter "step") ; - if getparameter "trace" : - draw p ; - fi ; - runscript("mp.lmt_mesh_update()") i p ; - endfor ; - elseif getparameter "trace" : - for i=1 upto getparametercount "paths" : - p := getparameter "paths" i ; - draw p if not cycle p : -- cycle fi ; - endfor ; - fi ; - popparameters ; - runscript("mp.lmt_mesh_set()") ; - ) -enddef ; - -vardef mfun_meshed_clipped(expr pat, box, pct) = - pp := point (arctime pct of pat) of pat ; - if (ypart pp <= lly) or (ypart pp >= ury) or (xpart pp <= llx) or (xpart pp >= urx) : - (cp -- pp) intersection_point bb - else : - pp - fi -enddef ; - -vardef mfun_meshed_clipped(expr pat, box, pct) = - pp := point (arctime pct of pat) of pat ; - if ypart pp <= lly : - if xpart pp <= llx : - (llx, lly) - elseif xpart pp >= urx : - (urx, lly) - else : - (xpart pp, lly) - fi - elseif ypart pp >= ury : - if xpart pp <= llx : - (llx, ury) - elseif xpart pp >= urx : - (urx, ury) - else : - (xpart pp, ury) - fi - elseif xpart pp <= llx : - (llx, ypart pp) - elseif xpart pp >= urx : - (urx, ypart pp) - else : - pp - fi -enddef ; - -vardef meshed(expr pth, box, stp) = - begingroup - save cb, cp, llx, lly, urx, ury, pp, lp, bb ; pair cb, cp, pp ; path bb ; - bb := box enlarged -1/10; - cb := center bb ; - cp := center pth ; - llx := xpart llcorner bb; - lly := ypart llcorner bb; - urx := xpart urcorner bb; - ury := ypart urcorner bb; - lp := arclength pth ; - for i=stp step stp until 1+stp/2 : - cp -- - mfun_meshed_clipped(pth,bb,lp*(i-stp)) -- - mfun_meshed_clipped(pth,bb,lp*(i )) -- - cp -- - endfor cycle - endgroup -enddef ; - -vardef OverlayMesh(expr p, s) = - lmt_mesh [ paths = { meshed(p,OverlayBox,s) } ] -enddef ; - -% charts - -presetparameters "chart" [ - originsize = 1mm, - trace = false, - showlabels = true, - center = false, - - samples = { }, - - cumulative = false, - percentage = false, - maximum = 0, - distance = 1mm, - - % labels = { }, - labelstyle = "", - labelformat = "", - % labelstrut = "auto", - % labelanchor = "", - % labeloffset = 0, - labelfraction = 0.8, - labelcolor = "", - - backgroundcolor = "", - drawcolor = "white", - fillcolors = { % use color palet - "darkred", "darkgreen", "darkblue", - "darkyellow", "darkmagenta", "darkcyan", - "darkgray" - }, - colormode = "global", - - linewidth = .25mm, - - legendcolor = "", - legendstyle = "", - legend = { }, -] ; - -presetparameters "chart:circle" "chart" [ - height = 5cm, - width = 5mm, - labelanchor = "", - labeloffset = 0, - labelstrut = "no", -] ; - -presetparameters "chart:histogram" "chart" [ - height = 5cm, - width = 5mm, - labelanchor = "bot", - labeloffset = 1mm, - labelstrut = "auto", -] ; - -presetparameters "chart:bar" "chart" [ - height = 5mm, - width = 5cm, - labelanchor = "lft", - labeloffset = 1mm, - labelstrut = "no", -] ; - -def lmt_chart_circle = applyparameters "chart:circle" "lmt_do_chart_circle" enddef ; -def lmt_chart_histogram = applyparameters "chart:histogram" "lmt_do_chart_histogram" enddef ; -def lmt_chart_bar = applyparameters "chart:bar" "lmt_do_chart_bar" enddef ; - -def lmt_do_chart_start (expr what) = - pushparameters what ; - save width, height, distance, linewidth, labelgap, labelfraction, value, nofsamples, nofsamplesets ; - save fillcolor, drawcolor, labelcolor, labelstyle, labelformat, labelstrut, labelanchor, colormode ; - string fillcolor, drawcolor, labelcolor, labelstyle, labelformat, labelstrut, labelanchor, colormode ; - height := getparameter "height" ; - width := getparameter "width" ; - distance := getparameter "distance" ; - linewidth := getparameter "linewidth" ; - drawcolor := getparameter "drawcolor" ; - colormode := getparameter "colormode" ; - labelcolor := getparameter "labelcolor" ; - labelgap := getparameter "labeloffset" ; - labelstyle := getparameter "labelstyle" ; - labelformat := getparameter "labelformat" ; - labelstrut := getparameter "labelstrut" ; - labelanchor := getparameter "labelanchor" ; - labelfraction := getparameter "labelfraction" ; - nofsamplesets := getparametercount "samples" ; - nofsamples := getmaxparametercount "samples" ; -enddef ; - -def lmt_do_chart_stop = - if getparameter "center" : - currentpicture := currentpicture shifted - center currentpicture ; - fi - if (getparameter "backgroundcolor") <> "" : - addbackground withcolor getparameter "backgroundcolor" ; - fi - if getparameter "trace" : - save b ; path b ; b := boundingbox currentpicture ; - draw image ( - draw fullcircle scaled 1mm ; - draw b - ) - dashed evenly scaled 1/4 - withpen pencircle scaled .125mm - withcolor "darkgray" ; - fi - popparameters ; -enddef ; - -vardef lmt_do_chart_text(expr s, i, value) = - lmt_text [ - style = labelstyle, - format = labelformat, - strut = labelstrut, - anchor = labelanchor, - offset = labelgap, - color = labelcolor, - text = (getparameterdefault "labels" s i (decimal value)) - background = "", - ] -enddef ; - -def lmt_do_chart_legend = - n := getparametercount "legend" ; - if n > 0 : - save dx, dy, p, l, w, o, d, ddy ; picture l ; - dx := xpart urcorner currentpicture + EmWidth ; - dy := ypart urcorner currentpicture ; - labelcolor := getparameter "legendcolor" ; - labelstyle := getparameter "legendstyle" ; - w := 2EmWidth ; - o := .25EmWidth ; - d := ExHeight ; - ddy := .8LineHeight ; - for i=1 upto n : - dy := dy - ddy ; - l := lmt_text [ - text = getparameter "legend" i, - anchor = "rt" - style = labelstyle, - color = labelcolor, - background = "", - ] ; - fill leftboundary l rightenlarged w - shifted (dx,dy+d) - withcolor getparameter "fillcolors" i ; - draw l - shifted (dx+w+o,dy+d) ; - endfor ; - fi ; -enddef ; - -vardef lmt_do_chart_circle = - image ( - lmt_do_chart_start("chart:circle") ; - if (nofsamplesets > 0) and (nofsamples > 0) : - nofsamplesets := 1 ; - save p, r, s, first, last, total, factor, n, percentage ; - path p, r, s[] ; boolean percentage ; - percentage := getparameter "percentage" ; - total := 0 ; - for i = 1 upto nofsamples : - total := total + getparameter "samples" (1) i ; % () is needed else 1i - endfor ; - factor := 100/total ; - first := 0 ; - p := fullcircle ysized (height) ; - r := origin -- (2*height,0) ; - for i = 1 upto nofsamples : - fillcolor := getparameter "fillcolors" i ; - value := (getparameter "samples" (1) i) * factor ; - last := first + (360 / 100) * value ; - s[i] := ((p cutbefore (r rotated first)) cutafter (r rotated last)) ; - fill origin -- s[i] -- cycle withcolor fillcolor ; - first := last ; - endfor ; - if linewidth > 0 : - if drawcolor = "" : - drawcolor := backgroundcolor ; - fi ; - for i = 1 upto nofsamples : - interim linecap := butt ; - draw origin -- (point 0 of s[i]) withpen pencircle scaled linewidth withcolor drawcolor ; - draw origin -- (point length(s[i]) of s[i]) withpen pencircle scaled linewidth withcolor drawcolor ; - endfor ; - fi ; - if getparameter "showlabels" : - first := 0 ; - for i = 1 upto nofsamples : - value := getparameter "samples" (1) i ; - last := first + (360/100) * value * factor ; - draw lmt_do_chart_text (s,i,value) - shifted ((labelfraction*(height/2),0) rotated ((first+last)/2)) ; - first := last ; - endfor ; - fi ; - lmt_do_chart_legend ; - n := getparameter "originsize" ; - if n > 0 : - fill fullcircle scaled n withcolor "white" ; - fi ; - fi ; - lmt_do_chart_stop ; - ) -enddef ; - -vardef lmt_do_chart_histogram = - image ( - lmt_do_chart_start("chart:histogram") ; - if (nofsamplesets > 0) and (nofsamples > 0) : - save value, maximum, cumulative, maxwidth ; boolean cumulative ; - maximum := getparameter "maximum" ; - cumulative := getparameter "cumulative" ; - if labelanchor = "center" : - labelanchor := "vcenter" ; - fi ; - if maximum = 0 : - for s = 1 upto nofsamplesets : - for i = 1 upto nofsamples : - value := getparameter "samples" s i ; - maximum := if cumulative : - maximum + value ; - else : - max(maximum,value) ; - fi ; - endfor ; - endfor ; - fi ; - if nofsamplesets = 1 : - distance := 0 ; - fi ; - maxwidth := nofsamplesets * nofsamples * width + (nofsamples - 1)* distance ; - value := 0 ; - for s = 1 upto nofsamplesets : - for i = 1 upto nofsamples : - value := if cumulative : value + fi (getparameter "samples" s i) * height / maximum ; - fill unitsquare xyscaled (width,value) - if linewidth > 0 : - if i > 1 : leftenlarged (-linewidth/2) fi - if i < nofsamples : rightenlarged (-linewidth/2) fi - fi - shifted (nofsamplesets*(i-1)*width+(s-1)*width+(i-1)*distance,0) - withcolor getparameter "fillcolors" if colormode = "local" : s else : i fi ; - endfor ; - endfor ; - setbounds currentpicture to unitsquare xyscaled (maxwidth,height) ; - for s = 1 upto nofsamplesets : - if getparameter "showlabels" : - for i = 1 upto nofsamples : - draw lmt_do_chart_text (s,i,getparameter "samples" s i) - shifted (nofsamplesets*((i-1)*width)+width/2+(s-1)*width+(i-1)*distance,0) ; - endfor ; - fi ; - endfor ; - lmt_do_chart_legend ; - fi ; - lmt_do_chart_stop ; - ) -enddef ; - -vardef lmt_do_chart_bar = - - image ( - lmt_do_chart_start("chart:bar") ; - if (nofsamplesets > 0) and (nofsamples > 0) : - save value, maximum, cumulative, maxheight ; boolean cumulative ; - maximum := getparameter "maximum" ; - cumulative := getparameter "cumulative" ; - if labelanchor = "center" : - labelanchor := "hcenter" ; - fi ; - if maximum = 0 : - for s = 1 upto nofsamplesets : - for i = 1 upto nofsamples : - value := getparameter "samples" s i ; - maximum := if cumulative : maximum + value else : max(maximum,value) fi ; - endfor ; - endfor ; - fi ; - if nofsamplesets = 1 : - distance := 0 ; - fi ; - maxheight := nofsamplesets * nofsamples * height + (nofsamples - 1)* distance ; - for s = 1 upto nofsamplesets : - value := 0 ; - for i = 1 upto nofsamples : - value := if cumulative : value + fi (getparameter "samples" s i) * width / maximum ; - fill unitsquare xyscaled (value,height) - if linewidth > 0 : - if i > 1 : topenlarged (-linewidth/2) fi - if i < nofsamples : bottomenlarged (-linewidth/2) fi - fi - shifted (0,maxheight-nofsamplesets*i*height+(s-1)*height-(i-1)*distance) - withcolor getparameter "fillcolors" if colormode = "local" : s else : i fi ; - endfor ; - endfor ; - setbounds currentpicture to unitsquare xyscaled (width,maxheight) ; - if getparameter "showlabels" : - for s = 1 upto nofsamplesets : - for i = 1 upto nofsamples : - draw lmt_do_chart_text (s,i,getparameter "samples" s i) - shifted (0,maxheight-nofsamplesets*(i*height)+height/2+(s-1)*height-(i-1)*distance) ; - endfor ; - endfor ; - fi ; - lmt_do_chart_legend ; - fi ; - lmt_do_chart_stop ; - ) -enddef ; - -%D This one is more complex than needed but I want to trace so I need all those -%D variables. - -presetparameters "shade" [ - alternative = "circular", - path = origin -- cycle, - trace = false - - % alternative = "circular" | "linear" - % domain = { a, b } - % radius = a | { a, b } - % factor = a - % origin = (a,b) | { (a,b), {c, d) } - % vector = { a, b } - % colors = { a, b } - % center = a | { a, b } - % direction = "up" | "down" | "left" | "right" | { a, b } - -] ; - -% TODO: pass colors as strings - -def lmt_shade = applyparameters "shade" "lmt_do_shade" enddef ; - -vardef lmt_do_shade = - image ( - pushparameters "shade" ; - - save domain_min, domain_max, radius_a, radius_b, factor ; - save color_a, color_b, center_a, center_b, alternative, s ; - string color_a, color_b, alternative, s ; pair center_a, center_b ; - - alternative := getparameter "alternative" ; - - mfun_with_shade_method_analyze(getparameter "path") ; - - domain_min := 0 ; - domain_max := 1 ; - - color_a := "white" ; - color_b := "black" ; - - if alternative = "circular" : - center_a := center mfun_shade_path ; - center_b := center_a ; - radius_a := 0 ; - radius_b := mfun_max_radius(mfun_shade_path) ; - factor := 1.2 ; - else : - center_a := llcorner mfun_shade_path ; - center_b := urcorner mfun_shade_path ; - radius_a := 0 ; - radius_b := 0 ; - factor := 0; - fi ; - - if hasparameter "domain" : - domain_min := getparameter "domain" 1 ; - domain_max := getparameter "domain" 2 ; - fi - if hasparameter "radius" : - if numeric getparameter "radius" : - radius_a := 0 ; - radius_b := getparameter "radius" ; - else : - radius_a := getparameter "radius" 1 ; - radius_b := getparameter "radius" 2 ; - fi ; - factor := 1 ; - fi - if hasparameter "factor" : - factor := getparameter "factor" ; - fi - if hasparameter "origin" : - if pair getparameter "origin" : - center_a := getparameter "origin" ; - center_b := center_b ; - else : - center_a := getparameter "origin" 1 ; - center_b := getparameter "origin" 2 ; - fi ; - fi - if hasparameter "colors" : - color_a := getparameter "colors" 1 ; - color_b := getparameter "colors" 2 ; - fi - if hasparameter "direction" : - save a, b, bb ; path bb ; - 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 ; - elseif s = "down" : - p_a := xpart shadeddown ; - p_b := ypart shadeddown ; - elseif s = "left" : - p_a := xpart shadedleft ; - p_b := ypart shadedleft ; - elseif s = "right" : - p_a := xpart shadedright ; - p_b := ypart shadedright ; - fi - else : - p_a := getparameter "direction" 1 ; - p_a := getparameter "direction" 2 ; - fi - if p_a >= 0 : - center_a := point p_a of bb ; - fi - if p_b >= 0 : - center_b := point p_b of bb ; - fi - fi ; - if hasparameter "center" : - save cx, cy ; - if numeric getparameter "center" : - cx := getparameter "center" ; - cx := cy ; - % elseif pair getparameter "center" : - % cx := xpart getparameter "center" ; - % cy := ypart getparameter "center" ; - else : - cx := getparameter "center" 1 ; - cy := getparameter "center" 2 ; - fi - center_a := center mfun_shade_path shifted ( - cx * bbwidth (mfun_shade_path)/2, - cy * bbheight(mfun_shade_path)/2 - ) ; - elseif hasparameter "vector" : - center_a := point (getparameter "vector" 1) of mfun_shade_path ; - center_b := point (getparameter "vector" 2) of mfun_shade_path ; - fi - fill mfun_shade_path - withprescript "sh_domain=" & decimal domain_min & " " & decimal domain_max - withprescript "sh_transform=yes" - withprescript "sh_color=into" - withprescript "sh_color_a=" & colordecimals color_a - withprescript "sh_color_b=" & colordecimals color_b - withprescript "sh_first=" & ddecimal point 0 of mfun_shade_path % 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 alternative = "linear" : - withprescript "sh_type=linear" - % withprescript "sh_factor=1" - withprescript "sh_factor=" & decimal factor - withprescript "sh_center_a=" & ddecimal center_a - withprescript "sh_center_b=" & ddecimal center_b - else : - withprescript "sh_type=circular" - % withprescript "sh_factor=1.2" - withprescript "sh_factor=" & decimal factor - withprescript "sh_center_a=" & ddecimal center_a - withprescript "sh_center_b=" & ddecimal center_b - withprescript "sh_radius_a=" & decimal radius_a - withprescript "sh_radius_b=" & decimal radius_b - fi ; - if getparameter "trace" : - draw fullcircle scaled 1mm shifted center_a ; - draw fullsquare scaled 2mm shifted center_b ; - draw textext.top("\strut\ttx center a") ysized LineHeight shifted center_a shifted (0, 2mm) ; - draw textext.bot("\strut\ttx center b") ysized LineHeight shifted center_b shifted (0,-2mm) ; - if alternative = "circular" : -% draw fullcircle scaled ( radius_a * 2) shifted center_a dashed evenly ; -% draw fullcircle scaled (factor * radius_b * 2) shifted -center_b dashed evenly ; - draw fullcircle scaled ( radius_a) shifted center_a dashed evenly ; - draw fullcircle scaled (factor * radius_b) shifted -center_b dashed evenly ; - fi - fi - popparameters ; - ) -enddef ; - -% This is very experimental and will first be tested by a few users who -% are interested in this. - -presetparameters "contour" [ - xmin = 0, - xmax = 0, - ymin = 0, - ymax = 0, - xstep = 0, - ystep = 0, - levels = 10, - % colors = { }, % used when set - preamble = "", - function = "x + y", - color = "lin(l)", % l/n - background = "bitmap", % bitmap | shape | band - foreground = "auto", % cell| edge | shape | auto: bitmap/edge shape/shape - linewidth = .25, - backgroundcolor = "black", - linecolor = "gray", - xformat = "@0.2N", - yformat = "@0.2N", - zformat = "@0.2N", - xstyle = "", - ystyle = "", - zstyle = "", - - width = 0, % auto when 0 - height = 0, % auto when 0 - - trace = false, - checkresult = false, - defaultnan = 0, - defaultinf = 0, - - legend = "all", % x | y | z | function | range | all (but range) - legendheight = LineHeight, - legendwidth = LineHeight, - legendgap = 0, - legenddistance = EmWidth, - textdistance = 2EmWidth/3, - functiondistance = ExHeight, - functionstyle = "", - - level = 4096, % for selecting one (can't be too large for scaled) - - axisdistance = ExHeight, - axislinewidth = .25, - axisoffset = ExHeight/4, - axiscolor = "black", - ticklength = ExHeight, - - xtick = 5, - ytick = 5, - xlabel = 5, - ylabel = 5, - -] ; - -% we can as well push ... - -def lmt_contour = applyparameters "contour" "lmt_do_contour" enddef ; - -def mfun_only_draw = addto currentpicture doublepath enddef ; -def mfun_only_fill = addto currentpicture contour enddef ; -def mfun_only_fillup text t = addto currentpicture doublepath t withpostscript "both" enddef ; -def mfun_only_nodraw text t = addto currentpicture doublepath t withpostscript "collect" enddef ; -def mfun_only_nofill text t = addto currentpicture contour t withpostscript "evenodd" enddef ; -def mfun_only_eofill text t = addto currentpicture contour t withpostscript "collect" enddef ; - -def lmt_do_contour_shortcuts = - save D ; let D = mfun_only_draw ; - save E ; let E = mfun_only_eofill ; - save F ; let F = mfun_only_fill ; - save U ; let U = mfun_only_fillup ; - save d ; let d = mfun_only_nodraw ; - save e ; let f = mfun_only_eofill ; - save f ; let f = mfun_only_nofill ; - save C ; let C = cycle ; - save B ; let B = controls ; - save A ; let A = and ; -enddef ; - -def lmt_do_contour_band = - lua.mp.lmt_contours_edge_set_by_band() ; - for v=1 upto lua.mp.lmt_contours_nofvalues() : - draw image ( - lua.mp.lmt_contours_edge_get_band(v) ; - ) - withcolor lua.mp.lmt_contours_color(v) ; - endfor ; -enddef; - -def lmt_do_contour_cell(expr dx,dy) = - lua.mp.lmt_contours_edge_set_by_cell() ; - draw image ( - if level = 4096 : - for v=1+1 upto lua.mp.lmt_contours_nofvalues() : - lua.mp.lmt_contours_edge_get_cell(v) ; - endfor ; - else : - lua.mp.lmt_contours_edge_get_cell(level) ; - fi - ) - if (dx <>0) or (dy <> 0) : shifted (dx,dy) fi - withcolor getparameter "linecolor" - withpen pencircle scaled getparameter "linewidth" ; -enddef ; - -def lmt_do_contour_edge(expr dx, dy) = - lua.mp.lmt_contours_edge_set() ; - draw image ( - if level = 4096 : - for v=1+1 upto lua.mp.lmt_contours_nofvalues() : - lua.mp.lmt_contours_edge_paths(v); - endfor ; - else : - lua.mp.lmt_contours_edge_paths(level); - fi - ) - if (dx <>0) or (dy <> 0) : shifted (dx,dy) fi - withcolor getparameter "linecolor" - withpen pencircle scaled getparameter "linewidth" ; -enddef ; - -def lmt_do_contour_edges(expr dx, dy) = - lua.mp.lmt_contours_edge_set() ; - if level = 4096 : - for v=1+1 upto lua.mp.lmt_contours_nofvalues() : - draw image ( - lua.mp.lmt_contours_edge_paths(v); - ) - if (dx <>0) or (dy <> 0) : shifted (dx,dy) fi - withpen pencircle scaled getparameter "linewidth" - withcolor lua.mp.lmt_contours_color(v) ; - endfor ; - else : - draw image ( - lua.mp.lmt_contours_edge_paths(level); - ) - if (dx <>0) or (dy <> 0) : shifted (dx,dy) fi - withpen pencircle scaled getparameter "linewidth" - withcolor lua.mp.lmt_contours_color(level) ; - fi ; -enddef ; - -def lmt_do_contour_cells(expr dx, dy) = - lua.mp.lmt_contours_edge_set_by_cell() ; - if level = 4096 : - for v=1+1 upto lua.mp.lmt_contours_nofvalues() : - draw image ( - lua.mp.lmt_contours_edge_get_cell(v) ; - ) - if (dx <>0) or (dy <> 0) : shifted (dx,dy) fi - withpen pencircle scaled getparameter "linewidth" - withcolor lua.mp.lmt_contours_color(v) ; - endfor ; - else : - draw image ( - lua.mp.lmt_contours_edge_get_cell(level) ; - ) - if offset : shifted (-1/2,-1/2) fi - withpen pencircle scaled getparameter "linewidth" - withcolor lua.mp.lmt_contours_color(v) ; - fi ; -enddef ; - -def lmt_do_contour_shape(expr dx, dy) = - draw image ( - if level = 4096 : - for v=1+1 upto lua.mp.lmt_contours_nofvalues() : - lua.mp.lmt_contours_shape_paths(v); - endfor ; - else : - lua.mp.lmt_contours_shape_paths(level); - lua.mp.lmt_contours_shape_paths(1); - fi - ) - if (dx <>0) or (dy <> 0) : shifted (dx,dy) fi - withcolor getparameter "linecolor" - withpen pencircle scaled getparameter "linewidth" ; -enddef ; - -def lmt_do_contour_bitmap = - lua.mp.lmt_contours_bitmap_set() ; - lua.mp.lmt_contours_bitmap_get() ; -enddef ; - -def lmt_do_contour_shades(expr outlines) = - lua.mp.lmt_contours_shade_set(outlines) ; - if level = 4096 : - for v=1 upto lua.mp.lmt_contours_nofvalues() : % no + 1 here - draw image ( - lua.mp.lmt_contours_shade_paths(v) ; - ) - withpen pencircle scaled 0 - withcolor lua.mp.lmt_contours_color(v) ; - endfor ; - else : - draw image ( - lua.mp.lmt_contours_shade_paths(level); - ) - withpen pencircle scaled 0 - withcolor lua.mp.lmt_contours_color(level) ; - fi ; -enddef ; - -def lmt_load_mlib_cnt = - runscript("lua.registercode('mlib-cnt')"); - extra_beginfig := extra_beginfig & % todo: use different hook - "runscript(" & ditto & "mp.lmt_contours_cleanup()" & ditto & ")" ; - let lmt_load_mlib_cnt = relax ; -enddef ; - -vardef lmt_do_contour = - image ( - - lmt_load_mlib_cnt ; - - pushparameters "contour" ; - - lua.mp.lmt_contours_start() ; - - % graphic - - save bg, fg, nx, ny, trace, level, b, done ; string bg, fg ; boolean trace, done ; path b ; - - bg := getparameter "background" ; - fg := getparameter "foreground" ; - nx := lua.mp.lmt_contours_nx() ; - ny := lua.mp.lmt_contours_ny() ; - trace := getparameter "trace" ; - level := getparameter "level" ; - done := true ; - - begingroup ; - - lmt_do_contour_shortcuts ; - - if bg = "band" : - lmt_do_contour_band ; - b := boundingbox currentpicture ; - if (fg = "auto") or (fg = "cell") : - lmt_do_contour_cell(0,0) ; - elseif (fg = "edge") : - lmt_do_contour_edge(0,0) ; % true ? - fi ; - - elseif bg = "bitmap" : - - lmt_do_contour_bitmap ; - b := boundingbox currentpicture ; - if (fg = "auto") or (fg = "cell") : - lmt_do_contour_cell(-1/2,-1/2) ; - elseif (fg = "edge") : - lmt_do_contour_edge(-1/2,-1/2) ; - fi ; - - elseif bg = "shape" : - - lmt_do_contour_shades((fg = "auto") or (fg = "shape")) ; - b := boundingbox currentpicture ; - if (fg == "auto") or (fg = "shape") : - lmt_do_contour_shape(0,0) ; - elseif fg == "cell" : - lmt_do_contour_cell(-1,-1) ; - elseif fg == "edge" : - lmt_do_contour_edge(-1,-1) ; - fi ; - - % currentpicture := currentpicture reflectedabout ( (0, ny/2), (nx,ny/2) ) ; - - elseif fg = "cell" : - - lmt_do_contour_shortcuts ; - lmt_do_contour_cells(0,0) ; - b := boundingbox currentpicture ; - - elseif fg = "edge" : - - lmt_do_contour_shortcuts ; - lmt_do_contour_edges(0,0) ; - b := boundingbox currentpicture ; - - else : - - done := false ; - - fi ; - - endgroup ; - - if done : - - save w, h, cx, cy ; - - cx := - bbwidth (b)/(nx - 1) ; - cy := - bbheight(b)/(ny - 1) ; - clip currentpicture to b - leftenlarged cx rightenlarged cx - topenlarged cy bottomenlarged cy ; - currentpicture := currentpicture - shifted (cx,cy) ; - - w := getparameter "width" ; - h := getparameter "height" ; - - % axis - - save xtic, ytic, auto ; boolean auto ; - - xtic := getparameter "xtick" ; - ytic := getparameter "ytick" ; - auto := (w = 0) and (h = 0) ; - - % resize - - if w <> 0 : - if h <> 0 : - currentpicture := currentpicture xysized (w,h) ; - else : - currentpicture := currentpicture xsized w ; - fi ; - elseif h <> 0 : - currentpicture := currentpicture ysized h ; - fi ; - if w = 0 : - w := bbwidth(currentpicture) ; - fi ; - if h = 0 : - h := bbheight(currentpicture) ; - fi ; - - % legend - - if hasoption "legend" "all,x,y,z,range" : - - save u, s, sx, sy, ax, ay, ao, al, at, tl, ox, oy, lg, tx, ty, wx, hx, ry, fmt, pmin, pmax ; string fmt; picture pmin, pmax ; - - % move some in the ifs - - if hasoption "legend" "all,z" : - - % colorbar - - fmt := lua.mp.lmt_contours_format() ; - pmin := lmt_text [ format = fmt, text = decimal lua.mp.lmt_contours_minmean() ] ; - pmax := lmt_text [ format = fmt, text = decimal lua.mp.lmt_contours_maxmean() ] ; - wx := max(bbwidth(pmin),bbwidth(pmax)) ; - hx := bbheight(pmin) ; - - else : - - hx := 0; - - fi ; - - if auto : - % u := 1 ; - u := lua.mp.lmt_contours_ny() / 100 ; - ry := 4u ; - sy := 5u ; - sx := 5u ; - lg := 0 ; - ox := 5u ; - oy := - sy/2 + ry/2 ; - tx := 2u ; - ty := 1u ; - ax := 1u ; - ay := 1u ; - ao := u ; - al := u/8 ; - at := 3u/2 ; - al := u/4 ; - else : - ry := 0 ; - sy := getparameter "legendheight" ; - sx := getparameter "legendwidth" ; - lg := getparameter "legendgap" ; - ox := getparameter "legenddistance" ; - oy := - sy/2 + hx/2 ; - tx := getparameter "textdistance" ; - ty := getparameter "functiondistance" ; - ax := getparameter "axisdistance" ; - ay := ax ; - ao := getparameter "axisoffset" ; - at := getparameter "ticklength" ; - al := getparameter "axislinewidth" ; - fi ; - - if hasoption "legend" "all,z" : - - save dy ; dy := h ; - - for v=1 upto lua.mp.lmt_contours_nofvalues() : - dy := dy - sy ; - fill unitsquare xyscaled (sx,sy) - shifted (w+ox,dy) - withcolor lua.mp.lmt_contours_color(v) ; - draw - lmt_text [ - trace = trace, - anchor = "llft", - format = fmt, - text = decimal lua.mp.lmt_contours_value(v), - style = getparameter "zstyle", - position = (wx,0), - background = "", - ] - if ry <> 0 : ysized (ry) fi - shifted (w+ox+tx+sx,dy+sy+oy) - ; - dy := dy - lg ; - endfor ; - - fi ; - - if hasoption "legend" "x,all" : - - save n, d, s, xmin, xmax, xlab ; - - xmin := getparameter "xmin" ; - xmax := getparameter "xmax" ; - xlab := getparameter "xlabel" ; - - draw image ( - interim linecap := butt ; - draw ((0,0) -- (w,0)) ; - n := al/2 ; s := (w - al) / xtic ; d := (xmax - xmin) / xtic ; - for i=xmin step d until xmax : - draw (n,0) -- (n,-at) ; - n := n + s ; - endfor ; - ) shifted (0,-ay) - withpen pencircle scaled al - withcolor getparameter "axiscolor" - ; - - if hasoption "legend" "label,all" : - - draw image ( - n := al/2 ; s := (w - al) / xlab ; d := (xmax - xmin) / xlab ; - for i=xmin step d until xmax : - draw lmt_text [ - trace = trace, - anchor = "bot", - format = getparameter "xformat", - style = getparameter "xstyle", - text = decimal i - background = "", - ] - if ry <> 0 : ysized (ry) fi - shifted (n,-at-ao) - ; - n := n + s ; - endfor ; - ) shifted (0,-ay) ; - - fi ; - - fi ; - - if hasoption "legend" "y,all" : - - save n, d, s, ymin, ymax, ylab ; - - ymin := getparameter "ymin" ; - ymax := getparameter "ymax" ; - ylab := getparameter "ylabel" ; - - draw image ( - interim linecap := butt ; - draw ((0,0) -- (0,h)) ; - n := al/2 ; s := (h - al) / ytic ; d := (ymax - ymin) / ytic ; - for i=ymin step d until ymax : - draw (0,n) -- (-at,n) ; - n := n + s ; - endfor ; - ) shifted (-ax,0) - withpen pencircle scaled al - withcolor getparameter "axiscolor" ; - ; - - if hasoption "legend" "label,all" : - - draw image ( - n := al/2 ; s := (h - al) / ylab ; d := (ymax - ymin) / ylab ; - for i=ymin step d until ymax : - draw lmt_text [ - trace = trace, - anchor = "lft", - format = getparameter "yformat", - style = getparameter "ystyle", - text = decimal i - background = "", - ] - if ry <> 0 : ysized (ry) fi - shifted (-at-ao,n) - ; - n := n + s ; - endfor ; - ) shifted (-ax,0) ; - - fi ; - - fi ; - - if hasoption "legend" "range,all" : - - % range - - save d ; d := ypart llcorner currentpicture ; - - draw - lmt_text [ - trace = trace, - anchor = "bot", - text = lua.mp.lmt_contours_range() - background = "", - ] - if ry <> 0 : ysized (ry) fi - shifted (w/2,d-ty) - ; - - % minmax - - draw - lmt_text [ - trace = trace, - anchor = "lrt", - text = lua.mp.lmt_contours_xrange() - background = "", - ] - if ry <> 0 : ysized (ry) fi - shifted (0,d-ty) - ; - - draw - lmt_text [ - trace = trace, - anchor = "llft", - text = lua.mp.lmt_contours_yrange() - background = "", - ] - if ry <> 0 : ysized (ry) fi - shifted (w,d-ty) - ; - - fi ; - - if hasoption "legend" "function,all" : - - % formula - - draw - lmt_text [ - trace = trace, - anchor = "bot", - style = getparameter "functionstyle", - text = lua.mp.lmt_contours_function() - background = "", - ] - if ry <> 0 : ysized (ry) fi - shifted (w/2,ypart llcorner currentpicture - ty) - ; - - fi ; - - if trace : - draw boundingbox currentpicture - dashed evenly - withpen pencircle scaled al ; - fi ; - - fi ; - - fi ; - - lua.mp.lmt_contours_stop() ; - - popparameters ; - ) -enddef ; - -newinternal svgforcecmyk ; svgforcecmyk := 0 ; - -vardef svgcolor(expr r, g, b) = - if svgforcecmyk > 0 : - (1-r,1-g,1-b,0) % simple: no black component, kind of ok for emoji - else : - (r,g,b) - fi -enddef ; - -vardef svgcmyk(expr c, m, y, k) = - (c,m,y,k) -enddef ; - -vardef svggray(expr s) = - s -enddef ; - -presetparameters "svg" [ - filename = "", - fontname = "", - colormap = "", - % unicode = 0, - width = 0, - height = 0, - origin = false, - offset = 0, -] ; - -def lmt_svg = applyparameters "svg" "lmt_do_svg" enddef ; - -vardef lmt_do_svg = - save w, h, o; - image ( - pushparameters "svg" ; - w := getparameter "width" ; - h := getparameter "height" ; - o := getparameter "offset" ; - lua.mp.lmt_svg_include() ; - if getparameter "origin" : - currentpicture := currentpicture shifted -llcorner currentpicture ; - fi ; - popparameters ; - if o <> 0 : - setbounds currentpicture to boundingbox currentpicture enlarged o ; - fi ; - ) - if w > 0 : - if h > 0 : xysized(w,h) else : xsized(w) fi - else : - if h > 0 : ysized(h) fi - fi -enddef ; - -% Another experiment. Parameters might change pending a discussion between Alan -% and me. - -presetparameters "surface" [ - code = "x + y", - color = "f, 0, 0", - linecolor = 1, - xmin = -1, - xmax = 1, - ymin = -1, - ymax = 1, - xstep = .1, - ystep = .1, - snap = .01, - xvector = { -0.7, -0.7 }, - yvector = { 1, 0 }, - zvector = { 0, 1 }, - light = { 3, 3, 10 }, - bright = 100, - clip = false, - lines = true, - linecolor = 1, - % axis = { } - % clipaxis = false - axiscolor = "gray" - axislinewidth = 1/2, -] ; - -def lmt_surface = applyparameters "surface" "lmt_do_surface" enddef ; - -vardef lmt_do_surface = - image ( - - lmt_load_mlib_cnt ; - - pushparameters "surface" ; - - save currentpen; pen currentpen ; - currentpen := pencircle scaled .25 ; - - interim linejoin := butt ; - - lmt_do_contour_shortcuts ; - - lua.mp.lmt_surface_do() ; - - currentpicture := currentpicture ysized getparameter "height" ; - - if hasparameter "axis" : - - save p ; picture p ; p := image ( - if hasparameter "axis" 1 : - draw ((origin) -- unitvector(getparameter "xvector")) scaled (getparameter "axis" 1) ; - fi ; - if hasparameter "axis" 2 : - draw ((origin) -- unitvector(getparameter "yvector")) scaled (getparameter "axis" 2) ; - fi ; - if hasparameter "axis" 3 : - draw ((origin) -- unitvector(getparameter "zvector")) scaled (getparameter "axis" 3) ; - fi ; - ) ; - - if getparameterdefault "clipaxis" false : - clip p to boundingbox currentpicture ; - fi ; - - draw p - withpen pencircle scaled getparameter "axislinewidth" - withcolor getparameter "axiscolor" - ; - - fi ; - - popparameters ; - ) -enddef ; - -% I can make a variant that avoids the lmt_do ... and does an immediate function -% call instead. - -presetparameters "mpsglyphs" [ - name = "dummy", - units = 1000, -] ; - -presetparameters "mpsglyph" [ - category = "dummy", - unicode = 0, - % unichar = "" -] ; - -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 ; - -% Again an experiment (todo: the faster method): - -def lmt_remaptext = runscript("mp.lmt_do_remaptext()") enddef ; - -triplet mfun_tt_s ; - -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,catcoderegime) ; - mfun_tt_s := lua.mp.mf_map_move(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 svgtext(expr t) = - save p ; picture p ; - % mfun_tt_s := (0,0,0) ; - % mfun_tt_r := (0,0,0) ; - p := rawmaptext(t) ; - p - if (mfun_labtype.drt >= 10) : % drt etc - shifted (0,ypart center p) - fi - shifted ( - - mfun_labshift.drt(p) - - (redpart mfun_tt_s,0) - + (greenpart mfun_tt_s,bluepart mfun_tt_s) - ) -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 ; diff --git a/metapost/context/base/mpiv/mp-luas.mpxl b/metapost/context/base/mpiv/mp-luas.mpxl deleted file mode 100644 index 421e82946..000000000 --- a/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/metapost/context/base/mpiv/mp-math.mpxl b/metapost/context/base/mpiv/mp-math.mpxl deleted file mode 100644 index ea8c1cd7c..000000000 --- a/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/metapost/context/base/mpiv/mp-page.mpxl b/metapost/context/base/mpiv/mp-page.mpxl deleted file mode 100644 index 8a4b735e0..000000000 --- a/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/metapost/context/base/mpxl/metafun.mpxl b/metapost/context/base/mpxl/metafun.mpxl new file mode 100644 index 000000000..a6160ef3e --- /dev/null +++ b/metapost/context/base/mpxl/metafun.mpxl @@ -0,0 +1,46 @@ +%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/metapost/context/base/mpxl/minifun.mpxl b/metapost/context/base/mpxl/minifun.mpxl new file mode 100644 index 000000000..6769d26e4 --- /dev/null +++ b/metapost/context/base/mpxl/minifun.mpxl @@ -0,0 +1,35 @@ +%D \module +%D [ file=minifun.mp, +%D version=2018.06.02, +%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 This is a minimal \METAFUN\ instance which can be handy for isolated +%D subruns. + +boolean contextlmtxmode ; contextlmtxmode := if known fontmaking : false else: true fi; + +prologues := 0 ; +mpprocset := 1 ; + +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.mpiv" ; + +string minifunversion ; minifunversion = "minifun xl " & mfun_timestamp; + +let normalend = end ; + +def end = ; message "" ; message minifunversion ; message "" ; endinput ; enddef ; +def bye = ; message "" ; message minifunversion ; message "" ; endinput ; enddef ; diff --git a/metapost/context/base/mpxl/mp-cont.mpxl b/metapost/context/base/mpxl/mp-cont.mpxl new file mode 100644 index 000000000..bc318d4b9 --- /dev/null +++ b/metapost/context/base/mpxl/mp-cont.mpxl @@ -0,0 +1,158 @@ +%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/metapost/context/base/mpxl/mp-lmtx.mpxl b/metapost/context/base/mpxl/mp-lmtx.mpxl new file mode 100644 index 000000000..1f70d0ac1 --- /dev/null +++ b/metapost/context/base/mpxl/mp-lmtx.mpxl @@ -0,0 +1,2281 @@ +%D \module +%D [ file=mp-luas.lmtx, +%D version=2019.06.23, +%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. + +% 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 ; + +boolean context_lmtx ; context_lmtx := true ; + +presetparameters "text" [ + offset = 0, + strut = "auto", + style = "", + color = "", + text = "", + anchor = "", + format = "", + position = origin, + trace = false, + + background = "", % "color", + backgroundcolor = "gray", +] ; + +def lmt_text = applyparameters "text" "lmt_do_text" enddef ; + +vardef lmt_do_text = + image ( + pushparameters "text" ; + save style, anchor, txt, fmt, strt ; + string style, anchor, txt, fmt, strt, bgr ; + interim textextoffset := getparameter "offset" ; + style := getparameter "style" ; + anchor := getparameter "anchor" ; + strt := getparameter "strut" ; + fmt := getparameter "format" ; + txt := getparameter "text" ; + bgr := getparameter "background" ; + if fmt <> "" : + txt := "\formatone{" & fmt & "}{" & txt & "}" + fi ; + if strt = "yes" : + txt := "\strut " & txt ; + elseif strt = "auto" : + txt := "\setstrut\strut " & txt ; + fi ; + if style <> "" : + txt := "\style[" & style & "]{" & txt & "}" ; + fi ; + if getparameter "trace" : + txt := "\ruledhbox{\showstruts" & txt & "}" ; + fi ; + draw + if anchor = "" : thetextext else : scantokens("thetextext." & anchor) fi ( + txt, + getparameter "position" + ) + withcolor getparameter "color" ; + if bgr = "color" : + addbackground withcolor getparameter "backgroundcolor" ; + fi ; + popparameters ; + ) +enddef ; + +presetparameters "grid" [ + nx = 1, dx = 1, + ny = 1, dy = 1, +] ; + +def lmt_grid = applyparameters "grid" "lmt_do_grid" enddef ; + +vardef lmt_do_grid = + image ( + save nx; nx := getparameter "grid" "nx" ; + save ny; ny := getparameter "grid" "ny" ; + save dx; dx := getparameter "grid" "dx" ; + save dy; dy := getparameter "grid" "dy" ; + for i = 0 step dx until nx : + draw ((0,0) -- (0,ny)) shifted (i,0) ; + endfor ; + for i = 0 step dy until ny : + draw ((0,0) -- (nx,0)) shifted (0,i) ; + endfor ; + ) +enddef ; + +def lmt_axis = applyparameters "axis" "lmt_do_axis" enddef ; + +presetparameters "axis" [ + nx = 1, dx = 1, tx = 0, sx = 1, startx = 0, + ny = 1, dy = 1, ty = 0, sy = 1, starty = 0, + + samples = { }, + list = { }, + connect = false, + list = [ close = false ], + samplecolors = { "" }, + axiscolor = "", + textcolor = "", +] ; + +vardef lmt_do_axis = + image ( + + pushparameters "axis" ; + save nx, ny, dx, dy, tx, ty ; + save c, startx, starty ; string c ; + nx := getparameter "nx" ; + ny := getparameter "ny" ; + dx := getparameter "dx" ; + dy := getparameter "dy" ; + tx := getparameter "tx" ; + ty := getparameter "ty" ; + c := getparameter "axiscolor" ; + startx := getparameter "startx" ; + starty := getparameter "starty" ; + draw (startx,starty) -- (startx,ny) withcolor c ; + draw (startx,starty) -- (nx,starty) withcolor c ; + for i = startx step dx until nx : + if (i > startx) or (startx = 0) : + draw ((0,0) -- (0,-2)) shifted (i,starty) withcolor c ; + fi ; + endfor ; + for i = starty step dy until ny : + if (i > starty) or (starty = 0) : + draw ((0,0) -- (-2,0)) shifted (startx,i) withcolor c ; + fi ; + endfor ; + if tx <> 0 : + c := getparameter "textcolor" ; + for i = startx step tx until nx : + if (i > startx) or (startx = 0) : + draw + textext("\strut " & decimal (i)) ysized 2 shifted (i,-4+starty) + withcolor c; + fi ; + endfor ; + fi ; + if ty <> 0 : + c := getparameter "textcolor" ; + for i = starty step ty until ny : + if (i > starty) or (starty = 0) : + draw + textext.lft("\strut " & decimal (i)) ysized 2 shifted (-3+startx,i) + withcolor c; + fi ; + endfor ; + fi ; + + if (getparametercount "samples") > 0 : + if getparameter "connect" : + for s = 1 upto getparametercount "samples" : + c := getparameter "samplecolors" s ; + draw for i = 1 upto getparametercount "samples" s : + if (i > 1) : -- fi (i, getparameter "samples" s i) + endfor + withcolor c ; + endfor ; + else : + for s = 1 upto getparametercount "samples" : + c := getparameter "samplecolors" s ; + for i = 1 upto getparametercount "samples" s : + draw (i, getparameter "samples" s i) + withcolor c ; + endfor ; + endfor ; + fi ; + fi ; + + if (getparametercount "list") > 0 : + + save p, ts, a, d ; path p ; numeric ts ; pair a, d ; + + ts := (getparameter "sy") / 20 ; + + pushparameters "list" ; + for s = 1 upto getparametercount : + pushparameters s ; + + c := getparameter "color" ; + + % p := for i = 1 upto getparametercount "points": + % if (i > 1) : -- fi (getparameter "points" i) + % endfor + % if (getparameterdefault "close" false) : -- cycle fi ; + + % this can become: + + % p := if (getparameterdefault "close" false) : + % % getparameterpath "points" "--" true ; + % getparameterpath "points" true ; + % else : + % % getparameterpath "points" "--" false ; + % getparameterpath "points" ; + % fi ; + + % p := getparameterpath "points" if (getparameterdefault "close" false) : true fi ; + + p := getparameterpath "points" (getparameterdefault "close" false) ; + % p := getparameterpath "points" getparameterdefault "close" false ; + + draw p withcolor c ; + + pushparameters "labels" ; + if (getparametercount) > 0 : + for i = 1 upto getparametercount: + n := i - 1 ; + a := point n of p ; + d := direction n of p ; + draw + textext(getparametertext i true) + ysized ts + shifted (a + .5 * unitvector(d) rotated 90) ; + endfor ; + fi ; + popparameters ; + + pushparameters "texts" ; + if (getparametercount) > 0 : + for i = 1 upto getparametercount : + n := i + 0.5 ; + a := point n of p ; + d := direction n of p ; + draw textext.d(getparametertext i true) + if d < left : rotated 180 shifted (0,-5) else : shifted (0,5) fi + ysized ts + shifted a + rotatedaround(a,angle(d)) ; + endfor ; + fi ; + popparameters ; + + popparameters ; + endfor ; + popparameters ; + fi ; + + popparameters ; + + ) + xyscaled(getparameter "axis" "sx",getparameter "axis" "sy") +enddef ; + +presetparameters "outline" [ + text = "", + kind = "draw", + fillcolor = "", + drawcolor = "", + rulethickness = 1/10, + align = "", + style = "", + width = 0, +] ; + +def lmt_outline = applyparameters "outline" "lmt_do_outline" enddef ; + +vardef lmt_do_outline = + image ( normaldraw image ( + save kind ; string kind ; kind := getparameter "outline" "kind" ; + save align ; string align ; align := getparameter "outline" "align" ; + save style ; string style ; style := getparameter "outline" "style" ; + save width ; numeric width ; width := getparameter "outline" "width" ; + if kind = "draw" : + kind := "d" ; + elseif kind = "fill" : + kind := "f" ; + elseif kind = "both" : + kind := "b" ; + elseif kind = "reverse" : + kind := "r" ; + elseif kind = "fillup" : + kind := "u" ; + fi ; + currentoutlinetext := currentoutlinetext + 1 ; + lua.mp.mf_outline_text( + currentoutlinetext, + if align = "" : + getparameter "outline" "text", + else : + "\framed[align={" & align & "}" + if width > 0 : + & ",width=" & decimal width & "bp" + fi + if style <> "" : + & ",foregroundstyle={" & style & "}" + fi + & ",offset=none,frame=off]{" + & (getparameter "outline" "text") + & "}", + fi, + kind + ) ; + save currentpen; pen currentpen ; + pickup pencircle scaled getparameter "outline" "rulethickness" ; + if kind = "f" : + mfun_do_outline_text_set_f ( + withcolor getparameter "outline" "fillcolor" + ); + elseif kind = "d" : + mfun_do_outline_text_set_d ( + withcolor getparameter "outline" "drawcolor" + ); + elseif kind = "b" : + mfun_do_outline_text_set_b ( + withcolor getparameter "outline" "fillcolor" + ) ( + withcolor getparameter "outline" "drawcolor" + ); + elseif kind = "u" : + mfun_do_outline_text_set_u ( + withcolor getparameter "outline" "fillcolor" + ); + elseif kind = "r" : + mfun_do_outline_text_set_r ( + withcolor getparameter "outline" "drawcolor" + ) ( + withcolor getparameter "outline" "fillcolor" + ) ; + elseif kind = "p" : + mfun_do_outline_text_set_p ; + else : + mfun_do_outline_text_set_n ( + % what to use here + ); + fi ; + lua.mp.mf_get_outline_text(currentoutlinetext) ; + ) ) +enddef ; + +presetparameters "followtext" [ + text = "", + spread = true, + trace = false, + reverse = false, + autoscaleup = "no", + autoscaledown = "no", + path = (fullcircle), +] ; + +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 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 ; + draw followtext ( + if (getparameter "reverse") : reverse fi (getparameter "path"), + getparameter "text" + ) ; + popparameters ; + ) +enddef ; + +presetparameters "arrow" [ + path = origin, + % pen = ..., + kind = "fill", + dimple = 1/5, + scale = 3/4, + penscale = 3, + length = 4, + angle = 45, + location = "end", % middle both + alternative = "normal", % dimpled curved + percentage = 50, + headonly = false, +] ; + +def lmt_arrow = applyparameters "arrow" "lmt_do_arrow" enddef ; + +vardef lmt_do_arrow = + image ( + pushparameters "arrow" ; + save a ; string a ; a := getparameter "alternative" ; + 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" ; + if not getparameter "headonly" : + draw p ; + fi ; + if hasparameter "pen" : + % a cheat: we should have a type check in lua + if hasoption "pen" "auto" : + ahlength := (getparameter "penscale") * boundingradius(currentpen) ; + else : + ahlength := (getparameter "penscale") * boundingradius(getparameterpen "pen") ; + fi ; + fi ; + if k = "draw" : draw elseif k = "both" : filldraw else : fill fi + if l = "middle" : + midarrowhead p ; + elseif l = "percentage" : + arrowheadonpath (p, (getparameter "percentage")/100) ; + elseif l = "both" : + arrowhead p ; + if k = "draw" : draw elseif k = "both" : filldraw else : fill fi + arrowhead reverse p ; + else : + arrowhead p ; + fi ; + popparameters ; + ) +enddef ; + +% from dum + +presetparameters "placeholder" [ + color = "red", + width = 1, + height = 1, + reduction = 0, + alternative = "circle", +] ; + +def lmt_placeholder = applyparameters "placeholder" "lmt_do_placeholder" enddef ; + +def lmt_do_placeholder = + begingroup ; + pushparameters "placeholder" ; + save w, h, d, r, p, c, b, s, q, a ; + numeric w, h, d, r ; path p ; string s, a ; + s := getparameter "color" ; + w := getparameter "width" ; + h := getparameter "height" ; + r := getparameter "reduction" ; + a := getparameter "alternative" ; + d := max(w,h) ; + if cmykcolor resolvedcolor(s) : + cmykcolor c, b ; b := (0,0,0,0) + else : + color c, b ; b := (1,1,1) + fi ; + c := resolvedcolor(s) ; + p := unitsquare xyscaled (w,h) ; + fill p withcolor r[.5c,b] ; + if a = "square" : + vardef q = fullsquare enddef ; + elseif a = "triangle" : + vardef q = fulltriangle rotated (90 * round(uniformdeviate(4))) enddef ; + else : + vardef q = fullcircle enddef ; + fi ; + for i := 1 upto 60 : + fill q + scaled (d/5 randomized (d/5)) + shifted (center p randomized (d)) + withcolor r[c randomized(.3,.9),b] ; + endfor ; + clip currentpicture to p ; + popparameters ; + endgroup ; +enddef ; + +% maybe: + +vardef lmt_connected(text t) = + save p ; path p ; + p := origin t ; + subpath (1,length(p)) of p +enddef ; + +def lmt_connection expr t = + -- t +enddef ; + +% also (todo) + +% % draw lmt_path [ +% % points = [ color = "darkred", size = 6 ], +% % controls = [ color = "darkgreen", size = 4 ], +% % lines = [ color = "darkgray", size = 1 ], +% % shape = [ color = "middlegray", size = 8 ], +% % labels = [ ], +% % path = ((1cm,1cm) -- (1.5cm,1.5cm) .. (2cm,0cm) .. cycle) +% % ] ; +% +% presetparameters "path" [ +% labels = [ +% color = "", +% size = 1 +% ], +% controls = [ +% color = "black", +% size = 2.5 +% ], +% lines = [ +% color = "middlegray", +% size = 1 +% ], +% points = [ +% color = "black", +% size = 4 +% ], +% path = [ +% color = "lightgray", +% size = 5, +% path = origin +% ] +% ] ; +% +% def lmt_path = applyparameters "path" "lmt_do_path" enddef ; +% +% vardef lmt_do_path = +% image ( +% % This one is not that efficient ... we can better inline the drawing routines here, but +% % it's just an interfacing test after all. +% if hasparameter "path" "path" : +% save p ; path p ; p := getparameter "path" "path" ; +% drawpath p +% withpen pencircle scaled (drawoptionsfactor * getparameterdefault "path" "shape" "size" "*") +% withcolor getparameterdefault "path" "shape" "color" "*" +% ; +% if hasparameter "path" "controls" : +% drawcontrollines p +% withpen pencircle scaled (drawoptionsfactor * getparameterdefault "path" "lines" "size" "*" ) +% withcolor getparameterdefault "path" "lines" "color" "*" +% ; +% drawcontrolpoints p +% withpen pencircle scaled (drawoptionsfactor * getparameterdefault "path" "controls" "size" "*") +% withcolor getparameterdefault "path" "controls" "color" "*" +% ; +% fi ; +% if hasparameter "path" "points" : +% drawpoints p +% withpen pencircle scaled (drawoptionsfactor * getparameterdefault "path" "points" "size" "*") +% withcolor getparameterdefault "path" "points" "color" "*" +% ; +% if hasparameter "path" "labels" : +% drawpointlabels p +% withcolor getparameterdefault "path" "labels" "color" "*" +% ; +% fi ; +% fi ; +% fi ; +% ) +% enddef ; + +% Here we use nodraw and dodraw to create efficient axis ticks. Yet another demo +% of coding. + +presetparameters "function" [ + sx = 1mm, + sy = 1mm, + offset = 0, + xmin = 1, + xmax = 1, + xstep = 1, + xsmall = 0, + xlarge = 0, + xlabels = "no", + xticks = "bottom", % top bottom middle + xcaption = "", + ymin = 1, + ymax = 1, + ystep = 1, + ysmall = 0, + ylarge = 0, + % xfirst = 0, + % xlast = 0, + % yfirst = 0, + % ylast = 0, + ylabels = "no", + yticks = "left", % left right middle + ycaption = "", + code = "", + close = false, + shape = "curve", + fillcolor = "", + drawsize = 1, + drawcolor = "", + frame = "", % yes ticks + linewidth = .05mm, + pointsymbol = "", + pointsize = 2, + pointcolor = "", + xarrow = "", + yarrow = "", + reverse = false, +] ; + +def lmt_function = applyparameters "function" "lmt_do_function" enddef ; + +vardef lmt_do_function_p(expr xmin, xmax, xstep, code, shape, close, fcolor, dsize, dcolor, psymbol, psize, pcolor) = + save p, q ; path p, q ; + p := lua.mp.lmt_function_x(xmin,xmax,xstep,code,shape) ; + if close : + q := (xmin,0) -- p -- (xmax,0) -- cycle ; + fill q withcolor fcolor ; + else : + draw p withpen currentpen scaled dsize withcolor dcolor + ; + fi ; + if psize > 0 : + if psymbol = "dot" : + draw image ( + for i = 0 upto length(p) : + draw point i of p ; + endfor ; + ) withpen currentpen scaled psize withcolor pcolor ; + fi ; + fi ; +enddef ; + +vardef lmt_do_function = + image ( + pushparameters "function" ; + save sx, sy, lw, tl, tr, ts, tt, currentpen ; transform tr, tt ; pen currentpen ; + sx := getparameter "sx" ; + sy := getparameter "sy" ; + lw := getparameter "linewidth" ; + tl := 1/20 ; % tick length + ts := 1/10 ; % text scale + tr := identity xyscaled(10/sx,10/sy) ; + tt := identity xyscaled(ts/sx,ts/sy) ; + pickup pencircle xyscaled(lw/sx,lw/sy) ; + draw image ( + save xmin, xmax, xstep, xsmall, xlarge, ymin, ymax, ystep, ysmall, ylarge, p ; + save code, option, txl, txs, tyl, tys, swap ; + string code, option ; + path txl, txs, tyl, tys ; boolean swap ; + picture p ; + + xmin := getparameter "xmin" ; + xmax := getparameter "xmax" ; + xstep := getparameter "xstep" ; + xsmall := getparameter "xsmall" ; + xlarge := getparameter "xlarge" ; + ymin := getparameter "ymin" ; + ymax := getparameter "ymax" ; + ystep := getparameter "ystep" ; + ysmall := getparameter "ysmall" ; + ylarge := getparameter "ylarge" ; + code := getparameter "code" ; + swap := getparameter "reverse" ; + + p := image ( + + if (getparametercount "functions") > 0 : + for s = 1 upto getparametercount "functions" : + pushparameters "functions" s ; + lmt_do_function_p ( + getparameterdefault "xmin", + getparameterdefault "xmax", + getparameterdefault "xstep", + getparameterdefault "code", + getparameterdefault "shape", + getparameterdefault "close", + getparameterdefault "fillcolor", + getparameterdefault "drawsize", + getparameterdefault "drawcolor", + getparameterdefault "pointsymbol", + getparameterdefault "pointsize", + getparameterdefault "pointcolor" + ) ; + popparameters ; + endfor ; + elseif code <> "" : + lmt_do_function_p ( + getparameter "xmin", + getparameter "xmax", + getparameter "xstep", + getparameter "code", + getparameter "shape", + getparameter "close", + getparameter "fillcolor", + getparameter "drawsize", + getparameter "drawcolor", + getparameter "pointsymbol", + getparameter "pointsize", + getparameter "pointcolor" + ) ; + fi ; + ) ; + + if not swap : draw p fi ; + + option := getparameter "xticks" ; + if option = "top" : + txs := (0,0) -- (0,tl) ; + elseif option = "bottom" : + txs := (0,-tl) -- (0,0) ; + else : + txs := (0,-tl) -- (0,tl) ; + fi ; + + option := getparameter "yticks" ; + if option = "left" : + tys := (-tl,0) -- (0,0) ; + elseif option = "right" : + tys := (0,0) -- (tl,0) ; + else : + tys := (-tl,0) -- (tl,0) ; + fi ; + + txs := txs transformed tr ; + tys := tys transformed tr ; + txl := txs scaled 2 ; + tyl := tys scaled 2 ; + + % this arrow head scaling is for Alan to sort out ... + + xmin := getparameterdefault "xfirst" xmin ; + xmax := getparameterdefault "xlast" xmax ; + ymin := getparameterdefault "yfirst" ymin ; + ymax := getparameterdefault "ylast" ymax ; + + if hasoption "frame" "ticks,sticks" : + if xsmall > 0 : + if hasoption "frame" "horizontal" : + for i = ymin step ((ymax-ymin)/ysmall) until ymax : + draw (xmin,i) -- (xmax,i) ; + endfor ; + dodraw (xmin,ymin) ; % flush snippets + fi ; + fi ; + if ysmall > 0 : + if hasoption "frame" "vertical" : + for i = xmin step ((xmax-xmin)/xsmall) until xmax : + draw (i,ymin) -- (i,ymax) ; + endfor ; + dodraw (xmin,ymin) ; % flush snippets + fi ; + fi ; + fi ; + + option := getparameter "xarrow" ; + if option = "yes" : + save ahlength ; ahlength := tl ; + % save ahangle ; ahangle := 100/sy ; + drawarrow (xmin,0) -- (xmax,0) ; + else : + draw (xmin,0) -- (xmax,0) ; + fi ; + + option := getparameter "yarrow" ; + if option = "yes" : + save ahlength ; ahlength := tl ; + % save ahangle ; ahangle := 100/sx ; + drawarrow (xmin,ymin) -- (xmin,ymax) ; + else : + draw (xmin,ymin) -- (xmin,ymax) ; + fi ; + + if hasoption "frame" "yes" : + draw (xmin,ymin) -- (xmax,ymin) -- (xmax,ymax) -- (xmin,ymax) -- cycle ; + fi ; + + if hasoption "frame" "ticks,sticks" : + if xsmall > 0 : + if hasoption "frame" "horizontal" : + for i = ymin step ((ymax-ymin)/ysmall) until ymax : + draw (xmin,i) -- (xmax,i) ; + endfor ; + fi ; + if hasoption "frame" "bottom" : + txs := ((0,0) -- (0,tl)) if hasoption "frame" "sticks" : rotated 180 fi ; + txs := txs transformed tr ; + for i = xmin step ((xmax-xmin)/xsmall) until xmax : + nodraw txs shifted (i,ymin) ; + endfor ; + fi ; + if hasoption "frame" "top" : + txs := (0,0) -- (0,-tl) if hasoption "frame" "sticks" : rotated 180 fi ; + txs := txs transformed tr ; + for i = xmin step ((xmax-xmin)/xsmall) until xmax : + nodraw txs shifted (i,ymax) ; + endfor ; + fi ; + dodraw (xmin,ymin) ; % flush snippets + fi ; + if ysmall > 0 : + if hasoption "frame" "vertical" : + for i = xmin step ((xmax-xmin)/xsmall) until xmax : + draw (i,ymin) -- (i,ymax) ; + endfor ; + fi ; + if hasoption "frame" "left" : + tys := (0,0) -- (tl,0) if hasoption "frame" "sticks" : rotated 180 fi ; + tys := tys transformed tr ; + for i = ymin step ((ymax-ymin)/ysmall) until ymax : + nodraw tys shifted (xmin,i) ; + endfor ; + fi ; + if hasoption "frame" "right" : + tys := (0,0) -- (-tl,0) if hasoption "frame" "sticks" : rotated 180 fi ; + tys := tys transformed tr ; + for i = ymin step ((ymax-ymin)/ysmall) until ymax : + nodraw tys shifted (xmax,i) ; + endfor ; + fi ; + dodraw (xmin,ymin) ; % flush snippets + fi ; + fi ; + + if xsmall > 0 : + for i = xmin step xsmall until xmax : + nodraw txs shifted (i,0) ; + endfor ; + fi ; + + if xlarge > 0 : + for i = xmin step xlarge until xmax : + nodraw txl shifted (i,0) ; + endfor ; + dodraw (xmin,0) ; % flush snippets + elseif xsmall > 0 : + dodraw (xmin,0) ; % flush snippets + fi ; + + if ysmall > 0 : + for i = ymin step ysmall until ymax : + nodraw tys shifted (xmin,i) ; + endfor ; + fi ; + + if ylarge > 0 : + for i = ymin step ylarge until ymax : + nodraw tyl shifted (xmin,i) ; + endfor ; + dodraw (xmin,ymin) ; % flush snippets + elseif ysmall > 0 : + dodraw (xmin,ymin) ; % flush snippets + fi ; + + if swap : draw p fi ; + + if xlarge > 0 : + option := getparameter "xlabels" ; + if option <> "no" : + for i = xmin step xlarge until xmax : + if ((i <> 0) and ((option <> "nolimits") or ((i > xmin) and (i < xmax)))) : + draw textext.bot(decimal i) transformed tt + shifted (i,1.25*(ypart point 0 of txl)) ; + fi ; + endfor ; + fi ; + fi ; + + if ylarge > 0 : + option := getparameter "ylabels" ; + if option <> "no" : + for i = ymin step ylarge until ymax : + if ((i <> 0) and ((option <> "nolimits") or ((i > ymin) and (i < ymax)))) : + draw textext.lft(decimal i) transformed tt + shifted (xmin+1.25*(xpart point 0 of tyl),i) ; + fi ; + endfor ; + fi ; + fi ; + + option := getparameter "xcaption" ; + if (option <> "") : + draw textext.bot(option) transformed tt + shifted (xmin,-tl) + shifted center bottomboundary currentpicture ; + fi ; + + option := getparameter "ycaption" ; + if (option <> "") : + draw textext.lft(option) transformed tt + shifted (xmin-tl,0) + shifted center leftboundary currentpicture ; + fi ; + ) + + xyscaled(sx,sy) ; + + setbounds currentpicture to + boundingbox currentpicture + enlarged (getparameter "offset") ; + + popparameters ; + ) +enddef ; + +% Don't use this one! + +presetparameters "mesh" [ + trace = false, + auto = false, + step = 0.05, + % box = ... + % paths = { ..., ..., ... } +] ; + +def lmt_mesh = applyparameters "mesh" "lmt_do_mesh" enddef ; + +vardef lmt_do_mesh = + image ( + save p, b ; path p, b ; + pushparameters "mesh" ; + if getparameter "auto" : + b := if hasparameter "box" : getparameter "box" else : OverlayBox fi ; + for i=1 upto getparametercount "paths" : + p := getparameter "paths" i ; + p := meshed(p if not cycle p : -- cycle fi,b,getparameter "step") ; + if getparameter "trace" : + draw p ; + fi ; + runscript("mp.lmt_mesh_update()") i p ; + endfor ; + elseif getparameter "trace" : + for i=1 upto getparametercount "paths" : + p := getparameter "paths" i ; + draw p if not cycle p : -- cycle fi ; + endfor ; + fi ; + popparameters ; + runscript("mp.lmt_mesh_set()") ; + ) +enddef ; + +vardef mfun_meshed_clipped(expr pat, box, pct) = + pp := point (arctime pct of pat) of pat ; + if (ypart pp <= lly) or (ypart pp >= ury) or (xpart pp <= llx) or (xpart pp >= urx) : + (cp -- pp) intersection_point bb + else : + pp + fi +enddef ; + +vardef mfun_meshed_clipped(expr pat, box, pct) = + pp := point (arctime pct of pat) of pat ; + if ypart pp <= lly : + if xpart pp <= llx : + (llx, lly) + elseif xpart pp >= urx : + (urx, lly) + else : + (xpart pp, lly) + fi + elseif ypart pp >= ury : + if xpart pp <= llx : + (llx, ury) + elseif xpart pp >= urx : + (urx, ury) + else : + (xpart pp, ury) + fi + elseif xpart pp <= llx : + (llx, ypart pp) + elseif xpart pp >= urx : + (urx, ypart pp) + else : + pp + fi +enddef ; + +vardef meshed(expr pth, box, stp) = + begingroup + save cb, cp, llx, lly, urx, ury, pp, lp, bb ; pair cb, cp, pp ; path bb ; + bb := box enlarged -1/10; + cb := center bb ; + cp := center pth ; + llx := xpart llcorner bb; + lly := ypart llcorner bb; + urx := xpart urcorner bb; + ury := ypart urcorner bb; + lp := arclength pth ; + for i=stp step stp until 1+stp/2 : + cp -- + mfun_meshed_clipped(pth,bb,lp*(i-stp)) -- + mfun_meshed_clipped(pth,bb,lp*(i )) -- + cp -- + endfor cycle + endgroup +enddef ; + +vardef OverlayMesh(expr p, s) = + lmt_mesh [ paths = { meshed(p,OverlayBox,s) } ] +enddef ; + +% charts + +presetparameters "chart" [ + originsize = 1mm, + trace = false, + showlabels = true, + center = false, + + samples = { }, + + cumulative = false, + percentage = false, + maximum = 0, + distance = 1mm, + + % labels = { }, + labelstyle = "", + labelformat = "", + % labelstrut = "auto", + % labelanchor = "", + % labeloffset = 0, + labelfraction = 0.8, + labelcolor = "", + + backgroundcolor = "", + drawcolor = "white", + fillcolors = { % use color palet + "darkred", "darkgreen", "darkblue", + "darkyellow", "darkmagenta", "darkcyan", + "darkgray" + }, + colormode = "global", + + linewidth = .25mm, + + legendcolor = "", + legendstyle = "", + legend = { }, +] ; + +presetparameters "chart:circle" "chart" [ + height = 5cm, + width = 5mm, + labelanchor = "", + labeloffset = 0, + labelstrut = "no", +] ; + +presetparameters "chart:histogram" "chart" [ + height = 5cm, + width = 5mm, + labelanchor = "bot", + labeloffset = 1mm, + labelstrut = "auto", +] ; + +presetparameters "chart:bar" "chart" [ + height = 5mm, + width = 5cm, + labelanchor = "lft", + labeloffset = 1mm, + labelstrut = "no", +] ; + +def lmt_chart_circle = applyparameters "chart:circle" "lmt_do_chart_circle" enddef ; +def lmt_chart_histogram = applyparameters "chart:histogram" "lmt_do_chart_histogram" enddef ; +def lmt_chart_bar = applyparameters "chart:bar" "lmt_do_chart_bar" enddef ; + +def lmt_do_chart_start (expr what) = + pushparameters what ; + save width, height, distance, linewidth, labelgap, labelfraction, value, nofsamples, nofsamplesets ; + save fillcolor, drawcolor, labelcolor, labelstyle, labelformat, labelstrut, labelanchor, colormode ; + string fillcolor, drawcolor, labelcolor, labelstyle, labelformat, labelstrut, labelanchor, colormode ; + height := getparameter "height" ; + width := getparameter "width" ; + distance := getparameter "distance" ; + linewidth := getparameter "linewidth" ; + drawcolor := getparameter "drawcolor" ; + colormode := getparameter "colormode" ; + labelcolor := getparameter "labelcolor" ; + labelgap := getparameter "labeloffset" ; + labelstyle := getparameter "labelstyle" ; + labelformat := getparameter "labelformat" ; + labelstrut := getparameter "labelstrut" ; + labelanchor := getparameter "labelanchor" ; + labelfraction := getparameter "labelfraction" ; + nofsamplesets := getparametercount "samples" ; + nofsamples := getmaxparametercount "samples" ; +enddef ; + +def lmt_do_chart_stop = + if getparameter "center" : + currentpicture := currentpicture shifted - center currentpicture ; + fi + if (getparameter "backgroundcolor") <> "" : + addbackground withcolor getparameter "backgroundcolor" ; + fi + if getparameter "trace" : + save b ; path b ; b := boundingbox currentpicture ; + draw image ( + draw fullcircle scaled 1mm ; + draw b + ) + dashed evenly scaled 1/4 + withpen pencircle scaled .125mm + withcolor "darkgray" ; + fi + popparameters ; +enddef ; + +vardef lmt_do_chart_text(expr s, i, value) = + lmt_text [ + style = labelstyle, + format = labelformat, + strut = labelstrut, + anchor = labelanchor, + offset = labelgap, + color = labelcolor, + text = (getparameterdefault "labels" s i (decimal value)) + background = "", + ] +enddef ; + +def lmt_do_chart_legend = + n := getparametercount "legend" ; + if n > 0 : + save dx, dy, p, l, w, o, d, ddy ; picture l ; + dx := xpart urcorner currentpicture + EmWidth ; + dy := ypart urcorner currentpicture ; + labelcolor := getparameter "legendcolor" ; + labelstyle := getparameter "legendstyle" ; + w := 2EmWidth ; + o := .25EmWidth ; + d := ExHeight ; + ddy := .8LineHeight ; + for i=1 upto n : + dy := dy - ddy ; + l := lmt_text [ + text = getparameter "legend" i, + anchor = "rt" + style = labelstyle, + color = labelcolor, + background = "", + ] ; + fill leftboundary l rightenlarged w + shifted (dx,dy+d) + withcolor getparameter "fillcolors" i ; + draw l + shifted (dx+w+o,dy+d) ; + endfor ; + fi ; +enddef ; + +vardef lmt_do_chart_circle = + image ( + lmt_do_chart_start("chart:circle") ; + if (nofsamplesets > 0) and (nofsamples > 0) : + nofsamplesets := 1 ; + save p, r, s, first, last, total, factor, n, percentage ; + path p, r, s[] ; boolean percentage ; + percentage := getparameter "percentage" ; + total := 0 ; + for i = 1 upto nofsamples : + total := total + getparameter "samples" (1) i ; % () is needed else 1i + endfor ; + factor := 100/total ; + first := 0 ; + p := fullcircle ysized (height) ; + r := origin -- (2*height,0) ; + for i = 1 upto nofsamples : + fillcolor := getparameter "fillcolors" i ; + value := (getparameter "samples" (1) i) * factor ; + last := first + (360 / 100) * value ; + s[i] := ((p cutbefore (r rotated first)) cutafter (r rotated last)) ; + fill origin -- s[i] -- cycle withcolor fillcolor ; + first := last ; + endfor ; + if linewidth > 0 : + if drawcolor = "" : + drawcolor := backgroundcolor ; + fi ; + for i = 1 upto nofsamples : + interim linecap := butt ; + draw origin -- (point 0 of s[i]) withpen pencircle scaled linewidth withcolor drawcolor ; + draw origin -- (point length(s[i]) of s[i]) withpen pencircle scaled linewidth withcolor drawcolor ; + endfor ; + fi ; + if getparameter "showlabels" : + first := 0 ; + for i = 1 upto nofsamples : + value := getparameter "samples" (1) i ; + last := first + (360/100) * value * factor ; + draw lmt_do_chart_text (s,i,value) + shifted ((labelfraction*(height/2),0) rotated ((first+last)/2)) ; + first := last ; + endfor ; + fi ; + lmt_do_chart_legend ; + n := getparameter "originsize" ; + if n > 0 : + fill fullcircle scaled n withcolor "white" ; + fi ; + fi ; + lmt_do_chart_stop ; + ) +enddef ; + +vardef lmt_do_chart_histogram = + image ( + lmt_do_chart_start("chart:histogram") ; + if (nofsamplesets > 0) and (nofsamples > 0) : + save value, maximum, cumulative, maxwidth ; boolean cumulative ; + maximum := getparameter "maximum" ; + cumulative := getparameter "cumulative" ; + if labelanchor = "center" : + labelanchor := "vcenter" ; + fi ; + if maximum = 0 : + for s = 1 upto nofsamplesets : + for i = 1 upto nofsamples : + value := getparameter "samples" s i ; + maximum := if cumulative : + maximum + value ; + else : + max(maximum,value) ; + fi ; + endfor ; + endfor ; + fi ; + if nofsamplesets = 1 : + distance := 0 ; + fi ; + maxwidth := nofsamplesets * nofsamples * width + (nofsamples - 1)* distance ; + value := 0 ; + for s = 1 upto nofsamplesets : + for i = 1 upto nofsamples : + value := if cumulative : value + fi (getparameter "samples" s i) * height / maximum ; + fill unitsquare xyscaled (width,value) + if linewidth > 0 : + if i > 1 : leftenlarged (-linewidth/2) fi + if i < nofsamples : rightenlarged (-linewidth/2) fi + fi + shifted (nofsamplesets*(i-1)*width+(s-1)*width+(i-1)*distance,0) + withcolor getparameter "fillcolors" if colormode = "local" : s else : i fi ; + endfor ; + endfor ; + setbounds currentpicture to unitsquare xyscaled (maxwidth,height) ; + for s = 1 upto nofsamplesets : + if getparameter "showlabels" : + for i = 1 upto nofsamples : + draw lmt_do_chart_text (s,i,getparameter "samples" s i) + shifted (nofsamplesets*((i-1)*width)+width/2+(s-1)*width+(i-1)*distance,0) ; + endfor ; + fi ; + endfor ; + lmt_do_chart_legend ; + fi ; + lmt_do_chart_stop ; + ) +enddef ; + +vardef lmt_do_chart_bar = + + image ( + lmt_do_chart_start("chart:bar") ; + if (nofsamplesets > 0) and (nofsamples > 0) : + save value, maximum, cumulative, maxheight ; boolean cumulative ; + maximum := getparameter "maximum" ; + cumulative := getparameter "cumulative" ; + if labelanchor = "center" : + labelanchor := "hcenter" ; + fi ; + if maximum = 0 : + for s = 1 upto nofsamplesets : + for i = 1 upto nofsamples : + value := getparameter "samples" s i ; + maximum := if cumulative : maximum + value else : max(maximum,value) fi ; + endfor ; + endfor ; + fi ; + if nofsamplesets = 1 : + distance := 0 ; + fi ; + maxheight := nofsamplesets * nofsamples * height + (nofsamples - 1)* distance ; + for s = 1 upto nofsamplesets : + value := 0 ; + for i = 1 upto nofsamples : + value := if cumulative : value + fi (getparameter "samples" s i) * width / maximum ; + fill unitsquare xyscaled (value,height) + if linewidth > 0 : + if i > 1 : topenlarged (-linewidth/2) fi + if i < nofsamples : bottomenlarged (-linewidth/2) fi + fi + shifted (0,maxheight-nofsamplesets*i*height+(s-1)*height-(i-1)*distance) + withcolor getparameter "fillcolors" if colormode = "local" : s else : i fi ; + endfor ; + endfor ; + setbounds currentpicture to unitsquare xyscaled (width,maxheight) ; + if getparameter "showlabels" : + for s = 1 upto nofsamplesets : + for i = 1 upto nofsamples : + draw lmt_do_chart_text (s,i,getparameter "samples" s i) + shifted (0,maxheight-nofsamplesets*(i*height)+height/2+(s-1)*height-(i-1)*distance) ; + endfor ; + endfor ; + fi ; + lmt_do_chart_legend ; + fi ; + lmt_do_chart_stop ; + ) +enddef ; + +%D This one is more complex than needed but I want to trace so I need all those +%D variables. + +presetparameters "shade" [ + alternative = "circular", + path = origin -- cycle, + trace = false + + % alternative = "circular" | "linear" + % domain = { a, b } + % radius = a | { a, b } + % factor = a + % origin = (a,b) | { (a,b), {c, d) } + % vector = { a, b } + % colors = { a, b } + % center = a | { a, b } + % direction = "up" | "down" | "left" | "right" | { a, b } + +] ; + +% TODO: pass colors as strings + +def lmt_shade = applyparameters "shade" "lmt_do_shade" enddef ; + +vardef lmt_do_shade = + image ( + pushparameters "shade" ; + + save domain_min, domain_max, radius_a, radius_b, factor ; + save color_a, color_b, center_a, center_b, alternative, s ; + string color_a, color_b, alternative, s ; pair center_a, center_b ; + + alternative := getparameter "alternative" ; + + mfun_with_shade_method_analyze(getparameter "path") ; + + domain_min := 0 ; + domain_max := 1 ; + + color_a := "white" ; + color_b := "black" ; + + if alternative = "circular" : + center_a := center mfun_shade_path ; + center_b := center_a ; + radius_a := 0 ; + radius_b := mfun_max_radius(mfun_shade_path) ; + factor := 1.2 ; + else : + center_a := llcorner mfun_shade_path ; + center_b := urcorner mfun_shade_path ; + radius_a := 0 ; + radius_b := 0 ; + factor := 0; + fi ; + + if hasparameter "domain" : + domain_min := getparameter "domain" 1 ; + domain_max := getparameter "domain" 2 ; + fi + if hasparameter "radius" : + if numeric getparameter "radius" : + radius_a := 0 ; + radius_b := getparameter "radius" ; + else : + radius_a := getparameter "radius" 1 ; + radius_b := getparameter "radius" 2 ; + fi ; + factor := 1 ; + fi + if hasparameter "factor" : + factor := getparameter "factor" ; + fi + if hasparameter "origin" : + if pair getparameter "origin" : + center_a := getparameter "origin" ; + center_b := center_b ; + else : + center_a := getparameter "origin" 1 ; + center_b := getparameter "origin" 2 ; + fi ; + fi + if hasparameter "colors" : + color_a := getparameter "colors" 1 ; + color_b := getparameter "colors" 2 ; + fi + if hasparameter "direction" : + save a, b, bb ; path bb ; + 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 ; + elseif s = "down" : + p_a := xpart shadeddown ; + p_b := ypart shadeddown ; + elseif s = "left" : + p_a := xpart shadedleft ; + p_b := ypart shadedleft ; + elseif s = "right" : + p_a := xpart shadedright ; + p_b := ypart shadedright ; + fi + else : + p_a := getparameter "direction" 1 ; + p_a := getparameter "direction" 2 ; + fi + if p_a >= 0 : + center_a := point p_a of bb ; + fi + if p_b >= 0 : + center_b := point p_b of bb ; + fi + fi ; + if hasparameter "center" : + save cx, cy ; + if numeric getparameter "center" : + cx := getparameter "center" ; + cx := cy ; + % elseif pair getparameter "center" : + % cx := xpart getparameter "center" ; + % cy := ypart getparameter "center" ; + else : + cx := getparameter "center" 1 ; + cy := getparameter "center" 2 ; + fi + center_a := center mfun_shade_path shifted ( + cx * bbwidth (mfun_shade_path)/2, + cy * bbheight(mfun_shade_path)/2 + ) ; + elseif hasparameter "vector" : + center_a := point (getparameter "vector" 1) of mfun_shade_path ; + center_b := point (getparameter "vector" 2) of mfun_shade_path ; + fi + fill mfun_shade_path + withprescript "sh_domain=" & decimal domain_min & " " & decimal domain_max + withprescript "sh_transform=yes" + withprescript "sh_color=into" + withprescript "sh_color_a=" & colordecimals color_a + withprescript "sh_color_b=" & colordecimals color_b + withprescript "sh_first=" & ddecimal point 0 of mfun_shade_path % 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 alternative = "linear" : + withprescript "sh_type=linear" + % withprescript "sh_factor=1" + withprescript "sh_factor=" & decimal factor + withprescript "sh_center_a=" & ddecimal center_a + withprescript "sh_center_b=" & ddecimal center_b + else : + withprescript "sh_type=circular" + % withprescript "sh_factor=1.2" + withprescript "sh_factor=" & decimal factor + withprescript "sh_center_a=" & ddecimal center_a + withprescript "sh_center_b=" & ddecimal center_b + withprescript "sh_radius_a=" & decimal radius_a + withprescript "sh_radius_b=" & decimal radius_b + fi ; + if getparameter "trace" : + draw fullcircle scaled 1mm shifted center_a ; + draw fullsquare scaled 2mm shifted center_b ; + draw textext.top("\strut\ttx center a") ysized LineHeight shifted center_a shifted (0, 2mm) ; + draw textext.bot("\strut\ttx center b") ysized LineHeight shifted center_b shifted (0,-2mm) ; + if alternative = "circular" : +% draw fullcircle scaled ( radius_a * 2) shifted center_a dashed evenly ; +% draw fullcircle scaled (factor * radius_b * 2) shifted -center_b dashed evenly ; + draw fullcircle scaled ( radius_a) shifted center_a dashed evenly ; + draw fullcircle scaled (factor * radius_b) shifted -center_b dashed evenly ; + fi + fi + popparameters ; + ) +enddef ; + +% This is very experimental and will first be tested by a few users who +% are interested in this. + +presetparameters "contour" [ + xmin = 0, + xmax = 0, + ymin = 0, + ymax = 0, + xstep = 0, + ystep = 0, + levels = 10, + % colors = { }, % used when set + preamble = "", + function = "x + y", + color = "lin(l)", % l/n + background = "bitmap", % bitmap | shape | band + foreground = "auto", % cell| edge | shape | auto: bitmap/edge shape/shape + linewidth = .25, + backgroundcolor = "black", + linecolor = "gray", + xformat = "@0.2N", + yformat = "@0.2N", + zformat = "@0.2N", + xstyle = "", + ystyle = "", + zstyle = "", + + width = 0, % auto when 0 + height = 0, % auto when 0 + + trace = false, + checkresult = false, + defaultnan = 0, + defaultinf = 0, + + legend = "all", % x | y | z | function | range | all (but range) + legendheight = LineHeight, + legendwidth = LineHeight, + legendgap = 0, + legenddistance = EmWidth, + textdistance = 2EmWidth/3, + functiondistance = ExHeight, + functionstyle = "", + + level = 4096, % for selecting one (can't be too large for scaled) + + axisdistance = ExHeight, + axislinewidth = .25, + axisoffset = ExHeight/4, + axiscolor = "black", + ticklength = ExHeight, + + xtick = 5, + ytick = 5, + xlabel = 5, + ylabel = 5, + +] ; + +% we can as well push ... + +def lmt_contour = applyparameters "contour" "lmt_do_contour" enddef ; + +def mfun_only_draw = addto currentpicture doublepath enddef ; +def mfun_only_fill = addto currentpicture contour enddef ; +def mfun_only_fillup text t = addto currentpicture doublepath t withpostscript "both" enddef ; +def mfun_only_nodraw text t = addto currentpicture doublepath t withpostscript "collect" enddef ; +def mfun_only_nofill text t = addto currentpicture contour t withpostscript "evenodd" enddef ; +def mfun_only_eofill text t = addto currentpicture contour t withpostscript "collect" enddef ; + +def lmt_do_contour_shortcuts = + save D ; let D = mfun_only_draw ; + save E ; let E = mfun_only_eofill ; + save F ; let F = mfun_only_fill ; + save U ; let U = mfun_only_fillup ; + save d ; let d = mfun_only_nodraw ; + save e ; let f = mfun_only_eofill ; + save f ; let f = mfun_only_nofill ; + save C ; let C = cycle ; + save B ; let B = controls ; + save A ; let A = and ; +enddef ; + +def lmt_do_contour_band = + lua.mp.lmt_contours_edge_set_by_band() ; + for v=1 upto lua.mp.lmt_contours_nofvalues() : + draw image ( + lua.mp.lmt_contours_edge_get_band(v) ; + ) + withcolor lua.mp.lmt_contours_color(v) ; + endfor ; +enddef; + +def lmt_do_contour_cell(expr dx,dy) = + lua.mp.lmt_contours_edge_set_by_cell() ; + draw image ( + if level = 4096 : + for v=1+1 upto lua.mp.lmt_contours_nofvalues() : + lua.mp.lmt_contours_edge_get_cell(v) ; + endfor ; + else : + lua.mp.lmt_contours_edge_get_cell(level) ; + fi + ) + if (dx <>0) or (dy <> 0) : shifted (dx,dy) fi + withcolor getparameter "linecolor" + withpen pencircle scaled getparameter "linewidth" ; +enddef ; + +def lmt_do_contour_edge(expr dx, dy) = + lua.mp.lmt_contours_edge_set() ; + draw image ( + if level = 4096 : + for v=1+1 upto lua.mp.lmt_contours_nofvalues() : + lua.mp.lmt_contours_edge_paths(v); + endfor ; + else : + lua.mp.lmt_contours_edge_paths(level); + fi + ) + if (dx <>0) or (dy <> 0) : shifted (dx,dy) fi + withcolor getparameter "linecolor" + withpen pencircle scaled getparameter "linewidth" ; +enddef ; + +def lmt_do_contour_edges(expr dx, dy) = + lua.mp.lmt_contours_edge_set() ; + if level = 4096 : + for v=1+1 upto lua.mp.lmt_contours_nofvalues() : + draw image ( + lua.mp.lmt_contours_edge_paths(v); + ) + if (dx <>0) or (dy <> 0) : shifted (dx,dy) fi + withpen pencircle scaled getparameter "linewidth" + withcolor lua.mp.lmt_contours_color(v) ; + endfor ; + else : + draw image ( + lua.mp.lmt_contours_edge_paths(level); + ) + if (dx <>0) or (dy <> 0) : shifted (dx,dy) fi + withpen pencircle scaled getparameter "linewidth" + withcolor lua.mp.lmt_contours_color(level) ; + fi ; +enddef ; + +def lmt_do_contour_cells(expr dx, dy) = + lua.mp.lmt_contours_edge_set_by_cell() ; + if level = 4096 : + for v=1+1 upto lua.mp.lmt_contours_nofvalues() : + draw image ( + lua.mp.lmt_contours_edge_get_cell(v) ; + ) + if (dx <>0) or (dy <> 0) : shifted (dx,dy) fi + withpen pencircle scaled getparameter "linewidth" + withcolor lua.mp.lmt_contours_color(v) ; + endfor ; + else : + draw image ( + lua.mp.lmt_contours_edge_get_cell(level) ; + ) + if offset : shifted (-1/2,-1/2) fi + withpen pencircle scaled getparameter "linewidth" + withcolor lua.mp.lmt_contours_color(v) ; + fi ; +enddef ; + +def lmt_do_contour_shape(expr dx, dy) = + draw image ( + if level = 4096 : + for v=1+1 upto lua.mp.lmt_contours_nofvalues() : + lua.mp.lmt_contours_shape_paths(v); + endfor ; + else : + lua.mp.lmt_contours_shape_paths(level); + lua.mp.lmt_contours_shape_paths(1); + fi + ) + if (dx <>0) or (dy <> 0) : shifted (dx,dy) fi + withcolor getparameter "linecolor" + withpen pencircle scaled getparameter "linewidth" ; +enddef ; + +def lmt_do_contour_bitmap = + lua.mp.lmt_contours_bitmap_set() ; + lua.mp.lmt_contours_bitmap_get() ; +enddef ; + +def lmt_do_contour_shades(expr outlines) = + lua.mp.lmt_contours_shade_set(outlines) ; + if level = 4096 : + for v=1 upto lua.mp.lmt_contours_nofvalues() : % no + 1 here + draw image ( + lua.mp.lmt_contours_shade_paths(v) ; + ) + withpen pencircle scaled 0 + withcolor lua.mp.lmt_contours_color(v) ; + endfor ; + else : + draw image ( + lua.mp.lmt_contours_shade_paths(level); + ) + withpen pencircle scaled 0 + withcolor lua.mp.lmt_contours_color(level) ; + fi ; +enddef ; + +def lmt_load_mlib_cnt = + runscript("lua.registercode('mlib-cnt')"); + extra_beginfig := extra_beginfig & % todo: use different hook + "runscript(" & ditto & "mp.lmt_contours_cleanup()" & ditto & ")" ; + let lmt_load_mlib_cnt = relax ; +enddef ; + +vardef lmt_do_contour = + image ( + + lmt_load_mlib_cnt ; + + pushparameters "contour" ; + + lua.mp.lmt_contours_start() ; + + % graphic + + save bg, fg, nx, ny, trace, level, b, done ; string bg, fg ; boolean trace, done ; path b ; + + bg := getparameter "background" ; + fg := getparameter "foreground" ; + nx := lua.mp.lmt_contours_nx() ; + ny := lua.mp.lmt_contours_ny() ; + trace := getparameter "trace" ; + level := getparameter "level" ; + done := true ; + + begingroup ; + + lmt_do_contour_shortcuts ; + + if bg = "band" : + lmt_do_contour_band ; + b := boundingbox currentpicture ; + if (fg = "auto") or (fg = "cell") : + lmt_do_contour_cell(0,0) ; + elseif (fg = "edge") : + lmt_do_contour_edge(0,0) ; % true ? + fi ; + + elseif bg = "bitmap" : + + lmt_do_contour_bitmap ; + b := boundingbox currentpicture ; + if (fg = "auto") or (fg = "cell") : + lmt_do_contour_cell(-1/2,-1/2) ; + elseif (fg = "edge") : + lmt_do_contour_edge(-1/2,-1/2) ; + fi ; + + elseif bg = "shape" : + + lmt_do_contour_shades((fg = "auto") or (fg = "shape")) ; + b := boundingbox currentpicture ; + if (fg == "auto") or (fg = "shape") : + lmt_do_contour_shape(0,0) ; + elseif fg == "cell" : + lmt_do_contour_cell(-1,-1) ; + elseif fg == "edge" : + lmt_do_contour_edge(-1,-1) ; + fi ; + + % currentpicture := currentpicture reflectedabout ( (0, ny/2), (nx,ny/2) ) ; + + elseif fg = "cell" : + + lmt_do_contour_shortcuts ; + lmt_do_contour_cells(0,0) ; + b := boundingbox currentpicture ; + + elseif fg = "edge" : + + lmt_do_contour_shortcuts ; + lmt_do_contour_edges(0,0) ; + b := boundingbox currentpicture ; + + else : + + done := false ; + + fi ; + + endgroup ; + + if done : + + save w, h, cx, cy ; + + cx := - bbwidth (b)/(nx - 1) ; + cy := - bbheight(b)/(ny - 1) ; + clip currentpicture to b + leftenlarged cx rightenlarged cx + topenlarged cy bottomenlarged cy ; + currentpicture := currentpicture + shifted (cx,cy) ; + + w := getparameter "width" ; + h := getparameter "height" ; + + % axis + + save xtic, ytic, auto ; boolean auto ; + + xtic := getparameter "xtick" ; + ytic := getparameter "ytick" ; + auto := (w = 0) and (h = 0) ; + + % resize + + if w <> 0 : + if h <> 0 : + currentpicture := currentpicture xysized (w,h) ; + else : + currentpicture := currentpicture xsized w ; + fi ; + elseif h <> 0 : + currentpicture := currentpicture ysized h ; + fi ; + if w = 0 : + w := bbwidth(currentpicture) ; + fi ; + if h = 0 : + h := bbheight(currentpicture) ; + fi ; + + % legend + + if hasoption "legend" "all,x,y,z,range" : + + save u, s, sx, sy, ax, ay, ao, al, at, tl, ox, oy, lg, tx, ty, wx, hx, ry, fmt, pmin, pmax ; string fmt; picture pmin, pmax ; + + % move some in the ifs + + if hasoption "legend" "all,z" : + + % colorbar + + fmt := lua.mp.lmt_contours_format() ; + pmin := lmt_text [ format = fmt, text = decimal lua.mp.lmt_contours_minmean() ] ; + pmax := lmt_text [ format = fmt, text = decimal lua.mp.lmt_contours_maxmean() ] ; + wx := max(bbwidth(pmin),bbwidth(pmax)) ; + hx := bbheight(pmin) ; + + else : + + hx := 0; + + fi ; + + if auto : + % u := 1 ; + u := lua.mp.lmt_contours_ny() / 100 ; + ry := 4u ; + sy := 5u ; + sx := 5u ; + lg := 0 ; + ox := 5u ; + oy := - sy/2 + ry/2 ; + tx := 2u ; + ty := 1u ; + ax := 1u ; + ay := 1u ; + ao := u ; + al := u/8 ; + at := 3u/2 ; + al := u/4 ; + else : + ry := 0 ; + sy := getparameter "legendheight" ; + sx := getparameter "legendwidth" ; + lg := getparameter "legendgap" ; + ox := getparameter "legenddistance" ; + oy := - sy/2 + hx/2 ; + tx := getparameter "textdistance" ; + ty := getparameter "functiondistance" ; + ax := getparameter "axisdistance" ; + ay := ax ; + ao := getparameter "axisoffset" ; + at := getparameter "ticklength" ; + al := getparameter "axislinewidth" ; + fi ; + + if hasoption "legend" "all,z" : + + save dy ; dy := h ; + + for v=1 upto lua.mp.lmt_contours_nofvalues() : + dy := dy - sy ; + fill unitsquare xyscaled (sx,sy) + shifted (w+ox,dy) + withcolor lua.mp.lmt_contours_color(v) ; + draw + lmt_text [ + trace = trace, + anchor = "llft", + format = fmt, + text = decimal lua.mp.lmt_contours_value(v), + style = getparameter "zstyle", + position = (wx,0), + background = "", + ] + if ry <> 0 : ysized (ry) fi + shifted (w+ox+tx+sx,dy+sy+oy) + ; + dy := dy - lg ; + endfor ; + + fi ; + + if hasoption "legend" "x,all" : + + save n, d, s, xmin, xmax, xlab ; + + xmin := getparameter "xmin" ; + xmax := getparameter "xmax" ; + xlab := getparameter "xlabel" ; + + draw image ( + interim linecap := butt ; + draw ((0,0) -- (w,0)) ; + n := al/2 ; s := (w - al) / xtic ; d := (xmax - xmin) / xtic ; + for i=xmin step d until xmax : + draw (n,0) -- (n,-at) ; + n := n + s ; + endfor ; + ) shifted (0,-ay) + withpen pencircle scaled al + withcolor getparameter "axiscolor" + ; + + if hasoption "legend" "label,all" : + + draw image ( + n := al/2 ; s := (w - al) / xlab ; d := (xmax - xmin) / xlab ; + for i=xmin step d until xmax : + draw lmt_text [ + trace = trace, + anchor = "bot", + format = getparameter "xformat", + style = getparameter "xstyle", + text = decimal i + background = "", + ] + if ry <> 0 : ysized (ry) fi + shifted (n,-at-ao) + ; + n := n + s ; + endfor ; + ) shifted (0,-ay) ; + + fi ; + + fi ; + + if hasoption "legend" "y,all" : + + save n, d, s, ymin, ymax, ylab ; + + ymin := getparameter "ymin" ; + ymax := getparameter "ymax" ; + ylab := getparameter "ylabel" ; + + draw image ( + interim linecap := butt ; + draw ((0,0) -- (0,h)) ; + n := al/2 ; s := (h - al) / ytic ; d := (ymax - ymin) / ytic ; + for i=ymin step d until ymax : + draw (0,n) -- (-at,n) ; + n := n + s ; + endfor ; + ) shifted (-ax,0) + withpen pencircle scaled al + withcolor getparameter "axiscolor" ; + ; + + if hasoption "legend" "label,all" : + + draw image ( + n := al/2 ; s := (h - al) / ylab ; d := (ymax - ymin) / ylab ; + for i=ymin step d until ymax : + draw lmt_text [ + trace = trace, + anchor = "lft", + format = getparameter "yformat", + style = getparameter "ystyle", + text = decimal i + background = "", + ] + if ry <> 0 : ysized (ry) fi + shifted (-at-ao,n) + ; + n := n + s ; + endfor ; + ) shifted (-ax,0) ; + + fi ; + + fi ; + + if hasoption "legend" "range,all" : + + % range + + save d ; d := ypart llcorner currentpicture ; + + draw + lmt_text [ + trace = trace, + anchor = "bot", + text = lua.mp.lmt_contours_range() + background = "", + ] + if ry <> 0 : ysized (ry) fi + shifted (w/2,d-ty) + ; + + % minmax + + draw + lmt_text [ + trace = trace, + anchor = "lrt", + text = lua.mp.lmt_contours_xrange() + background = "", + ] + if ry <> 0 : ysized (ry) fi + shifted (0,d-ty) + ; + + draw + lmt_text [ + trace = trace, + anchor = "llft", + text = lua.mp.lmt_contours_yrange() + background = "", + ] + if ry <> 0 : ysized (ry) fi + shifted (w,d-ty) + ; + + fi ; + + if hasoption "legend" "function,all" : + + % formula + + draw + lmt_text [ + trace = trace, + anchor = "bot", + style = getparameter "functionstyle", + text = lua.mp.lmt_contours_function() + background = "", + ] + if ry <> 0 : ysized (ry) fi + shifted (w/2,ypart llcorner currentpicture - ty) + ; + + fi ; + + if trace : + draw boundingbox currentpicture + dashed evenly + withpen pencircle scaled al ; + fi ; + + fi ; + + fi ; + + lua.mp.lmt_contours_stop() ; + + popparameters ; + ) +enddef ; + +newinternal svgforcecmyk ; svgforcecmyk := 0 ; + +vardef svgcolor(expr r, g, b) = + if svgforcecmyk > 0 : + (1-r,1-g,1-b,0) % simple: no black component, kind of ok for emoji + else : + (r,g,b) + fi +enddef ; + +vardef svgcmyk(expr c, m, y, k) = + (c,m,y,k) +enddef ; + +vardef svggray(expr s) = + s +enddef ; + +presetparameters "svg" [ + filename = "", + fontname = "", + colormap = "", + % unicode = 0, + width = 0, + height = 0, + origin = false, + offset = 0, +] ; + +def lmt_svg = applyparameters "svg" "lmt_do_svg" enddef ; + +vardef lmt_do_svg = + save w, h, o; + image ( + pushparameters "svg" ; + w := getparameter "width" ; + h := getparameter "height" ; + o := getparameter "offset" ; + lua.mp.lmt_svg_include() ; + if getparameter "origin" : + currentpicture := currentpicture shifted -llcorner currentpicture ; + fi ; + popparameters ; + if o <> 0 : + setbounds currentpicture to boundingbox currentpicture enlarged o ; + fi ; + ) + if w > 0 : + if h > 0 : xysized(w,h) else : xsized(w) fi + else : + if h > 0 : ysized(h) fi + fi +enddef ; + +% Another experiment. Parameters might change pending a discussion between Alan +% and me. + +presetparameters "surface" [ + code = "x + y", + color = "f, 0, 0", + linecolor = 1, + xmin = -1, + xmax = 1, + ymin = -1, + ymax = 1, + xstep = .1, + ystep = .1, + snap = .01, + xvector = { -0.7, -0.7 }, + yvector = { 1, 0 }, + zvector = { 0, 1 }, + light = { 3, 3, 10 }, + bright = 100, + clip = false, + lines = true, + linecolor = 1, + % axis = { } + % clipaxis = false + axiscolor = "gray" + axislinewidth = 1/2, +] ; + +def lmt_surface = applyparameters "surface" "lmt_do_surface" enddef ; + +vardef lmt_do_surface = + image ( + + lmt_load_mlib_cnt ; + + pushparameters "surface" ; + + save currentpen; pen currentpen ; + currentpen := pencircle scaled .25 ; + + interim linejoin := butt ; + + lmt_do_contour_shortcuts ; + + lua.mp.lmt_surface_do() ; + + currentpicture := currentpicture ysized getparameter "height" ; + + if hasparameter "axis" : + + save p ; picture p ; p := image ( + if hasparameter "axis" 1 : + draw ((origin) -- unitvector(getparameter "xvector")) scaled (getparameter "axis" 1) ; + fi ; + if hasparameter "axis" 2 : + draw ((origin) -- unitvector(getparameter "yvector")) scaled (getparameter "axis" 2) ; + fi ; + if hasparameter "axis" 3 : + draw ((origin) -- unitvector(getparameter "zvector")) scaled (getparameter "axis" 3) ; + fi ; + ) ; + + if getparameterdefault "clipaxis" false : + clip p to boundingbox currentpicture ; + fi ; + + draw p + withpen pencircle scaled getparameter "axislinewidth" + withcolor getparameter "axiscolor" + ; + + fi ; + + popparameters ; + ) +enddef ; + +% I can make a variant that avoids the lmt_do ... and does an immediate function +% call instead. + +presetparameters "mpsglyphs" [ + name = "dummy", + units = 1000, +] ; + +presetparameters "mpsglyph" [ + category = "dummy", + unicode = 0, + % unichar = "" +] ; + +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 ; + +% Again an experiment (todo: the faster method): + +def lmt_remaptext = runscript("mp.lmt_do_remaptext()") enddef ; + +triplet mfun_tt_s ; + +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,catcoderegime) ; + mfun_tt_s := lua.mp.mf_map_move(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 svgtext(expr t) = + save p ; picture p ; + % mfun_tt_s := (0,0,0) ; + % mfun_tt_r := (0,0,0) ; + p := rawmaptext(t) ; + p + if (mfun_labtype.drt >= 10) : % drt etc + shifted (0,ypart center p) + fi + shifted ( + - mfun_labshift.drt(p) + - (redpart mfun_tt_s,0) + + (greenpart mfun_tt_s,bluepart mfun_tt_s) + ) +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 ; diff --git a/metapost/context/base/mpxl/mp-luas.mpxl b/metapost/context/base/mpxl/mp-luas.mpxl new file mode 100644 index 000000000..421e82946 --- /dev/null +++ b/metapost/context/base/mpxl/mp-luas.mpxl @@ -0,0 +1,250 @@ +%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/metapost/context/base/mpxl/mp-math.mpxl b/metapost/context/base/mpxl/mp-math.mpxl new file mode 100644 index 000000000..ea8c1cd7c --- /dev/null +++ b/metapost/context/base/mpxl/mp-math.mpxl @@ -0,0 +1,161 @@ +%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/metapost/context/base/mpxl/mp-page.mpxl b/metapost/context/base/mpxl/mp-page.mpxl new file mode 100644 index 000000000..8a4b735e0 --- /dev/null +++ b/metapost/context/base/mpxl/mp-page.mpxl @@ -0,0 +1,243 @@ +%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 ; -- cgit v1.2.3